Form1.Gauge1.Progress: = 100;
// RedrawDiagram;
finally
FreeEmulation;
end;
end;
function TQSheme.NewParcel: Pointer;
var P: Pointer;
begin
P: = FParcelsClass.Create;
FParcels.Add (P);
Result: = P;
end;
procedure TQSheme.NewEvent (AEvent: Integer; ASender, ASource: TObject; AInfo: TInfo);
var P: PEventRec;
begin
GetMem (P, SizeOf (TEventRec ));
with P ^ do begin
Event: = AEvent;
Sender: = ASender;
Source: = ASource;
Info: = AInfo;
SysTime: = FSysTime;
end;
FEventQueue.Add (P);
end;
function TQSheme.GetCounts (Index: integer): integer;
var i: integer;
begin
Result: = 0;
for i: = 0 to FParcels.Count-1 do
if Ord (TParcel (FParcels [i]). State) = Index then Inc (Result);
end;
function TQSheme.GetParcelCount: integer;
begin
Result: = FParcels.Count;
end;
const// DrawConstants
Top = 20;
Left = 20;
Interval = 20;
procedure TQSheme.DrawElementLines;
var i: integer;
Y: integer;
begin
for i: = 0 to ElementCount-1 do begin
Y: = Top + interval * i;
with Diagram.Canvas do begin
TextOut (0, Y + Font.Height, Elements [i]. Name);
MoveTo (0, Y);
LineTo (Diagram.ClientWidth, Y)
end;
end;
end;
procedure TQSheme.DisplayEvents;
(var i: integer;
s: string;)
begin
(Form1.mResults.Items.Clear;
for i: = 0 to FEventQueue.Count - 1 do begin
with TEventRec (FEventQueue [i] ^) do begin
case Event of
EV_TAKE: S: ='+++:';
EV_REFUSE: S: ='------:';
EV_PASS: S: = 'PASS :';
end;
S: = S + IntToStr (Info);
S: = S + '[' + IntToStr (SysTime) + ']';
if Assigned (Source) then S: = S + TElement (Source). Name
else S: = S + 'nil';
S: = S +'->';
if Assigned (Sender) then S: = S + TElement (Sender). Name
else S: = S + 'nil';
end;
Form1.mResults.Items.Add (S);
end;)
end;
procedure TQSheme.RedrawDiagram;
// var i: integer;
begin
// Diagram.Canvas.FillRect (Rect (0,0, Diagram.Width, Diagram.Height ));
// DrawElementLines;
DisplayEvents;
end;
initialization
Randomize;
end.
unit QSObjs;
interface
uses Classes, QSTypes, SysUtils, Utils;
type
TElement = class;
TIsRightElement = function (Element: TElement): Boolean of object;// far;
TBeforeAfterAction = procedure (Sender: TElement) of object;
TElement class =
private
FId: integer;
FName: string;
FSources: TList;
FSheme: TObject;
FContainer: TParcel;
FOnSourceValidate: TIsRightElement;
FOnDestinationValidate: TIsRightElement;
FBeforeTake: TBeforeAfterAction;
FAfterTake: TBeforeAfterAction;
FBeforeDrop: TBeforeAfterAction;
FAfterDrop: TBeforeAfterAction;
procedure SetSheme (ASheme: TObject);
function GetSourceCount: integer;
function GetSource (Index: integer): TElement;
function GetParcelPresent: Boolean;
function GetCanDropParcelFor (Destination: TElement): Boolean;
function GetCanTakeParcelFrom (Source: TElement): Boolean;
procedure Pass (SourceIndex: integer); virtual;
protected
function GetCanTake: Boolean; virtual; abstract;
function GetCanDrop: Boolean; virtual; abstract;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddSource (Element: TElement);
procedure DelSource (Element: TElement);
procedure AskForParcel; virtual;
procedure ClearContainer; virtual;
procedure RefuseParcel (SourceIndex: integer);
procedure DropParcel; virtual;
procedure TakeParcel (SourceIndex: integer); virtual;
procedure DoBeforeDrop (Sender: TElement);
procedure DoBeforeTake (Sender: TElement);
procedure DoAfterDrop (Sender: TElement);
procedure DoAfterTake (Sender: TElement);
property CanDropParcelFor [Destination: TElement]: Boolean read GetCanDropParcelFor;
property CanTakeParcelFrom [Source: TElement]: Boolean read GetCanTakeParcelFrom;
property Container: TParcel read FContainer write FContainer;
property ParcelPresent: Boolean read GetParcelPresent;
property CanTake: Boolean read GetCanTake;
property CanDrop: Boolean read GetCanDrop;
property Id: integer read FId write FId;
published
property Name: string read FName write FName;
property Sheme: TObject read FSheme write SetSheme;
property SourceCount: integer read GetSourceCount;
property Sources [Index: integer]: TElement read GetSource;
property OnSourceValidate: TIsRightElement read FOnSourceValidate write FOnSourceValidate;
property OnDestinationValidate: TIsRightElement read FOnDestinationValidate write FOnDestinationValidate;
property BeforeTake: TBeforeAfterAction read FBeforeTake write FBeforeTake;
property AfterTake: TBeforeAfterAction read FAfterTake write FAfterTake;
property BeforeDrop: TBeforeAfterAction read FBeforeDrop write FBeforeDrop;
property AfterDrop: TBeforeAfterAction read FAfterDrop write FAfterDrop;
end;
TElementClass = class of TElement;
TGenerator class =
private
FMean: TCustTime;
FDisp: TCustTime;
FRandomType: TRandomType;
function GetRandom: TCustTime;
public
constructor Create;
property Mean: TCustTime read FMean write FMean;
property Disp: TCustTime read FDisp write FDisp;
property RandomType: TRandomType read FRandomType write FRandomType;
property Time: TCustTime read GetRandom;
end;
TShop = class (TElement)
private
FGenerator: TGenerator;
FEndWorkTime: TCustTime;
procedure Pass (SourceIndex: integer); override;
function GetProcessed: Boolean;
protected
function GetCanTake: Boolean; override;
function GetCanDrop: Boolean; override;
property EndWorkTime: TCustTime read FEndWorkTime write FEndWorkTime;
public
constructor Create; override;
destructor Destroy; override;
procedure DropParcel; override;
property Generator: TGenerator read FGenerator;
property Processed: Boolean read GetProcessed;
procedure Work; virtual;
end;
TChannel = class (TShop)
public
procedure Pass (SourceIndex: integer); override;
end;
TSource = class (TShop)
private
procedure TakeParcel (SourceIndex: integer); override;
public
procedure Pass (SourceIndex: integer); override;
procedure AskForParcel; override;
end;
TAccumulator = class (TElement)
private
FParcels: TList;
FLimited: Boolean;
FCapacity: integer;
function GetParcel (Index: integer): TParcel;
function GetFreeSpacePresent: Boolean;
function GetEmpty: Boolean;
procedure SetCapacity (Value: integer);
function GetCapacity: integer;
function GetParcelCount: integer;
procedure Pass (SourceIndex: integer); override;
function GetCanTake: Boolean; override;
function GetCanDrop: Boolean; override;
public
constructor Create; override;
destructor Destroy; override;
procedure ClearContainer; override;
procedure DropParcel; override;
property ParcelCount: integer read GetParcelCount;
property Parcels [Index: integer]: TParcel read GetParcel;
property FreeSpacePresent: Boolean read GetFreeSpacePresent;
property Empty: Boolean read GetEmpty;
procedure TakeParcel (Index: integer); override;
published
property Capacity: integer read GetCapacity write SetCapacity;
property Limited: Boolean read FLimited write FLimited;
end;
TAccumulatorClass = class of TAccumulator;
implementation
uses QSheme;
constructor TElement.Create;
begin
FSources: = TList.Create;
end;
destructor TElement.Destroy;
begin
FSources.Free;
inherited;
end;
procedure TElement.SetSheme (ASheme: TObject);
begin
if Assigned (ASheme) then FSheme: = ASheme;
end;
procedure TElement.AddSource (Element: TElement);
begin
if Assigned (Element) then FSources.Add (Element);
end;
procedure TElement.DelSource (Element: TELement);
begin
if Assigned (Element) then FSources.Remove (Element);
end;
function TElement.GetSourceCount: integer;
begin
Result: = FSources.Count;
end;
function TElement.GetSource (Index: integer): TElement;
begin
Result: = FSources [Index];
end;
procedure TElement.TakeParcel (SourceIndex: integer);
begin
FContainer: = Sources [SourceIndex]. FContainer;
TQSheme (Sheme). NewEvent (EV_TAKE, Self, Sources [SourceIndex], FContainer.Info);
Sources [SourceIndex]. DropParcel;
end;
procedure TElement.Pass (SourceIndex: integer);
var Source: TElement;
begin
if SourceIndex <> -1 then Source: = Sources [SourceIndex];
DoBeforeTake (Self);
if SourceIndex <> -1 then Source.DoBeforeDrop (Source);
TakeParcel (SourceIndex);
DoAfterTake (Self);
if SourceIndex <> -1 then Source.DoAfterDrop (Source);
end;
function TElement.GetCanDropParcelFor (Destination: TElement): Boolean;
begin
Result: = CanDrop;
if Assigned (OnDestinationValidate) then
Result: = Result and OnDestinationValidate (Destination)
end;
function TElement.GetCanTakeParcelFrom (Source: TElement): Boolean;
begin
if Assigned (OnSourceValidate) then
Result: = OnSourceValidate (Source)
else Result: = True;
end;
procedure TElement.AskForParcel;
var i: integer;
Source: TElement;
begin
for i: = 0 to SourceCount - 1 do begin
Source: = Sources [i];
if Source.CanDropParcelFor [Self] and CanTakeParcelFrom [Source] then
if CanTake then begin
Pass (i);
if Self is TShop then Exit;
end
else
if not (Source is TAccumulator) then RefuseParcel (i);
end;// for
end;
function TElement.GetParcelPresent: Boolean;
begin
Result: = FContainer <> nil;
end;
procedure TElement.ClearContainer;
begin
DropParcel;
end;
procedure TElement.RefuseParcel (SourceIndex: integer);
begin
Sources [SourceIndex]. Container.State: = psRefused;
TQSheme (Sheme). NewEvent (EV_REFUSE, Self, Sources [SourceIndex], Sources [SourceIndex]. Container.Info);
Sources [SourceIndex]. DropParcel;
end;
procedure TElement.DropParcel;
begin
Container: = nil;
end;
procedure TElement.DoBeforeDrop (Sender: TElement);
begin
if Assigned (FBeforeDrop) then FBeforeDrop (Sender);
end;
procedure TElement.DoAfterDrop (Sender: TElement);
begin
if Assigned (FAfterDrop) then FAfterDrop (Sender);
end;
procedure TElement.DoBeforeTake (Sender: TElement);
begin
if Assigned (FBeforeTake) then FBeforeTake (Sender);
end;
procedure TElement.DoAfterTake (Sender: TElement);
begin
if Assigned (FAfterTake) then FAfterTake (Sender);
end;
constructor TGenerator.Create;
begin
inherited;
FRandomType: = rtPlane;
end;
function TGenerator.GetRandom: TCustTime;
var R: single;
begin
case FRandomType of
rtPlane: R: = PlaneRND;
rtNormal: R: = NormRND;
rtExponent: R: = ExpRND
else
R: = Random;
end;
Result: = FMean - FDisp + Round (R * 2 * FDisp);
end;
constructor TShop.Create;
begin
inherited;
FGenerator: = TGenerator.Create;
end;
destructor TShop.Destroy;
begin
FGenerator.Free;
inherited;
end;
procedure TShop.DropParcel;
begin
inherited;
FEndWorkTime: = 0;
end;
procedure TShop.Pass (SourceIndex: integer);
begin
inherited;
Work;
end;
function TShop.GetProcessed: Boolean;
begin
Result: = (TQSheme (Sheme). SysTime> = FEndWorkTime);
end;
function TShop.GetCanTake: Boolean;
begin
Result: = not ParcelPresent and Processed;
end;
function TShop.GetCanDrop: Boolean;
begin
Result: = ParcelPresent and Processed;
end;
procedure TShop.Work;
begin
FEndWorkTime: = TQSheme (Sheme). SysTime + FGenerator.GetRandom;
end;
procedure TChannel.Pass (SourceIndex: integer);
begin
inherited;
Container.State: = psWork;
end;
procedure TSource.TakeParcel (SourceIndex: integer);
begin
Container: = TQSheme (Sheme). NewParcel;
end;
procedure TSource.Pass (SourceIndex: integer);
begin
inherited;
Container.State: = psBorn;
end;
procedure TSource.AskForParcel;
begin
if CanTake then Pass (-1);
end;
constructor TAccumulator.Create;
begin
FLimited: = False;
FParcels: = TList.Create;
inherited;
end;
destructor TAccumulator.Destroy;
begin
FParcels.Free;
end;
function TAccumulator.GetParcel (Index: integer): TParcel;
begin
Result: = FParcels [Index];
end;
function TAccumulator.GetCanDrop: Boolean;
begin
if Empty then AskForParcel;
if not Empty then Container: = FParcels.First;
Result: = not Empty;
end;
function TAccumulator.GetCanTake: Boolean;
begin
Result: = FreeSpacePresent;
end;
function TAccumulator.GetFreeSpacePresent: Boolean;
begin
Result: = (Capacity <> FParcels.Count) or (not Limited);
end;
function TAccumulator.GetEmpty: Boolean;
begin
Result: = FParcels.Count = 0;
// if not Result then Container: = FParcels.First;
end;
procedure TAccumulator.DropParcel;
begin
if not Empty then FParcels.Delete (0);
inherited;
end;
function TAccumulator.GetCapacity: integer;
begin
Result: = FCapacity;
end;
function TAccumulator.GetParcelCount: integer;
begin
Result: = FParcels.Count;
end;
procedure TAccumulator.SetCapacity (Value: integer);
begin
FLimited: = True;
FCapacity: = Value;
end;
procedure TAccumulator.ClearContainer;
begin
FParcels.Clear;
inherited;
end;
procedure TAccumulator.Pass (SourceIndex: integer);
begin
inherited;
Container.State: = psStore;
end;
procedure TAccumulator.TakeParcel (Index: integer);
begin
FParcels.Add (Sources [Index]. Container);
TQSheme (Sheme). NewEvent (EV_TAKE, Self, Sources [Index], Sources [Index]. Container.Info);
Container: = FParcels.Last;
Sources [Index]. DropParcel;
end;
end.
- середній час надходження заявок від одного проектувальника,
яке в свою чергу з урахуванням умов завдання обчислюється як
(3),
(5),
- середній час обробки ЕОМ одного завдання .