2015-05-20
454
unit U_Base;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, Spin, TeEngine, Series, ExtCtrls, TeeProcs,
Chart, Buttons, Math, BubbleCh;
CONST MaxN = 100;
MaxR = 100;
type
TBase = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
n: TSpinEdit;
tzSG: TStringGrid;
Button1: TButton;
zSG: TStringGrid;
GroupBox2: TGroupBox;
Label4: TLabel;
Label5: TLabel;
M_Label: TLabel;
D_Label: TLabel;
Chart1: TChart;
Series1: TBarSeries;
Label6: TLabel;
Label7: TLabel;
Memo1: TMemo;
Memo2: TMemo;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
Erlang_Label: TLabel;
Label3: TLabel;
FkStepEdit: TEdit;
Chart2: TChart;
Series2: TLineSeries;
Label10: TLabel;
GraphMinEdit: TEdit;
Label11: TLabel;
GraphMaxEdit: TEdit;
Chart3: TChart;
LineSeries1: TLineSeries;
Label2: TLabel;
IntegralEdit: TEdit;
Series3: TLineSeries;
Series4: TLineSeries;
Panel1: TPanel;
x2Label: TLabel;
GroupBox3: TGroupBox;
Label8: TLabel;
Edit1: TEdit;
Label9: TLabel;
Edit2: TEdit;
Label12: TLabel;
Edit3: TEdit;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Edit5: TEdit;
Label16: TLabel;
Edit6: TEdit;
Label17: TLabel;
Label18: TLabel;
Edit4: TEdit;
Label19: TLabel;
Edit7: TEdit;
Label20: TLabel;
Label21: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Label22: TLabel;
Edit8: TEdit;
Button2: TButton;
Button3: TButton;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label27: TLabel;
Label26: TLabel;
Label28: TLabel;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
Label36: TLabel;
Label37: TLabel;
Label38: TLabel;
Label39: TLabel;
Edit9: TEdit;
Label40: TLabel;
Edit10: TEdit;
MoveCheck: TCheckBox;
Label41: TLabel;
Edit11: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure nChange(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
procedure RandomTz;
procedure Calculate;
procedure ReDraw;
procedure ReDrawResults;
function Factorial(Argument:Integer):Extended;
function ErlangF(Order: integer; Argument:Real): Extended;
function ErlangFNorm(Order: integer; Argument:Real): Extended;
function ErlangIntegral(a,b: Real; Step:Real): Extended;
function ErlangIntegralNorm(a,b: Real; Step:Real): Extended;
function Erlang1stF(Argument:Real):Real;
function Erlang1stFNorm(Argument:Real):Real;
function ErlangRandom(Lambda:Real; Order: integer):Real;
procedure Modeling;
//procedure Simulate;
end;
var
Base: TBase;
Tz: array [1..MaxN] of real; // моменты поступления заявок
z: array [1..MaxN-1] of real; // интервалы
Kz: array [1..MaxN-1] of integer;// Интервалы гистограммы
k: integer;
m,d,klen, zmin, zmax: real; // Мат ож., Дисперсия, пар-ры гистограммы
Intensivity: real; // Интенсивность
StreamOrder: integer; // Порядок потока
FkStep, GraphMin, GraphMax: real; // Пар-ры графиков
IntegralStep: real; // Шаг интегрирования
X2: real; // Параметр ХИ-2 распределения
SimulationStep: real; // Шаг симуляции
SimulateON: boolean; // Включение симуляции
MaxAppearedQrLen: integer; // Макс. появившаяся длина очереди
QrCnt1: array [1..MaxR] of integer; // Кол-во пришедших заявок
QrCnt2: array [1..MaxR] of integer;
QrServCnt1: array [1..MaxR] of integer; // Кол-во обслуженных заявок
QrServCnt2: array [1..MaxR] of integer;
QrServTime1: array [1..MaxR] of real; // Общее время обслуживания заявок
QrServTime2: array [1..MaxR] of real;
QrRejbyWaitCnt1: array [1..MaxR] of integer; // Кол-во отказов из-за ожидания
QrRejbyWaitCnt2: array [1..MaxR] of integer;
QrRejbyMaxLCnt1: array [1..MaxR] of integer; // Кол-во отказов из-за забитости очереди
QrRejbyMaxLCnt2: array [1..MaxR] of integer;
QrWaitTime1: array [1..MaxR] of real; // Общее время ожидания обслуживания
QrWaitTime2: array [1..MaxR] of real;
Sr_QrCnt1, Sr_QrCnt2: integer; // Усредненные величины
Sr_QrServCnt1, Sr_QrServCnt2: integer;
Sr_QRServTime1, Sr_QrServTime2: real;
Sr_QrRejbyWaitCnt1, Sr_QrRejbyWaitCnt2: integer;
Sr_QrRejbyMaxLCnt1, Sr_QrRejbyMaxLCnt2: integer;
Sr_QrWaitTime1, Sr_QrWaitTime2: real;
State_NewQueryToLine1: boolean; // Флаг "Новая заявка --> Линия 1"
State_NewQueryToLine2: boolean; // Флаг "Новая заявка --> Линия 2"
State_NewQueryReject: boolean; // Флаг "Новая заявка --> отказ"
State_NewQueryToQr: boolean; // Флаг "Новая заявка --> очередь"
State_FromQrReject: boolean; // Флаг "Из очереди --> отказ"
State_FromQrToLine1: boolean; // Флаг "Из очереди --> Линия 1"
State_FromQrToLine2: boolean; // Флаг "Из очереди --> Линия 1"
function FloatToStr(x: real): string;
implementation
uses U_Simulate;
{$R *.dfm}
function FloatToStr(x: real): string;
var q: integer;
begin
result:=SysUtils.FloatToStr(x);
q:=POS(',',result);
If q<>0 then
begin
Delete(result,q,1);
Insert('.',result,q);
end;
if length(result)>q+3 then SetLength(result,q+3);
end;
procedure TBase.FormCreate(Sender: TObject);
begin
n.Value:=50;
StreamOrder:=0;
Randomize;
RandomTz;
ReDraw;
end;
procedure TBase.RandomTz;
var q: integer;
begin
Tz[1]:=0;
for q:=2 to n.Value do Tz[q]:=Tz[q-1]+Random(100)/10+1;
end;
function TBase.Factorial(Argument:Integer):Extended;
var q: integer;
begin
Result:=1;
For q:=2 to Argument do Result:=Result*q;
end;
// Функция распределения для потока Эрланга k-го порядка
function TBase.ErlangF(Order: integer; Argument:Real): Extended;
var TempParam,Value:Extended;
begin
TempParam:=Intensivity{*(Order+1)};
Result:=TempParam*Power(TempParam*Argument,Order)*Exp(-TempParam*Argument);
Result:=Result/Factorial(Order);
end;
// Нормированная Функция распределения для потока Эрланга k-го порядка
function TBase.ErlangFNorm(Order: integer; Argument:Real): Extended;
var TempParam,Value:Extended;
begin
TempParam:=Intensivity*(Order+1);
Result:=TempParam*Power(TempParam*Argument,Order)*Exp(-TempParam*Argument);
Result:=Result/Factorial(Order);
end;
// Расчет интеграла по функции распределения Эрланга
function TBase.ErlangIntegral(a,b: Real; Step:Real): Extended;
var sum,x: real;
begin
sum:=0;
x:=a;
While x<=b do
begin
sum:=sum+(Step * ErlangF(StreamOrder, x+Step/2));
x:=x+Step;
end;
result:=sum;
end;
// Расчет интеграла по нормированной функции распределения Эрланга
function TBase.ErlangIntegralNorm(a,b: Real; Step:Real): Extended;
var sum,x: real;
begin
sum:=0;
x:=a;
While x<=b do
begin
sum:=sum+(Step * ErlangFNorm(StreamOrder, x+Step/2));
x:=x+Step;
end;
result:=sum;
end;
// 1st interval
function TBase.Erlang1stF(Argument:Real):Real;
begin
Result:=Intensivity*(1-ErlangIntegral(0,Argument,IntegralStep));
end;
function TBase.Erlang1stFNorm(Argument:Real):Real;
begin
Result:=Intensivity*(StreamOrder+1)*(1-ErlangIntegralNorm(0,Argument,IntegralStep));
end;
// Случайный поток Эрланга k-го порадка
function TBase.ErlangRandom(Lambda:Real; Order: integer):Real;
var
R:Real;
q: integer;
begin
Result:=0;
For q:=0 to Order do Result:=Result + (-Lambda)*Ln(Random);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TBase.Calculate;
var q, err, sum, w: integer;
begin
// Mean
m:=0; For q:=1 to n.Value-1 do m:=m+z[q]; m:=m/(n.Value-1);
// Variance
d:=0; For q:=1 to n.Value-1 do d:=d+SQR(z[q]-m); d:=d/(n.Value-1);
// Gistogramm
zmin:=z[1]; For q:=2 to n.Value-1 do if zmin>z[q] then zmin:=z[q];
zmax:=z[1]; For q:=2 to n.Value-1 do if zmax<z[q] then zmax:=z[q]; zmax:=zmax+0.01;
k:= TRUNC(1 + 3 * LN(n.Value)); klen:=(zmax-zmin)/k;
// Intensivity
intensivity:=1/m;
// StreamOrder
StreamOrder:=Round(1/(d*Sqr(Intensivity)) {-1});
If StreamOrder<0 then StreamOrder:=0;
// Get FkStep
VAL(FkStepEdit.Text,FkStep,err); if err<>0 then FkStep:=0.1;
VAL(GraphMinEdit.Text,GraphMin,err); if err<>0 then GraphMin:=0;
VAL(GraphMaxEdit.Text,GraphMax,err); if err<>0 then GraphMax:=100;
VAL(IntegralEdit.Text,IntegralStep,err); if err<>0 then IntegralStep:=0.1;
// X2 - check
X2:=0;
for q:=1 to k do
begin
sum:=0;
for w:=1 to n.Value-1 do
if (z[w]>=(q-1)*klen + zmin) AND (z[w]<(q)*klen + zmin) then INC(sum);
Kz[q]:=sum;
X2:=X2 + SQR(sum - (N.Value-1)*ErlangF(StreamOrder,(q-0.5)*klen + zmin)) /
(N.Value-1)*ErlangF(StreamOrder,(q-0.5)*klen + zmin);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TBase.ReDraw;
var q: integer;
begin
If n.Text='' then exit;
For q:=1 to n.Value-1 do z[q]:=tz[q+1]-tz[q];
tzSG.RowCount:=n.Value;
for q:=1 to n.Value do
begin
tzSG.Cells[0,q-1]:=IntToStr(q);
tzSG.Cells[1,q-1]:=FloatToStr(Tz[q]);
end;
zSG.RowCount:=n.Value-1;
for q:=1 to n.Value-1 do
begin
zSG.Cells[0,q-1]:=IntToStr(q)+' - '+IntToStr(q+1);
zSG.Cells[1,q-1]:=FloatToStr(z[q]);
end;
{Chart4.Series[0].AddValue (1);
Chart4.Series[0].AddValue (4);
Chart4.Series[0].AddValue (8);
Chart4.Series[0].AddValue (2);
}
end;
procedure TBase.ReDrawResults;
var q, w: integer;
begin
M_Label.Caption:=FloatToStr(m);
D_Label.Caption:=FloatToStr(d);
// Gistogramm
Chart1.Series[0].Clear;
Label6.Caption:=FloatToStr(zmin);
Label7.Caption:=FloatToStr(zmax);
for q:=1 to k do
begin
Chart1.Series[0].AddXY (q, Kz[q]/(n.Value-1));
end;
Erlang_Label.Caption:='Порядок потока Эрланга ' + IntToStr(StreamOrder);
X2Label.Caption:='x2 ' + FloatToStr(X2);
// Erlang
Chart2.Series[0].Clear;
Chart2.Series[1].Clear;
w:=Round((GraphMax-GraphMin)/FkStep);
for q:=0 to w do
begin
Chart2.Series[0].AddXY (GraphMin+q*FkStep, ErlangF(StreamOrder,GraphMin+q*FkStep));
Chart2.Series[1].AddXY (GraphMin+q*FkStep, ErlangFNorm(StreamOrder,GraphMin+q*FkStep));
end;
// Erlang 1st interval
Chart3.Series[0].Clear;
Chart3.Series[1].Clear;
for q:=0 to w do
begin
Chart3.Series[0].AddXY (GraphMin+q*FkStep, Erlang1stF(GraphMin+q*FkStep));
Chart3.Series[1].AddXY (GraphMin+q*FkStep, Erlang1stFNorm(GraphMin+q*FkStep));
end;
end;
procedure TBase.Button1Click(Sender: TObject);
begin
ReDraw;
Calculate;
ReDrawResults;
end;
procedure TBase.nChange(Sender: TObject);
begin
ReDraw;
end;
procedure TBase.SpeedButton3Click(Sender: TObject);
begin
RandomTz;
ReDRaw;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TBase.Modeling;
var w,err: integer;
QType: byte; // Тип поступившей заявки
CurT, nextT: real; // Текущее время и время прибытия следующей заявки
NextStateT, dt: real; // Время следующего состояния, dt
temptime: real;
temptype: byte;
CurStream: integer;
CurSrTime: real;
Qr: array of real; // Очередь (время)
QrType: array of byte; // Очередь (Тип заявки)
Line1Free, Line2Free: boolean; // Флаги свободы линий
Line1TimeOut, Line2TimeOut: real; // Время освобождения линии
Line1QType, Line2QType: byte; // Тип заявок в линиях
QrWaitExpires: real; // Время отказа заявки в очереди
MaxQrT1, MaxQrT2: real; // Макс. время нахождения заявки в очереди
RN: integer; // Кол-во реализаций
RCur: integer; // Текущая реализация
RT: real; // Длительность реализации
MaxQrLen: integer; // Макс. длина очереди
I1, I2: real; // Интенсивности обработки заявок
I1Time, I2Time: real; // Соответственно, время обработки заявок
FromQrRejN: integer;
mainstep: integer;
////////////////////////////////////////////////////////////////////////////
// С И М У Л Я Ц И Я
PROCEDURE Simulate;
VAR q: integer;
col: byte;
temptime, tempmax: real;
w1,w2: integer;
rcsize, rcx, rcy, rctext, rcrow: integer;
tx,ty, txstep, tystep: real;
rccolor: TColor;
begin
rcsize:=25;
rcx:=40;
rcy:=40;
rctext:=15;
rcrow:=10;
//mainstep:=7000;
With SimulateForm.MI do
begin
If MoveCheck.Checked then
BEGIN
if State_NewQueryToLine1 then
begin
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(300,300,90,260, mainstep, rcsize, rccolor);
end;
if State_NewQueryToLine2 then
begin
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(300,300,210,260, mainstep, rcsize, rccolor);
end;
if State_NewQueryToQr then
begin
w1:=(Length(Qr)-1) mod rcrow;
w2:=(Length(Qr)-1) div rcrow;
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(300,300,20+rcx*w1,40+rcy*w2, mainstep, rcsize, rccolor);
end;
if State_NewQueryReject then
begin
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(300,300,500,300, mainstep, rcsize, rccolor);
end;
if State_FromQrReject then
begin
w1:=FromQrRejN mod rcrow;
w2:=FromQrRejN div rcrow;
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(20+rcx*w1,40+rcy*w2,500,300, mainstep, rcsize, rccolor);
end;
if State_FromQrToLine1 then
begin
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(20,40,90,260, mainstep, rcsize, rccolor);
end;
if State_FromQrToLine2 then
begin
if QType=1 then rccolor:=RGB(250,0,0)
else rccolor:=RGB(0,250,0);
SimulateForm.DrawAnimation(20,40,210,260, mainstep, rcsize, rccolor);
end;
END;
//
//
//
// отображаем очередь
For q:=0 to MaxQrLen-1 do
if q<Length(Qr) then
begin
w1:=q mod rcrow;
w2:=q div rcrow;
temptime:=CurT-Qr[q];
if QrType[q]=1 then tempmax:=MaxQrT1 else tempmax:=MaxQrT2;
col:=Round (150 * (1-temptime/tempmax))+100;
if QrType[q]=1 then Canvas.Brush.Color:=RGB(col,0,0)
else Canvas.Brush.Color:=RGB(0,col,0);
Canvas.Ellipse(20+rcx*w1,40+rcy*w2,20+rcx*w1+ rcsize,40+rcy*w2+ rcsize);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(20+rcx*w1,40+rcy*w2-rctext,FloatToStr(tempmax-temptime));
end
else
begin
w1:=q mod rcrow;
w2:=q div rcrow;
Canvas.Brush.Color:=0;
Canvas.Ellipse(20+rcx*w1,40+rcy*w2,20+rcx*w1+ rcsize,40+rcy*w2+ rcsize);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(20+rcx*w1,40+rcy*w2-rctext,' ');
end;
// отображаени обработчик 1
if Line1Free then
begin
Canvas.Brush.Color:=0;
Canvas.Ellipse(50,220,130,300);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(50,200,' ');
end
else
begin
temptime:=Line1TimeOut-CurT;
if Line1QType=1 then tempmax:=I1Time else tempmax:=I2Time;
col:=Round (150 * (1-temptime/tempmax))+100;
if Line1QType=1 then Canvas.Brush.Color:=RGB(col,0,0)
else Canvas.Brush.Color:=RGB(0,col,0);
Canvas.Ellipse(50,220,130,300);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(50,200,FloatToStr(temptime));
end;
// отображаени обработчик 2
if Line2Free then
begin
Canvas.Brush.Color:=0;
Canvas.Ellipse(170,220,250,300);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(170,200,' ');
end
else
begin
temptime:=Line2TimeOut-CurT;
if Line2QType=1 then tempmax:=I1Time else tempmax:=I2Time;
col:=Round (150 * (1-temptime/tempmax))+100;
if Line2QType=1 then Canvas.Brush.Color:=RGB(col,0,0)
else Canvas.Brush.Color:=RGB(0,col,0);
Canvas.Ellipse(170,220,250,300);
Canvas.Brush.Color:=clBtnFace;
Canvas.TextOut(170,200,FloatToStr(temptime));
end;
end;
SimulateForm.Label2.Caption:='Реализация '+ FloatToStr(RCur);
SimulateForm.Label1.Caption:='Время '+ FloatToStr(CurT);
WITH SimulateForm do
begin
Label23.Caption:='Количество пришедших заявок '+IntToStr(QrCnt1[RCur]+QrCnt2[RCur]);
Label24.Caption:='1ого рода '+IntToStr(QrCnt1[RCur]);
Label25.Caption:='2ого рода '+IntToStr(QrCnt2[RCur]);
Label27.Caption:='Макс. возникшая длина очереди '+IntToStr(MaxAppearedQrLen);
Label30.Caption:='Количество обслуженных заявок '+IntToStr(QrServCnt1[RCur]+QrServCnt2[RCur]);
Label28.Caption:='1ого рода '+IntToStr(QrServCnt1[RCur]);
Label29.Caption:='2ого рода '+IntToStr(QrServCnt2[RCur]);
Label26.Caption:='Общее время обслуживания заявок '+FloatToStr(QrServTime1[RCur]+QrServTime2[RCur]);
Label31.Caption:='1ого рода '+FloatToStr(QrServTime1[RCur]);
Label32.Caption:='2ого рода '+FloatToStr(QrServTime2[RCur]);
if (QrServCnt1[RCur]<>0) AND (QrServCnt2[RCur]<>0) then
begin
Label33.Caption:='Среднее время ожидания заявкой ' +
FloatToStr((QrWaitTime1[RCur]/QrServCnt1[RCur] + QrWaitTime2[RCur]/QrServCnt2[RCur]) /2);
Label34.Caption:='1ого рода '+FloatToStr(QrWaitTime1[RCur]/QrServCnt1[RCur]);
Label35.Caption:='2ого рода '+FloatToStr(QrWaitTime2[RCur]/QrServCnt2[RCur]);
end;
Label36.Caption:='Количество отказов (вс./оч.) '+
IntToStr(QrRejByMaxLCnt1[RCur] + QrRejByWaitCnt1[RCur] +
QrRejByMaxLCnt2[RCur] + QrRejByWaitCnt2[RCur]) +
' / '+IntToStr(QrRejByMaxLCnt1[RCur] + QrRejByMaxLCnt2[RCur]);
Label37.Caption:='1ого рода '+
IntToStr(QrRejByMaxLCnt1[RCur] + QrRejByWaitCnt1[RCur]) +
' / '+IntToStr(QrRejByMaxLCnt1[RCur]);
Label38.Caption:='2ого рода '+
IntToStr(QrRejByMaxLCnt2[RCur] + QrRejByWaitCnt2[RCur]) +
' / '+IntToStr(QrRejByMaxLCnt2[RCur]);
end;
Application.ProcessMessages;
end;
////////////////////////////////////////////////////////////////////////////
// Функция определения время отказа заяыки в очереди
function SingleQrWaitExpires(n: integer): real;
var q: integer;
begin
if QrType[n]=1 then result:=MaxQrT1+Qr[n]
else result:=MaxQrT2+Qr[n];
end;
// Процедура определения минимального времени выхода заяки из очереди
function GetQrTimeOut: real;
var q: integer;
min, temp: real;
begin
if Length(Qr)=0 then exit;
min:=SingleQrWaitExpires(0);
for q:=1 to Length(Qr)-1 do
begin
temp:=SingleQrWaitExpires(q);
if temp < min then min:=temp;
end;
QrWaitExpires:=min;
end;
// Процедура выхода заявки из очереди
function QueryGo(n: integer): byte;
var q: integer;
begin
result:=QrType[n];
for q:=n+1 to Length(Qr)-1 do
begin
Qr[q-1]:=Qr[q];
QrType[q-1]:=QrType[q];
end;
SetLength(Qr,Length(Qr)-1);
SetLength(QrType,Length(Qr));
end;
begin
// Считывание данных
VAL(Edit1.Text,RN,err); if err<>0 then exit; if RN>MaxR then RN:=MaxR;
VAL(Edit2.Text,RT,err); if err<>0 then exit;
VAL(Edit3.Text,MaxQrLen,err); if err<>0 then exit;
VAL(Edit5.Text,I1,err); if err<>0 then exit;
VAL(Edit6.Text,I2,err); if err<>0 then exit;
I1Time:=1/I1; Label20.Caption:='/ вр. '+FloatToStr(I1Time);
I2Time:=1/I2; Label21.Caption:='/ вр. '+FloatToStr(I2Time);
VAL(Edit4.Text,MaxQrT1,err); if err<>0 then exit;
VAL(Edit7.Text,MaxQrT2,err); if err<>0 then exit;
VAL(Edit8.Text,SimulationStep,err); if err<>0 then exit;
VAL(Edit9.Text,CurSrTime,err); if err<>0 then exit;
VAL(Edit10.Text,CurStream,err); if err<>0 then exit;
VAL(Edit11.Text,mainstep,err); if err<>0 then exit;
// Усредненные величины
Sr_QrCnt1:=0; Sr_QrCnt2:=0;
Sr_QrServCnt1:=0; Sr_QrServCnt2:=0;
Sr_QRServTime1:=0; Sr_QrServTime2:=0;
Sr_QrRejbyWaitCnt1:=0; Sr_QrRejbyWaitCnt2:=0;
Sr_QrRejbyMaxLCnt1:=0; Sr_QrRejbyMaxLCnt2:=0;
Sr_QrWaitTime1:=0; Sr_QrWaitTime2:=0;
MaxAppearedQrLen:=0;
// Начало цикла по всем реализациям
For RCur:=1 to RN do
BEGIN
// Сброс на начальное состояние
QrCnt1[RCur]:=0;
QrCnt2[RCur]:=0;
QrServCnt1[RCur]:=0;
QrServCnt2[RCur]:=0;
QrServTime1[RCur]:=0;
QrServTime2[RCur]:=0;
QrRejbyWaitCnt1[RCur]:=0;
QrRejbyWaitCnt2[RCur]:=0;
QrRejbyMaxLCnt1[RCur]:=0;
QrRejbyMaxLCnt2[RCur]:=0;
QrWaitTime1[RCur]:=0;
QrWaitTime2[RCur]:=0;
State_NewQueryToLine1:=false;
State_NewQueryToLine2:=false;
State_NewQueryReject:=false;
State_NewQueryToQr:=false;
State_FromQrReject:=false;
State_FromQrToLine1:=false;
State_FromQrToLine2:=false;
CurT:=0;
nextT:=ErlangRandom(CurSrTime,CurStream);
Line1Free:=true;
Line2Free:=true;
SetLength(Qr,0);
SetLength(QrType,0);
QrWaitExpires:=0;
Line1TimeOut:=0;
Line2TimeOut:=0;
While CurT < RT do
// Время пошло:)
begin
// ЛИНИЯ 1 ОСВОБОДИЛАСЬ
if (NOT Line1Free) AND (CurT >= Line1TimeOut) then
begin
// Увеличиваем кол-во и время обслуженных заявок
If Line1QType=1 then INC(QrServCnt1[RCur]) else INC(QrServCnt2[RCur]);
if Line1QType=1 then QrServTime1[RCur]:=QrServTime1[RCur]+I1Time
else QrServTime2[RCur]:=QrServTime2[RCur]+I2Time;
if Length(Qr)<>0 then
// Очередь не пуста, поэтому в линию поступает заявка из очереди
begin
temptime:=Qr[0];
QType:=QueryGo(0); // выпускаем заявку из очереди
GetQrTimeOut;
if QType=1 then Line1TimeOut:=CurT + I1Time
else Line1TimeOut:=CurT + I2Time;
Line1QType:=QType;
// Увеличиваем Время ожидания
if Line1QType=1 then QrWaitTime1[RCur]:=QrWaitTime1[RCur]+(CurT-temptime)
else QrWaitTime2[RCur]:=QrWaitTime2[RCur]+(CurT-temptime);
State_FromQrToLine1:=TRUE;
end else
// Очередь пуста
begin
Line1Free:=true;
end;
end;
// ЛИНИЯ 2 ОСВОБОДИЛАСЬ
if (NOT Line2Free) AND (CurT >= Line2TimeOut) then
begin
// Увеличиваем кол-во и время обслуженных заявок
If Line2QType=1 then INC(QrServCnt1[RCur]) else INC(QrServCnt2[RCur]);
if Line2QType=1 then QrServTime1[RCur]:=QrServTime1[RCur]+I1Time
else QrServTime2[RCur]:=QrServTime2[RCur]+I2Time;
if Length(Qr)<>0 then
// Очередь не пуста, поэтому в линию поступает заявка из очереди
begin
temptime:=Qr[0];
QType:=QueryGo(0); // выпускаем заявку из очереди
GetQrTimeOut;
if QType=1 then Line2TimeOut:=CurT + I1Time
else Line2TimeOut:=CurT + I2Time;
Line2QType:=QType;
// Увеличиваем Время ожидания
if Line2QType=1 then QrWaitTime1[RCur]:=QrWaitTime1[RCur]+(CurT-temptime)
else QrWaitTime2[RCur]:=QrWaitTime2[RCur]+(CurT-temptime);
State_FromQrToLine2:=TRUE;
end else
// Очередь пуста
begin
Line2Free:=true;
end;
end;
// ВРЕМЯ ПРОБЫВАНИЯ ЗАЯВКИ В ОЧЕРЕДИ ИСТЕКЛО
if (Length(Qr)>0) AND ((CurT >= QrWaitExpires)) then
begin
w:=0;
For w:=0 to Length(Qr)-1 do
if (CurT >= SingleQrWaitExpires(w)) then
begin
temptype:=QrType[w];
// Увеличиваем время отказа
if temptype=1 then INC(QrRejbyWaitCnt1[RCur]) else INC(QrRejbyWaitCnt2[RCur]);
QType:=QrType[w];
QueryGo(w);
State_FromQrReject:=TRUE;
FromQrRejN:=w;
break;
end;
GetQrTimeOut;
end;
// ПРИШЛА ЗАЯВКА
if CurT >= nextT then
begin
// Обработка поступившей заявки
QType:=RANDOM(2)+1; // Тип заявки
// Увеличиваем число поступивших заявок
If QType = 1 then INC(QrCnt1[RCur]) else INC(QrCnt2[RCur]);
If Line1Free then
// Линия 1 Свободна
begin
Line1Free:=false;
if QType=1 then Line1TimeOut:=CurT + I1Time
else Line1TimeOut:=CurT + I2Time;
Line1QType:=QType;
State_NewQueryToLine1:=TRUE;
end else
If Line2Free then
// Линия 2 Свободна
begin
Line2Free:=false;
if QType=1 then Line2TimeOut:=CurT + I1Time
else Line2TimeOut:=CurT + I2Time;
Line2QType:=QType;
State_NewQueryToLine2:=TRUE;
end else
// Обе линии заняты
begin
w:=Length(Qr);
if w=MaxQrLen then
// Очередь забита полностью - ОТКАЗ:(
begin
State_NewQueryReject:=TRUE;
// Увеличиваем число отказов из-за забитости очереди
If QType = 1 then INC(QrRejbyMaxLCnt1[RCur]) else INC(QrRejbyMaxLCnt2[RCur]);
end
// Помещаем заявку в очередь
else
begin
SetLength(Qr,w+1);
SetLength(QrType,w+1);
Qr[w]:=CurT;
QrType[w]:=QType;
If Length(Qr)>MaxAppearedQrLen then MaxAppearedQrLen:=Length(Qr);
State_NewQueryToQr:=TRUE;
GetQrTimeOut;
end;
end;
// Определение следующей заявки
nextT:=CurT+ErlangRandom(CurSrTime,CurStream);
end;
// Определяем шаг времени, чтобы попасть в следующее состояние системы
NextStateT:=NextT;
if Length(Qr)>0 then NextStateT:=MIN(NextStateT,QrWaitExpires);
if NOT Line1Free then NextStateT:=MIN(NextStateT,Line1TimeOut);
if NOT Line2Free then NextStateT:=MIN(NextStateT,Line2TimeOut);
if SimulateON then
begin
dt:=MIN(NextStateT-CurT, SimulationStep);
Simulate;
Application.ProcessMessages;
if SimulateForm.StopButton.Down then
begin
SimulateForm.StopButton.Down:=false;
SimulateForm.PauseButton.Down:=false;
SimulateForm.Close;
EXIT;
end;
Repeat Application.ProcessMessages; Until NOT SimulateForm.PauseButton.Down;
CurT:=CurT+dt;
end
else CurT:=NextStateT;
State_NewQueryToLine1:=false;
State_NewQueryToLine2:=false;
State_NewQueryReject:=false;
State_NewQueryToQr:=false;
State_FromQrReject:=false;
State_FromQrToLine1:=false;
State_FromQrToLine2:=false;
end;
END;
////////////////////////////////////////////////////////////////////////////
// Подсчет средних значений
For RCur:=1 to RN do
begin
Sr_QrCnt1:=Sr_QrCnt1+ QrCnt1[RCur];
Sr_QrCnt2:=Sr_QrCnt2+ QrCnt2[RCur];
Sr_QrServCnt1:=Sr_QrServCnt1+ QrServCnt1[RCur];
Sr_QrServCnt2:=Sr_QrServCnt2+ QrServCnt2[RCur];
Sr_QRServTime1:=Sr_QRServTime1+ QRServTime1[RCur];
Sr_QrServTime2:=Sr_QRServTime2+ QRServTime2[RCur];
Sr_QrRejbyWaitCnt1:=Sr_QrRejbyWaitCnt1+ QrRejbyWaitCnt1[RCur];
Sr_QrRejbyWaitCnt2:=Sr_QrRejbyWaitCnt2+ QrRejbyWaitCnt2[RCur];
Sr_QrRejbyMaxLCnt1:=Sr_QrRejbyMaxLCnt1+ QrRejbyMaxLCnt1[RCur];
Sr_QrRejbyMaxLCnt2:=Sr_QrRejbyMaxLCnt2+ QrRejbyMaxLCnt2[RCur];
Sr_QrWaitTime1:=Sr_QrWaitTime1+ QrWaitTime1[RCur];
Sr_QrWaitTime2:=Sr_QrWaitTime2+ QrWaitTime2[RCur];
end;
Sr_QrCnt1:=Sr_QrCnt1 div RN;
Sr_QrCnt2:=Sr_QrCnt2 div RN;
Sr_QrServCnt1:=Sr_QrServCnt1 div RN;
Sr_QrServCnt2:=Sr_QrServCnt2 div RN;
Sr_QRServTime1:=Sr_QRServTime1 /RN;
Sr_QrServTime2:=Sr_QRServTime2 /RN;
Sr_QrRejbyWaitCnt1:=Sr_QrRejbyWaitCnt1 div RN;
Sr_QrRejbyWaitCnt2:=Sr_QrRejbyWaitCnt2 div RN;
Sr_QrRejbyMaxLCnt1:=Sr_QrRejbyMaxLCnt1 div RN;
Sr_QrRejbyMaxLCnt2:=Sr_QrRejbyMaxLCnt2 div RN;
Sr_QrWaitTime1:=Sr_QrWaitTime1 /RN;
Sr_QrWaitTime2:=Sr_QrWaitTime2 /RN;
Label23.Caption:='Количество пришедших заявок '+IntToStr(Sr_QrCnt1+Sr_QrCnt2);
Label24.Caption:='1ого рода '+IntToStr(Sr_QrCnt1);
Label25.Caption:='2ого рода '+IntToStr(Sr_QrCnt2);
Label27.Caption:='Макс. возникшая длина очереди '+IntToStr(MaxAppearedQrLen);
Label30.Caption:='Количество обслуженных заявок '+IntToStr(Sr_QrServCnt1+Sr_QrServCnt2);
Label28.Caption:='1ого рода '+IntToStr(Sr_QrServCnt1);
Label29.Caption:='2ого рода '+IntToStr(Sr_QrServCnt2);
Label26.Caption:='Общее время обслуживания заявок '+FloatToStr(Sr_QrServTime1+Sr_QrServTime2);
Label31.Caption:='1ого рода '+FloatToStr(Sr_QrServTime1);
Label32.Caption:='2ого рода '+FloatToStr(Sr_QrServTime2);
if (Sr_QrServCnt1<>0) AND (Sr_QrServCnt2<>0) then
begin
Label33.Caption:='Среднее время ожидания заявкой ' +
FloatToStr((Sr_QrWaitTime1/Sr_QrServCnt1 + Sr_QrWaitTime2/Sr_QrServCnt2) /2);
Label34.Caption:='1ого рода '+FloatToStr(Sr_QrWaitTime1/Sr_QrServCnt1);
Label35.Caption:='2ого рода '+FloatToStr(Sr_QrWaitTime2/Sr_QrServCnt2);
end;
Label36.Caption:='Количество отказов (вс./оч.) '+
IntToStr(Sr_QrRejByMaxLCnt1 + Sr_QrRejByWaitCnt1 +
Sr_QrRejByMaxLCnt2 + Sr_QrRejByWaitCnt2) +
' / '+IntToStr(Sr_QrRejByMaxLCnt1 + Sr_QrRejByMaxLCnt2);
Label37.Caption:='1ого рода '+
IntToStr(Sr_QrRejByMaxLCnt1 + Sr_QrRejByWaitCnt1) +
' / '+IntToStr(Sr_QrRejByMaxLCnt1);
Label38.Caption:='2ого рода '+
IntToStr(Sr_QrRejByMaxLCnt2 + Sr_QrRejByWaitCnt2) +
' / '+IntToStr(Sr_QrRejByMaxLCnt2);
end;
procedure TBase.Button2Click(Sender: TObject);
begin
SimulateON:=true;
SimulateForm.Show;
Modeling;
end;
procedure TBase.Button3Click(Sender: TObject);
begin
SimulateON:=false;
Modeling;
end;
end.
