old/PAS/!SPbSTU/MSMO/CORE.PAS

unit CORE; {Ядро модели системы массового обслуживания}
                            INTERFACE
type       
 PSource  = ^CSource; {Указатель на источник}
 PDevice  = ^CDevice; {Указатель на систему обработки (устройство) }
 PBuffer  = ^CBuffer; {Указатель на буфер запросов}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

TReq = record  {Запрос на обслуживание}
  Birth : real; {Время появления запроса}
  Death : real; {Время смерти запроса (обработан, либо отклонен)}
  FromSource : PSource; {Кто просил-то ?}
  ToDevice   : PDevice; {А собственно куда ?}
end;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}


{$R-}
TReqArray = array [0..1000] of TReq;
PReqArray = ^TReqArray;
TSourceArr = array [0..1000] of PSource;
PSourceArr = ^TSourceArr;
PReq = ^TReq;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}


ESOURCES = (SOURCE_DUMMY,SOURCE_EASIEST,SOURCE_ERLANG); {Типы источников}

CSource = object   {Объект - простейший источник}
  SType : ESOURCES; {Каков наш источник? }
  Name  : integer;  {А как его зовут ?}

  LastTime : real;  {Время генерации последнего запроса}
  LastReq  : TReq;  {Последний сгенерированный запрос}

  NewTime  : real;  {Момент генерации нового запроса}
  Lambda   : real;

  TotalReq : longInt; {Общее число заявок от источника}
  DoneReq : longInt; {число обработанных заявок от источника}  
  RefusedReq:LongInt; {Число отклоненных заявок}
  WaitTime : real; {Общее время пребывания в системе}
  ProbRefuse:real; {Вероятность отказа} 
  MatWait  : real; {Математическое ожидание в буфере}

  Constructor Init(aName : Integer;aLambda:real); {Конструктор с именем}
  Procedure Reset; {Сброс всех счетчиков}
  Procedure GenNewReq; {Генерация нового запроса}
  Destructor Done;virtual;
end;{CSource}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

CDevice = object   {Объект - простейшее устойство массового обслуживания}
  LastTime : real; {Время последнего завершения обслуживания}

  BegTime  : real; {Время начала обслуживания}
  DoneTime : real; {Время, в которое закончится обработка}

  Stoppage : real; {Общее время простоя прибора}

  IsWorking : boolean; {Осуществляется ли обслуживание ?}
  CurWorking : TReq; {Текущий обрабатываемый запрос}
  Lambda   : real; 

  Constructor Init(aLambda:real); {}
  Function AddReq(aCurReq : PReq;aCurTime:real):boolean; {Начало обработка запроса}
  Procedure Reset; {Сброс устр-ва}
  Function DoneWork:PReq; {Завершение обработки текущего запроса, с его возвратом}
  Destructor Done;
end; {CDevice}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
EBuffers = (BUFFER_DUMMY, BUFFER_FIFO, BUFFER_LIFO);

CBuffer = object      {Буффер запросов}
  BufType      : EBuffers; {Тип буфера}
  BufferLength : integer; {Длина буфера}
  CellCount    : integer; {Индекс текущей свободной ячейки}
  Data         : PReqArray; {Собственно сам буфер}
  Constructor Init(aBufLen:integer); {Инициализация буфера}
  Destructor Done;virtual;{Деструктор, он и есть}
  Function SetBufferSize(aNewSize:integer):boolean;{Изменение размера буфера}
  Procedure FreeBuffer; {Освобождение всего буфера сразу}
  Function AddReq(var aNew, rKicked:TReq):boolean; {Добавляется запрос в буфер.
   Если из буфера какой-то запрос удален, то ф-ция возвр. false, и в rKicked -
   запрос, который отклонен}
  Function GetReq(var rReq:TReq):boolean;virtual; {Вытащить из буфера запрос,
        если успешно - true}
end; {CBuffer}
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

CModel = object {Наша модель СМО} 
 Sources  : PSourceArr; {Источники} 
 SourceCnt: integer;    {Число источников}
 MaxSrc   : integer;    {Размерность массива источников}

 Buffer   : PBuffer;    {Буфер}
 Device   : PDevice;    {Устройство}

 CurTime  : real;       {Текущий момент времени}
 Delta    : real;
 DovInt   : real;

 NextSource:integer;    {Какой из источников - быстрее}
 RealizSteps:LongInt;   {Необх. число реализаций}
 CurStep  : LongInt;    {Текущий шаг}
{}
 DoneCount,             {Число обработанных заявок}
 RefusedCount,           {Число отклоненных заявок}
 TotalCount : integer;  {Общее число заявок}

 Working  : boolean;    {Работает ли модель ?}
 WorkReq  : TReq;

 Constructor Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
                  aDel,aDov:Real);
 Function SetSourceCount(aNewCnt:integer):boolean; {Установка нового числа
                                              источников, с сохранением старых}
 Function AddNewSource(aNewSrc:PSource):boolean; {Добавление нового источника}
 Procedure SetNextSource; {Находит NextSource}
 Function TestVer:boolean; {}
 Function RemoveSource(aName:integer):boolean; {Удаление источника из модели}
 Procedure Reset; {Сброс всех счетчиков}
 Procedure Start;
 Procedure PrintValues(var F:TEXT);
 Function Step:boolean; {Моделирует следующий шаг, если в }
 Destructor Done;
end;
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
                        IMPLEMENTATION

Constructor CSource.Init(aName : Integer;aLambda:real);
Begin
  Name := aName;
  SType := SOURCE_EASIEST;
  Lambda := aLambda;
  Reset;
end;{CSource.Init}
{-------------------------------------------------------------------------}
Procedure CSource.Reset;
Begin
  LastTime :=0; NewTime:=0;
  TotalReq :=0;
  DoneReq :=0;
  RefusedReq:=0;
  WaitTime :=0;
  ProbRefuse:=0;
  MatWait  :=0;
end;{CSource.Reset}
{-------------------------------------------------------------------------}
Procedure CSource.GenNewReq;
Begin
  LastTime := NewTime; 
  NewTime := LastTime - Ln(Random)/Lambda;
  Inc(TotalReq);
  LastReq.Birth := NewTime;
  LastReq.Death := -1.0;
  LastReq.FromSource := @Self;
end;{CSource.GenNewReq}
{-------------------------------------------------------------------------}
Destructor CSource.Done;
begin
end;
{-------------------------------------------------------------------------}
{    CDevice    }
Constructor CDevice.Init(aLambda:real);
begin
  Lambda := aLambda;
  Reset;
end;{CDevice.Init}
{=========================================}
Procedure CDevice.Reset;
begin
  LastTime := 0;
  DoneTime := 0;
  Stoppage := 0;
  IsWorking := false;
end;{CDevice.Reset}
{---------------------------}
Function CDevice.AddReq(aCurReq : PReq;aCurTime:real):boolean; {Начало обработка запроса}
begin
  AddReq := false;
  if not isWorking then
   begin
    BegTime   := aCurTime;
    Stoppage  := Stoppage + (BegTime-LastTime);
    DoneTime  := BegTime - Ln(Random)/Lambda;
    IsWorking := true;
    CurWorking := aCurReq^;
    CurWorking.ToDevice := @Self;
    AddReq    := true;      
   end;
end;{CDevice.AddReq}
{=========================================}
Function CDevice.DoneWork:PReq; 
begin
  DoneWork := nil;
  if isWorking then   
   begin
     LastTime := DoneTime;
     CurWorking.Death := DoneTime;
     DoneWork := @CurWorking;
     isWorking := false;
   end;
end;{CDevice.DoneWork}
{=========================================}
Destructor CDevice.Done;
begin
end;{CDevice.Done}
{=========================================}

{  CBuffer  } 
Constructor CBuffer.Init(aBufLen:integer); 
begin
  BufType := BUFFER_LIFO;
  BufferLength := aBufLen;
  CellCount := 0;
  GetMem(Data,Sizeof(TReq)*BufferLength);
  FillChar(Data^,Sizeof(TReq)*BufferLength,0);
end;{CBuffer.Init}
{-----------------------}
Destructor CBuffer.Done;
begin
  FreeMem(Data,Sizeof(TReq)*BufferLength); {Dispose(data)}
  BufferLength:=0;
end;{CBuffer.Done}
{-----------------------}
Function CBuffer.SetBufferSize(aNewSize:integer):boolean;
var
 NewBuf : PReqArray;
begin
 SetBufferSize := false;
 if aNewSize > BufferLength then
  begin
   GetMem(NewBuf,Sizeof(TReq)*aNewSize);
   FillChar(NewBuf^,Sizeof(TReq)*aNewSize,0);
   Move(Data^,NewBuf^,Sizeof(TReq)*BufferLength);
   FreeMem(Data,Sizeof(TReq)*BufferLength);
   Data := NewBuf;
   BufferLength := aNewSize;
   SetBufferSize := true;
  end;
end;{CBuffer.SetBufferSize}
{-----------------------}
Function CBuffer.AddReq(var aNew, rKicked:TReq):boolean;
begin
  if CellCount=BufferLength then {На самом деле, т.к с 0, то больше}
   begin
     AddReq := false;
     rKicked := Data^[0];
     rKicked.Death := aNew.Birth; {Запрос отклонен, в момент, когда новый прибыл,
                                    т.е. когда тот был создан}
     Move(Data^[1],Data^[0], SizeOf(TReq) * (BufferLength-1));
     Data^[CellCount-1] := aNew;
   end
  else
   begin
     AddReq := true;
     Data^[CellCount] := aNew;
     Inc(CellCount);
   end;
end;{CBuffer.AddReq}
{-----------------------}
Function CBuffer.GetReq(var rReq:TReq):boolean;
begin
 GetReq := false;
 if CellCount > 0 then
  begin
   rReq := Data^[CellCount-1];
   Dec(CellCount);
   GetReq := true;
  end;
end;{CBuffer.GetReq}
{---------------------------------------------}
Procedure CBuffer.FreeBuffer;
begin
 CellCount := 0;
end;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

Constructor CModel.Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
                       aDel,aDov:Real);
Begin
  MaxSrc := aBegSrcCnt;
  GetMem(Sources,Sizeof(PSource)*MaxSrc);
  SourceCnt := 0;
  RealizSteps := 100;
  Buffer := aBuf;
  Device := aDev;
  Delta := aDel;
  DovInt := aDov;
  Reset;
end;{CModel.Init}
{---------------------------------------------------------}
Procedure CModel.Reset;
begin
  NextSource:=0;
  CurTime := 0;
  CurStep := 0;
  DoneCount := 0;
  RefusedCount := 0;
  RealizSteps := 100;
  TotalCount := 0;
  Working := false;
end;{CModel.Reset}
{------------------------------------------------------------------}
Function CModel.SetSourceCount(aNewCnt:integer):boolean;
var
 NewBuf : PSourceArr;
Begin
 SetSourceCount := false;
 if aNewCnt > MaxSrc then
  begin
   GetMem(NewBuf,Sizeof(PSource)*aNewCnt);
   Move(Sources^,NewBuf^,Sizeof(PSource)*MaxSrc);
   FreeMem(Sources,Sizeof(PSource)*MaxSrc);
   Sources := NewBuf;
   MaxSrc := aNewCnt;
   SetSourceCount := true;
  end;
end;{CModel.SetSourceCount}
{------------------------------------------------------------------}
Function CModel.AddNewSource(aNewSrc:PSource):boolean;
Begin
  if SourceCnt >= MaxSrc then AddNewSource := SetSourceCount(MaxSrc+1);
  Sources^[SourceCnt] := aNewSrc;
  Inc(SourceCnt);
end;{CModel.AddNewSource}
{------------------------------------------------------------------}
Function CModel.RemoveSource(aName:integer):boolean;
var
 c : integer;
Begin
  RemoveSource := false;
  if SourceCnt = 1 then exit;  
  for c := 0 to SourceCnt-1 do if Sources^[c]^.Name = aName then break;
  if c = SourceCnt-1 then exit;
  Dispose(Sources^[c],Done);
  while c <> SourceCnt-1 do
   begin
    Sources^[c] := Sources^[c+1];
    inc(c);
   end;
  Dec(SourceCnt);
end;{CModel.RemoveSource}
{------------------------------------------------------------------}
Procedure CModel.SetNextSource; {Находит NextSource}
var
 c      : integer;
begin
 NextSource := 0;
 for c := 0 to SourceCnt-1 do
 begin
  if (Sources^[c]^.NewTime < Sources^[NextSource]^.NewTime) then
   NextSource := c;
 end;
end;{CModel.SetNextSource}
{------------------------------------------------------------------}
Procedure CModel.Start;
var
 c,First : integer;
begin
 if (Device=nil) or (Buffer=nil) or (SourceCnt=0) then exit;
 Reset;
 Device^.Reset;
 Buffer^.FreeBuffer;

 First := 0;
 for c := 0 to SourceCnt-1 do
 begin
  Sources^[c]^.Reset;
  Sources^[c]^.GenNewReq;
  if (Sources^[c]^.NewTime < Sources^[First]^.NewTime) then
    First := c;
 end;
 WorkReq := Sources^[First]^.LastReq;
 Device^.AddReq(@WorkReq,Sources^[First]^.NewTime);
 Sources^[First]^.GenNewReq;

 SetNextSource;

 Working := true;
end;
{------------------------------------------------------------------}
Function CModel.TestVer:boolean;
var
 NewV,c,p:real;
 i : integer;
begin
 NewV:=0;
 TestVer:=true;
 for i := 0 to SourceCnt-1 do if Sources^[i]^.RefusedReq <> 0 then
  begin
   p := 1.0 * Sources^[i]^.RefusedReq / Sources^[i]^.TotalReq;
   c := (DovInt*(1-p))/(Delta*Delta*p);
   if c > NewV then NewV := c;
  end;
 if NewV > RealizSteps then
  begin
   RealizSteps := round(NewV);
   TestVer := false;
  end;
end;{CModel.TextVer}
{------------------------------------------------------------------}
Function CModel.Step:boolean;
var
 Kicked : TReq;
 i      : integer;
 ret    : boolean;
Begin
 Step := false;
 if Not Working then exit;
 ret := false; {Считаем, что продолжать не будем}

 for i:=0 to SourceCnt-1 do if Sources^[i]^.TotalReq < RealizSteps then
   ret:=true;

 if not ret then ret := not TestVer;
  if Device^.DoneTime < Sources^[NextSource]^.NewTime then
   begin
    CurTime := Device^.DoneTime;
    WorkReq := Device^.DoneWork^;
    inc(DoneCount);
    inc(TotalCount);
    inc(WorkReq.FromSource^.DoneReq);

    WorkReq.FromSource^.WaitTime := WorkReq.FromSource^.WaitTime +
      WorkReq.Death - WorkReq.Birth;

    if Buffer^.GetReq(WorkReq) then
     begin {В буфере находилась заявка}
       WorkReq.FromSource^.MatWait := WorkReq.FromSource^.MatWait +
        CurTime-WorkReq.Birth;
       Device^.AddReq(@WorkReq,CurTime);
     end
    else {Need to gen new req}
     begin
       Device^.AddReq(@Sources^[NextSource]^.LastReq,Sources^[NextSource]^.LastReq.Birth);
       Sources^[NextSource]^.GenNewReq;
       SetNextSource;
     end;
   end
  else {Ближайшее событие - генерация запроса}
   begin
     CurTime := Sources^[NextSource]^.NewTime;
     if not Buffer^.AddReq(Sources^[NextSource]^.LastReq,Kicked) then
      begin
        inc(Kicked.FromSource^.RefusedReq);

        {Kicked.FromSource^.WaitTime := Kicked.FromSource^.WaitTime +
         Kicked.Death-Kicked.Birth;}

        Inc(RefusedCount);
        Inc(TotalCount);
      end;
     Sources^[NextSource]^.GenNewReq;
     SetNextSource;
   end; {}
 inc(CurStep);
 Step := ret;
end;{CModel.Step}
{------------------------------------------------------------------}
Procedure CModel.PrintValues(var F:Text);
var
 i : integer;
begin
  WriteLn(F,'Отн. точность - ',Delta*100:0:0,'%, дов. инт в кв. - ',DovInt:0:2);
  WriteLn(F,'Хар-ка потока прибора - ', Device^.Lambda:0:2);
  WriteLn(F,'Ист.|Всг заяв.|Отк заяв.|Вып заяв.|P отк.  |Мат. ож | Общ. вр.');
  for i := 0 to SourceCnt-1 do with Sources^[i]^ do
  begin
    write(F,Name:4,' ',TotalReq:9,' ',RefusedReq:9,' ',DoneReq:9,' ',100.0*RefusedReq/TotalReq:6:2,'%  ');
    if DoneReq <> 0 then Write(F,MatWait/DoneReq:8:3,' ') else Write(F,'  ---    ');
    WriteLN(F,WaitTime:0:2);
  end;
  WriteLn(F,'Коэффициент простоя прибора - ',100*Device^.Stoppage/CurTime:0:2,'%');
  WriteLN(F,'---')
end;{CModel.PrintValues}
{------------------------------------------------------------------}
Destructor CModel.Done;
var
 c : integer;
Begin
  for c:= 0 to SourceCnt-1 do Dispose(Sources^[c],Done);
  FreeMem(Sources,Sizeof(PSource)*MaxSrc);
end;{CModel.Done}
{------------------------------------------------------------------}
END. {EOF}