{*
 * @(#) simpas.pas - Event Simulation Unit.
 **
 * Language: Turbo Pascal
 * Tested with: Turbo Pascal v6.0
 * Last modified: 1997-11-20 13:20:00 GMT+03:00
 *}

unit SimPas;

interface

type
 DataPntr=Pointer; { ^DataType } { Pointer type to event data }
 NotePntr=^NoteType; { Pointer type to event record }
 NoteType=record
            Numb: Integer; { Number of event activity }
            Time: Real; { Event time }
            Addr: DataPntr; { Event data address }
            Next,Prev: NotePntr; { Prev and next addresses }
          end;
 StatType=array[1..3] of record { Statistics data type }
                           Numb, { Activity number }
                           Exist, { Counter of existing events in the list }
                           Simul, { Happened events counter }
                           Prep, { Happened schedulings counter }
                           Canc: Integer; { Happened cancellations counter }
                         end;
 GenerType=array[1..3] of record { Stream regeneration data type }
                            Numb, { Activity number }
                            Count, { Regeneration cycles counter }
                            ID: Integer; { Generator type identifier }
                            Param1,Param2: Real; { Two parameters }
                          end;

var
 ActNumb: Integer; { Activity number of the active event }
 ActTime: Real; { Time of the active event }
 ActAddr: DataPntr; { Data address of the active event }
 Repeater: Integer; { Repeation counter of installations }
 Inform: Integer; { Debug info switch }
 RND_INT: Integer; { Pseudo-random seed }
 Node: NotePntr; { Head list chain pointer }
 Route: NotePntr; { Current list chain pointer }
 SlyNode: NotePntr; { Control duplication of 'Node' }
 Addr: DataPntr; { Event data working pointer }
 Stat: ^StatType; { Statistics data pointer }
 Gener: ^GenerType; { Stream generation data pointer }

procedure Initiate;
 { Variables initialization }

function RND: Real;
 { Generator of random numbers in range from 0 (inclusive) to 1 (exclusive) }
function Uniform(Min, Max: Real): Real;
 { Generator of unifor random numbers in range from Min to Max }
function Normal(M,S: Real): Real;
 { Gaussian random numbers generator }
function NegExp(L: Real): Real;
 { Generator of 'neg_exp' random numbers (L>0) }

procedure Start(N: Integer; T: Real; A:DataPntr; Time: Real);
 { Setting of installation start (the first record in list and end time }
procedure Finish;
 { Stopping of simulation }

function Simulate: Boolean;
 { Do one step of simulation }
procedure ViewList;
 { List show routine }
procedure ViewStat;
 { Statistics array show routine }

procedure ViewNote(P: NotePntr);
 { List record show routine }
function IncNote(P1,P2: NotePntr; N: Integer; T: Real; A: DataPntr): NotePntr;
 { List record addition }
procedure DelNote(P: NotePntr);
 { List record deletion }

function GetNextT(T: Real): NotePntr;
 { List record searching }
function GetStatI(var Numb: Integer): Integer;
 { Find statistics index of event number }
function GetGener(var Numb: Integer): Integer;
 { Find generation index of event number }
procedure StatCanc(var Numb: Integer);
 { Statistics correction on cancellation }
procedure StatPrep(var Numb: Integer);
 { Statistics correction on event planning }

procedure Statistics(Numb: Integer);
 { Do statistics gathering }
procedure Generate(Numb,Distr: Integer; Par1,Par2: Real; Count: Integer);
 { Do stream generation }
function Cancel(P: NotePntr): DataPntr;
 { Event cancellation }
function CancMin(N: Integer): DataPntr;
 { Event cancellation (with the specified number and min time }

procedure PrepBefore(P: NotePntr; N: Integer; A: DataPntr);
 { Event addition before the specified record }
procedure PrepAfter(P: NotePntr; N: Integer; A: DataPntr);
 { Event addition after the specified record }
procedure Prepare(N: Integer; DT: Real; A: DataPntr);
 { Event addition before the record with the time greater than (current+DT) }
procedure PrepPrior(N: Integer; DT: Real; A: DataPntr);
 { Event addition before the record with the time not less than (current+DT) }

function Have(Numb: Integer): Integer;
 { Returns records counter for the the specified statistics number }
function Done(Numb: Integer): Real;
 { Returns average counter of happened events with the specified number }
function Prep(Numb: Integer): Real;
 { Returns average counter of scheduled events with the specified number }
function Canc(Numb: Integer): Real;
 { Returns average counter of cancelled events with the specified number }

implementation

procedure ViewNote(P: NotePntr);
var
  A: Char;
begin
  if P^.Addr=nil
    then A:='_'
    else A:='#';
  WriteLn('Number=':10,P^.Numb:5,'Time=':15,P^.Time:10:3,'Address=':15,A);
end;

function RND: Real;
const
  M=113;
  D=12703;
  B=66;
var
  C: Integer;
begin
  C:=RND_INT div M;
  RND_INT:=B*C+M*(RND_INT-M*C);
  if RND_INT>D
    then RND_INT:=RND_INT-D;
  RND:=RND_INT/D;
end;

procedure DelNote(P: NotePntr);
begin
  P^.Next^.Prev:=P^.Prev;
  P^.Prev^.Next:=P^.Next;
  Dispose(P);
end;

function IncNote(P1,P2: NotePntr; N: Integer; T: Real;
                 A: DataPntr): NotePntr;
var
  P: NotePntr;
begin
  New(P);
  P1^.Next:=P;
  P2^.Prev:=P;
  IncNote:=P;
  P^.Numb:=N;
  P^.Prev:=P1;
  P^.Next:=P2;
  P^.Time:=T;
  P^.Addr:=A;
end;

function GetNextT(T: Real): NotePntr;
var
  P: NotePntr;
begin
  if SlyNode<>Node
    then begin
           GetNextT:=nil;
           if Inform>0
             then WriteLn('No List!');
         end
    else begin
           P:=Node^.Next;
           while (P<>Node) and (P^.Time<=T)
             do P:=P^.Next;
           GetNextT:=P;
         end;
end;

function GetStatI(var Numb: Integer): Integer;
begin
  GetStatI:=0;
  if Stat<>nil
    then if Stat^[1].Numb=Numb
           then GetStatI:=1
           else if Stat^[2].Numb=Numb
                  then GetStatI:=2
                  else if Stat^[3].Numb=Numb
                         then GetStatI:=3;
end;

function GetGener(var Numb: Integer): Integer;
begin
  GetGener:=0;
  if Gener<>nil
    then if Gener^[1].Numb=Numb
           then GetGener:=1
           else if Gener^[2].Numb=Numb
                  then GetGener:=2
                  else if Gener^[3].Numb=Numb
                         then GetGener:=3;
end;

procedure StatCanc(var Numb: Integer);
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then begin
           Stat^[I].Canc:=Stat^[I].Canc+1;
           Stat^[I].Exist:=Stat^[I].Exist-1;
         end;
end;

procedure StatPrep(var Numb: Integer);
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then begin
           Stat^[I].Prep:=Stat^[I].Prep+1;
           Stat^[I].Exist:=Stat^[I].Exist+1;
         end;
end;

procedure Initiate;
begin
  Inform:=0;
  Repeater:=0;
  RND_INT:=7531;
  Node:=nil;
  Route:=nil;
  SlyNode:=nil;
  Stat:=nil;
  Gener:=nil;
end;

procedure Statistics(Numb: Integer);
var
  I: Integer;
begin
  if Stat=nil
    then begin
           New(Stat);
           Stat^[1].Numb:=0;
           Stat^[2].Numb:=0;
           Stat^[3].Numb:=0;
         end;
  I:=GetStatI(Numb);
  if I=0
    then begin
           I:=GetStatI(I);
           if I=0
             then I:=3;
         end;
  Stat^[I].Numb:=Numb;
  Stat^[I].Exist:=0;
  Stat^[I].Simul:=0;
  Stat^[I].Prep:=0;
  Stat^[I].Canc:=0;
end;

procedure Generate(Numb,Distr: Integer; Par1,Par2: Real; Count: Integer);
var
  I: Integer;
begin
  if Gener=nil
    then begin
           New(Gener);
           Gener^[1].Numb:=0;
           Gener^[2].Numb:=0;
           Gener^[3].Numb:=0;
         end;
  I:=GetGener(Numb);
  if I=0
    then begin
           I:= GetGener(I);
           if I=0
             then I:=3
         end;
  Gener^[I].Numb:=Numb;
  Gener^[I].Param1:=Par1;
  Gener^[I].Count:=Count;
  Gener^[I].Param2:=Par2;
  Gener^[I].ID:=Distr;
end;

procedure Start(N: Integer; T: Real; A: DataPntr; Time: Real);
begin
  ActNumb:=0;
  ActTime:=0.0;
  ActAddr:=nil;
  New(Node);
  SlyNode:=Node;
  Repeater:=Repeater+1;
  if Stat<>nil
    then begin
           Stat^[1].Exist:=0;
           Stat^[2].Exist:=0;
           Stat^[3].Exist:=0;
         end;
  if Inform>0
    then begin
           Write('Start of realization ',Repeater);
           if Time>0
             then WriteLn(' until time ',Time:10:3)
             else WriteLn;
         end;
  Node^.Numb:=0;
  Node^.Time:=0;
  Node^.Addr:=nil;
  New(Route);
  Node^.Next:=Route;
  if N<>0
    then StatPrep(N);
  Route^.Prev:=Node;
  Route^.Numb:=N;
  Route^.Time:=T;
  Route^.Addr:=A;
  Route:=Node;
  if Time>0
    then begin
           New(Route);
           Route^.Numb:=0;
           Route^.Time:=Time;
           Route^.Addr:=nil;
           Route^.Next:=Node;
           Node^.Prev:=Route;
         end;
  Node^.Next^.Next:=Route;
  Route^.Prev:=Node^.Next;
  if Inform>0
    then begin
           Write('First record ');
           ViewNote(Node^.Next);
         end;
  if Inform>2
    then ReadLn;
end;

procedure Finish;
begin
  if Inform>0
    then Write('Finish':11);
  if SlyNode<>Node
    then begin
           if Inform>0
             then WriteLn('No List!');
          end
    else begin
           Route:=IncNote(Node,Node^.Next,0,Node^.Time,nil);
           if Inform>0
             then ViewNote(Route);
         end;
end;

function Cancel(P: NotePntr): DataPntr;
begin
  Cancel:=nil;
  if Inform>1
    then Write('Cancel':11);
  if P<>Node
    then begin
           StatCanc(P^.Numb);
           Cancel:=P^.Addr;
           if Inform>1
             then ViewNote(P);
           DelNote(P);
         end
    else if Inform>1
           then WriteLn('Head Element?!?');
end;

function CancMin(N: Integer): DataPntr;
var
  P:NotePntr;
  B: Boolean;
begin
  CancMin:=nil;
  if Inform>1
    then Write('CancMin':11);
  if SlyNode<>Node
    then begin
           if Inform>0
             then WriteLn('No List!');
         end
    else begin
           B:=False;
           P:=Node;
           repeat
             P:=P^.Next;
             if P^.Numb=N
               then B:=True;
           until (P=Node) or (B=True);
           if B=False
             then begin
                    if Inform>1
                      then WriteLn('No Event ',n:3,'in the List!');
                  end
             else begin
                    if Inform>1
                      then ViewNote(P);
                    StatCanc(N);
                    CancMin:=P^.Addr;
                    DelNote(P);
                  end;
         end;
end;

procedure PrepBefore(P: NotePntr; N: Integer; A: DataPntr);
var
  X: NotePntr;
begin
  if Inform>1
    then Write('Before':11);
  if P<>Node
    then begin
           StatPrep(N);
           X:=IncNote(P^.Prev,P,N,P^.Time,A);
           if Inform>1
             then ViewNote(X);
         end
    else if Inform>1
           then WriteLn('Head Element?!?');
end;

procedure PrepAfter(P: NotePntr; N: Integer; A: DataPntr);
var
  X: NotePntr;
begin
  if Inform>1
    then Write('After':11);
  if P<>Node
    then begin
           StatPrep(N);
           X:=IncNote(P,P^.Next,N,P^.Time,A);
           if Inform>1
             then ViewNote(X);
         end
    else if Inform>1
           then WriteLn('Head Element?!?');
end;

procedure Prepare(N: Integer; DT: Real; A: DataPntr);
var
  X: NotePntr;
begin
  if Inform>1
    then Write('Prepare':11);
  DT:=ActTime+DT;
  X:=GetNextT(DT);
  if X<>nil
    then begin
           StatPrep(N);
           X:=IncNote(X^.Prev,X,N,DT,A);
           if Inform>1
             then ViewNote(X);
         end;
end;

procedure PrepPrior(N: Integer; DT: Real; A: DataPntr);
var
  X: NotePntr;
begin
  if Inform>1
    then Write('Prior':11);
  DT:=ActTime+DT;
  if SlyNode<>Node
    then begin
           if Inform>0
             then WriteLn('No List!');
         end
    else begin
           StatPrep(N);
           X:=Node^.Next;
           while (X<>Node) and (X^.Time<DT)
             do X:=X^.Next;
           X:=IncNote(X^.Prev,X,N,DT,A);
           if Inform>1
             then ViewNote(X);
         end;
end;

function Uniform(Min,Max: Real): Real;
begin
  if Min<Max
    then Uniform:=Min+(Max-Min)*RND
    else Uniform:=Min;
end;

function Normal(M,S: Real): Real;
var
  X: Real;
  I: Integer;
begin
  X:=RND;
  for I:=1 to 11
    do X:=X+RND;
  Normal:=M+S*(X-6);
end;

function NegExp(L: Real): Real;
begin
  if L>0
    then NegExp:=-Ln(RND)/L
    else NegExp:=0;
end;

function Have(Numb: Integer): Integer;
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then Have:=Stat^[I].Exist
    else Have:=I;
end;

function Done(Numb: Integer): Real;
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then Done:=Stat^[I].Simul/Repeater
    else Done:=0;
end;

function Prep(Numb: Integer): Real;
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then Prep:=Stat^[I].Prep/Repeater
    else Prep:=0;
end;

function Canc(Numb: Integer): Real;
var
  I: Integer;
begin
  I:=GetStatI(Numb);
  if I>0
    then Canc:=Stat^[I].Canc/Repeater
    else Canc:=0;
end;

function Simulate: Boolean;
var
  P: NotePntr;
  I: Integer;
begin
  Simulate:=False;
  if Inform>0
    then Write('Simulate':11);
  if SlyNode<>Node
    then begin
           if Inform>0
             then WriteLn('No List!');
         end
    else begin
           if (Node^.Next^.Numb=0) or (Node^.Next=Node)
             then begin
                    Route:=Node^.Next;
                    while Route<>Node do begin
                                           if Route^.Addr<>nil
                                             then Dispose(Route^.Addr);
                                           P:=Route^.Next;
                                           Dispose(Route);
                                           Route:=P;
                                         end;
                    Dispose(Node);
                    if Inform>0
                      then begin
                             WriteLn('Simulation Finished!');
                             WriteLn;
                           end;
                  end
             else begin
                    ActNumb:=Node^.Next^.Numb;
                    ActTime:=Node^.Next^.Time;
                    ActAddr:=Node^.Next^.Addr;
                    if Inform>0
                      then ViewNote(Node^.Next);
                    DelNote(Node^.Next);
                    Node^.Time:=ActTime;
                    Simulate:=True;
                    I:=GetGener(ActNumb);
                    if I>0
                      then with Gener^[I]
                             do if Count>1
                                  then begin
                                         Count:=Count-1;
                                         if ID<1
                                           then Prepare(Numb,
                                                        Uniform(Param1,
                                                                Param2),nil)
                                           else if ID>1
                                                  then Prepare(Numb,
                                                               NegExp(Param1),
                                                               nil)
                                                  else Prepare(Numb,
                                                               Normal(Param1,
                                                               Param2),nil);
                                       end
                                  else Numb:=0;
                    I:=GetStatI(ActNumb);
                    if I>0
                      then begin
                             Stat^[I].Simul:=Stat^[I].Simul+1;
                             Stat^[I].Exist:=Stat^[I].Exist-1;
                           end;
                    if Inform>3
                      then ReadLn;
                  end;
         end;
end;

procedure ViewList;
var
  P: NotePntr;
begin
  Write('List:':11);
  P:=Node^.Next;
  while P<>Node
    do begin
         ViewNote(P);
         P:=P^.Next;
         Write(' ':11);
       end;
  WriteLn;
end;

procedure ViewStat;
begin
  if Stat<>nil
    then begin
           WriteLn(' Numb',' Exist',' Simul',' Prep',' Canc');
           WriteLn(Stat^[1].Numb:5,Stat^[1].Exist:6,Stat^[1].Simul:6,
                   Stat^[1].Prep:5,Stat^[1].Canc:5);
           WriteLn(Stat^[2].Numb:5,Stat^[2].Exist:6,Stat^[2].Simul:6,
                   Stat^[2].Prep:5,Stat^[2].Canc:5);
           WriteLn(Stat^[3].Numb:5,Stat^[3].Exist:6,Stat^[3].Simul:6,
                   Stat^[3].Prep:5,Stat^[3].Canc:5);
         end;
end;

begin
  Initiate;
end.