Если предварительная обработка не занята, и очередь к ней не пуста, деталь вынимается из очереди, и занимает предварительную обработку.
Если очередь на сборку для обработанных больше очереди необработанных, и очередь на предварительную обработку не пуста, деталь вынимается из очереди на предварительную обработку и поступает в очередь на сборку для необработанных.
Если сборка не занята, и очереди на сборку не пусты, из обеих очередей на сборку вынимается по одной детали, и начинается сборка.
Если очередь на регулировку не пуста, и регулировка не занята, деталь вынимается из очереди, и начинается регулировка.
Блок-схема:
Текстпрограммы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Math, Unit2;
type
TForm1 = class(TForm)
Image1: TImage;
Button2: TButton;
Button1: TButton;
CheckBox1: TCheckBox;
Buf1MSzLabel: TLabel;
Buf1AWaitLabel: TLabel;
Buf2AMSzLabel: TLabel;
Buf2AAWaitLabel: TLabel;
Buf2BMSzLabel: TLabel;
Buf2BAWaitLabel: TLabel;
Buf3MSzLabel: TLabel;
Buf3AWaitLabel: TLabel;
GoneLabel: TLabel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure LabeledEdit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormResize(Sender: TObject);
var
sz : TSize;
str : string;
W,H,x,y,dy : integer;
begin
Image1.Picture.Graphic:=nil;
W:=Image1.Width;
H:=Image1.Height;
y:=Trunc(H/2);
with Image1.Canvas do
begin
x:=Trunc(W/8);
str:='~10 мин'; sz:=TextExtent(str);
TextOut(Trunc((x-sz.cx)/2-2),y-sz.cy,str); //пишем строку
MoveTo(1,y); //переход в точку
LineTo(x,y); LineTo(x-10,y-4); LineTo(x,y); LineTo(x-11,y+6); //рисуем стрелку вправо
dy:=Trunc(H/10);
Rectangle(x,y-dy,Trunc(W/5),y+dy); //прямоугольник
str:='Буфер №1'; sz:=TextExtent(str);
TextOut(Trunc(W/6-(sz.cx+6)/2),Trunc(y-dy-sz.cy),str);
MoveTo(Trunc(W/5),y);
x:=Trunc(W/4);
LineTo(x,y); LineTo(x-10,y-4); LineTo(x,y); LineTo(x-11,y+6); //нижняя стрелка вправо
Ellipse(x,y-dy,x+dy*2,y+dy); //круг
x:=x+dy;
str:='Предв. обр.'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-dy-sz.cy),str);
str:=LabeledEdit1.Text+' мин'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-sz.cy/2),str);
MoveTo(x+dy,y);
x:=Trunc(W*0.45);
y:=Trunc(y+dy/2);
LineTo(x,y); LineTo(x-7,y-Trunc(H*0.02)); LineTo(x,y); LineTo(x-10,y); //нижняя стрелка вниз
y:=Trunc(H/2);
MoveTo(Trunc(W*0.2),y);
LineTo(Trunc(W*0.25)+dy,Trunc(H*0.15)); //верхняя стрелка вверх
y:=Trunc(y-dy/2);
LineTo(x,y); LineTo(x-3,y-10); LineTo(x,y); LineTo(x-10,y-2); //верхняя стрелка вниз
y:=Trunc(H/2);
Rectangle(x,y-dy,x+Trunc(W/5-W/8),y+dy);
str:='Буфер №2'; sz:=TextExtent(str);
TextOut(Trunc(W*0.49-sz.cx/2-2),Trunc(y-dy-sz.cy),str);
str:='A'; sz:=TextExtent(str);
TextOut(Trunc(W*0.49-sz.cx/2-2),Trunc(y-dy/2-sz.cy/2),str);
str:='B'; sz:=TextExtent(str);
TextOut(Trunc(W*0.49-sz.cx/2-2),Trunc(y+dy/2-sz.cy/2),str);
MoveTo(x,y);
x:=x+Trunc(W/5-W/8); LineTo(x,y); //линия в прямоугольнике
MoveTo(x,Trunc(y-dy/2));
LineTo(x+Trunc(W/4-W/5),y); //стрелка вниз
LineTo(x,Trunc(y+dy/2)); //стрелка вверх
x:=x+Trunc(W/4-W/5);
MoveTo(x-8,y-Trunc(H*0.03)); LineTo(x,y); LineTo(x-8,y+Trunc(H*0.03)); LineTo(x,y);
Ellipse(x,y-dy,x+dy*2,y+dy);
x:=x+dy;
str:='Сборка'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-dy-sz.cy),str);
str:=LabeledEdit2.Text+' мин'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-sz.cy/2),str);
MoveTo(x,y+dy);
LineTo(x,Trunc(y+H/4)); //линия вниз
x:=Trunc(W/16+W/10);
LineTo(x,Trunc(y+H/4)); //линия влево
y:=Trunc(y+dy);
LineTo(x,y); LineTo(x-4,y+10); LineTo(x,y); LineTo(x+4,y+11); //стрелка вверх
y:=Trunc(H/2);
x:=Trunc(W*0.573)+dy*2;
MoveTo(x,y);
x:=x+Trunc(W/4-W/5);
LineTo(x,y); LineTo(x-10,y-4); LineTo(x,y); LineTo(x-11,y+6); //стрелка вправо
Rectangle(x,y-dy,x+Trunc(W/5-W/8),y+dy);
x:=x+Trunc(W/5-W/8);
str:='Буфер №3'; sz:=TextExtent(str);
TextOut(Trunc(x-Trunc(W/10-W/16)-sz.cx/2),Trunc(y-dy-sz.cy),str);
MoveTo(x,y);
x:=x+Trunc(W/4-W/5);
LineTo(x,y); LineTo(x-10,y-4); LineTo(x,y); LineTo(x-11,y+6); //стрелка вправо
Ellipse(x,y-dy,x+dy*2,y+dy);
x:=x+dy;
str:='Регул.'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-dy-sz.cy),str);
str:='~'+LabeledEdit3.Text+' мин'; sz:=TextExtent(str);
TextOut(Trunc(x-sz.cx/2),Trunc(y-sz.cy/2),str);
end;
end;
procedure TForm1.LabeledEdit1Change(Sender: TObject);
begin
FormResize(Sender);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Buf1MSzLabel.Caption:='';
Buf1AWaitLabel.Caption:='';
Buf2AMSzLabel.Caption:='';
Buf2AAWaitLabel.Caption:='';
Buf2BMSzLabel.Caption:='';
Buf2BAWaitLabel.Caption:='';
Buf3MSzLabel.Caption:='';
Buf3AWaitLabel.Caption:='';
GoneLabel.Caption:='';
end;
const
MaxTime = 24*60; // 24 часа
pm : array [false..true] of Char = ('-','+');
procedure TForm1.Button2Click(Sender: TObject);
var
F : TextFile; //Файл
CurTime : Extended; //Текущее время
//Время прихода следующей партии, окончания предв. обр., окончания сборки, окончания регулировки
TimeIn,TimePrel,TimeAssem,TimeReg : extended;
bPrel,bAssem,bReg : boolean; //Занята ли предв. обр., сборка, регулировка
//Очередь на предв. обр., сборку для обраб., сборку для необр., регулировку
QPrel,QAssemA,QAssemB,QReg : TMyQueue;
//Макс. размер очереди на предв. обр., сборку для обраб., сборку для необр., регулировку
MPrel,MAssemA,MAssemB,MReg : cardinal;
//Сумма времен ожидания в очереди на предв. обр., сборку для обраб., сборку для необр., регулировку
SPrel,SAssemA,SAssemB,SReg : extended;
//Число прошедших в очередь на на предв. обр., сборку для обраб., сборку для необр., регулировку
NPrel,NAssemA,NAssemB,NReg : cardinal;
Gone : cardinal;
i : integer;
dum : TEL;
begin
randomize;
if CheckBox1.Checked then begin AssignFile(F,'log.txt'); Rewrite(F); end;
CurTime:=0;
TimeIn:=curTime-10*ln(random); //Время прихода первой тройки
TimePrel:=0; TimeAssem:=0; TimeReg:=0; //Все остальное обнуляем
bPrel:=false; bAssem:=false; bReg:=false;
init(QPrel); init(QAssemA); init(QAssemB); init(QReg);//Инициализируем очереди
MPrel:=0; MAssemA:=0; MAssemB:=0; MReg:=0;
SPrel:=0; SAssemA:=0; SAssemB:=0; SReg:=0;
NPrel:=0; NAssemA:=0; NAssemB:=0; NReg:=0;
Gone:=0;
while (CurTime<=MaxTime) do //Пока не прошло время (24 часа)
begin
//Если первым будет приход новой партии
if (not bPrel or (TimeIn<=TimePrel)) and
(not bAssem or (TimeIn<=TimeAssem)) and
(not bReg or (TimeIn<=TimeReg)) then
begin
CurTime:=TimeIn; //Новое текущее время
for i:=1 to 3 do //Ставим 3 детали в очередь
begin
dum.Time:=CurTime;
dum.was:=false;
Push(QPrel,dum);
end;
TimeIn:=CurTime-10*ln(random); //Время прихода след. партии
end
else //Если первым будет завершение предварительной обработки
if bPrel and (TimePrel<=TimeIn) and
(not bAssem or (TimePrel<=TimeAssem)) and
(not bReg or (TimePrel<=TimeReg)) then
begin
CurTime:=TimePrel; //Новое текущее время
dum.Time:=CurTime;
Push(QAssemB,dum); //Ставим в очередь обработанных на сборку
bPrel:=false; //Освоб. предв. обр.
end
else //Если первым будет завершение сборки
if bAssem and (TimeAssem<=TimeIn) and
(not bPrel or (TimeAssem<=TimePrel)) and
(not bReg or (TimeAssem<=TimeReg)) then
begin
CurTime:=TimeAssem; //Новое текущее время
if (random < 0.04) then //С вероятностью 4%
begin //Брак
for i:=1 to 2 do //Ставим две детали в очередь на предв. обр.
begin
dum.Time:=CurTime;
dum.was:=true; //Они бракованные
Push(QPrel,dum);
end;
end
else
begin
dum.Time:=CurTime;
dum.was:=false;
Push(QReg,dum); //Ставим в очередь на регулировку
end;
bAssem:=false; //Освобождаем сборку
end
else //Если первым будет завершение регулировки
if bReg and (TimeReg<=TimeIn) and
(not bPrel or (TimeReg<=TimePrel)) and
(not bAssem or (TimeReg<=TimeAssem)) then
begin
CurTime:=TimeReg; //Новое текущее время
bReg:=false; //Освоб. регул.
inc(Gone);
end;
//Если предв. обр. не занята и очередь на нее не пуста
if (not bPrel) and (not Empty(QPrel)) then
begin
TimePrel:=CurTime+MyStrToFloat(LabeledEdit1.Text); //Время завершения предв. обр.
dum:=Pop(QPrel); //Вынимаем из очереди
inc(NPrel); //Увел. число вышедших из очереди
SPrel:=SPrel+CurTime-dum.Time; //Сумма времен ожидания
bPrel:=true; //Занимаем предв. обр.
end;
//Пока очередь необработанных < очереди обработанных, и очередь на предв. не пуста,
//First - посмотреть первый элемент очереди, не вынимая
while (Count(QAssemA)<Count(QAssemB)) and (not Empty(QPrel)) and (not First(Qprel).was) do
begin
dum:=Pop(QPrel); //Время входа
inc(NPrel); //Увел. число вышедших из очереди
SPrel:=SPrel+CurTime-dum.Time; //Сумма времен ожидания
dum.time:=CurTime;
Push(QAssemA,dum); //Пихаем в очередь необработанных
end;
//Если сборка не занята и очереди на обработку не пусты
if (not bAssem) and (not Empty(QAssemA)) and (not Empty(QAssemB)) then
begin
//вынимаем из очереди необр.
dum:=Pop(QAssemA);
inc(NAssemA); //Увел. число вышедших
SAssemA:=SAssemA+CurTime-dum.Time; //Сумма времен
//вынимаем из очереди обр.
dum:=Pop(QAssemB);
inc(NAssemB);
SAssemB:=SAssemB+CurTime-dum.Time; //Сумма времен
bAssem:=true; //Занимем сборку
dum.time:=CurTime;
TimeAssem:=CurTime+MyStrToFloat(LabeledEdit2.Text); //Время окончания сборки
end;
//Если регулировка не занята и очередь на регулировку не пуста
if (not bReg) and (not Empty(QReg)) then
begin
dum:=Pop(QReg); //Вынимаем из очереди
inc(NReg); //Увел. число
SReg:=SReg+CurTime-dum.Time; //Сумма времен
bReg:=true; //Занимаем регулировку
TimeReg:=CurTime-MyStrToFloat(LabeledEdit3.Text)*ln(random); //Время окончания регулировки
end;
if CheckBox1.Checked then //Пишем лог
Writeln(F,CurTime:8:3,' ',TimeIn:9:3,' ',Count(QPrel):3,pm[bPrel],
TimePrel:11:3,' ',Count(QAssemA),'; ',Count(QAssemB),pm[bAssem],
TimeAssem:11:3,' ',Count(QReg):3,pm[bReg],TimeReg:11:3);
//Максимальные размеры очередей
if MPrel<Count(QPrel) then MPrel:=Count(QPrel);
if MAssemA<Count(QAssemA) then MAssemA:=Count(QAssemA);
if MAssemB<Count(QAssemB) then MAssemb:=Count(QAssemB);
if MReg<Count(QReg) then MReg:=Count(QReg);
end;
if CheckBox1.Checked then CloseFile(F);
//Пишем надписи на форме
Buf1MSzLabel.Caption:= 'Макс.буф. №1: '+IntToStr(MPrel);
Buf1AWaitLabel.Caption:= 'Ср.вр.буф. №1: '+FloatToStrF(SPrel/NPrel,ffFixed,5,2);
Buf2AMSzLabel.Caption:= 'Макс.буф. №2A: '+IntToStr(MAssemA);
Buf2AAWaitLabel.Caption:='Ср.вр.буф. №2A: '+FloatToStrF(SAssemA/NAssemA,ffFixed,5,2);;
Buf2BMSzLabel.Caption:= 'Макс.буф. №2B: '+IntToStr(MAssemB);
Buf2BAWaitLabel.Caption:='Ср.вр.буф. №2B: '+FloatToStrF(SAssemB/NassemB,ffFixed,5,2);;
Buf3MSzLabel.Caption:= 'Макс.буф. №3: '+IntToStr(MReg);
Buf3AWaitLabel.Caption:= 'Ср.вр.буф. №3: '+FloatToStrF(SReg/NReg,ffFixed,5,2);
GoneLabel.Caption:= 'Обработано: '+IntToStr(Gone);
end;
end.
unit Unit2;
interface
uses SysUtils;
type
TEL = record
time : extended;
was : boolean;
end;
PLink = ^TLink;
TLink = record
it : TEL; //Информация
next : PLink; //След. элем.
end;
TMyQueue = record
first,last : PLink;//Первый и последний
end;
procedure Init(var Q: TMyQueue); //Инициализация
procedure Push(var Q: TMyQueue; x:TEL); //Поместить в конец очереди
function Pop(var Q: TMyQueue): TEL; //Вынуть из очереди
function First(var Q: TMyQueue): TEL; //Посмотреть первый элемент очереди
function Empty(var Q: TMyQueue): boolean; //Пуста ли очередь
function Count(var Q: TMyQueue): cardinal; //Размер очереди
procedure Free(var Q: TMyQueue); //Освободить очередь
function MyStrToFloat(s: string): extended;
implementation
procedure Init(var Q: TMyQueue); //Инициализация
begin
Q.first:=nil;
Q.last:=nil;
end;
procedure Push(var Q: TMyQueue; x:TEL); //Поместить в конец очереди
var
p : PLink;
begin
new(p);
p.it:=x;
p^.next:=nil;
if (Q.last<>nil) then
Q.last^.next:=p
else
Q.first:=p;
Q.last:=p;
end;
function Pop(var Q: TMyQueue): TEL; //Вынуть из очереди
var
p : PLink;
X : TEL;
begin
p:=Q.first;
Q.first:=p^.next;
if (Q.first=nil) then Q.last:=nil;
X:=p^.it;
dispose(p);
Result:=X;
end;
function First(var Q: TMyQueue): TEL; //Посмотреть первый элемент очереди
begin
Result:=Q.first^.it;
end;
function Empty(var Q: TMyQueue): boolean;
begin
if (Q.first=nil) then Result:=true else Result:=false;
end;
function Count(var Q: TMyQueue): cardinal; //размер
var
p : PLink;
i : cardinal;
begin
i:=0;
p:=Q.first;
while (p<>nil) do
begin
inc(i);
p:=p^.next;
end;
Result:=i;
end;
procedure Free(var Q: TMyQueue); //Освободить очередь
var
p : PLink;
begin
while (Q.first<>nil) do
begin
p:=Q.first;
Q.first:=p^.next;
dispose(p);
end;
Q.last:=nil;
end;
function MyStrToFloat(s: string): extended;
var
n : integer;
begin
n:=pos('.',s);
if (n<>0) then s[n]:=DECIMALSEPARATOR;
Result:=StrToFloat(s);
end;
end.
Результаты:
Работа при заданных входных данных
(время предварительной обработки = 7 мин; время сборки = 6 мин; время
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.