begin
PPT:=AllProcTasks[i];
List:=Procs[PPT.ProcNum-1];
List.Add(PPT);
end;
// Формированик Линков
for i:=1 to Procs.Count-1 do
begin
List:=Procs[i];
for j:=0 to List.Count-1 do
begin
PPT:=List[j];
PPP:=GetProcPointByUIN(PPT.UIN);
PPC:=PPP.Prev;
while PPC<>nil do
begin
toPPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if toPPT.ProcNum = PPT.ProcNum then
begin
new(PH);
PH.Task:=toPPT;
PH.Link:=nil;
PH.Next:=PPT.Prev;
PPT.Prev:=PH;
end
else
begin
new(PLT);
PLT.length:=PPC.Value;
PLT.fromUIN:=toPPT.UIN;
PLT.fromProc:=toPPT.ProcNum;
PLT.toUIN:=PPT.UIN;
PLT.toProc:=PPT.ProcNum;
PLT.fromTask:=toPPT;
PLT.toTask:=PPT;
PLT.StartTime:=0;
PLT.PrevTask:=toPPT;
PLT.PrevLink:=nil;
Tlist(Links[toPPT.ProcNum-1]).Add(PLT);
tmpPoint:=PLT;
for k:=toPPT.ProcNum to PPT.ProcNum-2 do
begin
new(PLT);
PLT.length:=PPC.Value;
PLT.fromUIN:=toPPT.UIN;
PLT.fromProc:=toPPT.ProcNum;
PLT.toUIN:=PPT.UIN;
PLT.toProc:=PPT.ProcNum;
PLT.fromTask:=toPPT;
PLT.toTask:=PPT;
PLT.StartTime:=0;
PLT.PrevTask:=nil;
PLT.PrevLink:=tmpPoint;
Tlist(Links[k]).Add(PLT);
tmpPoint:=PLT
end;
new(PH);
PH.Task:=nil;
PH.Link:=tmpPoint;
PH.Next:=PPT.Prev;
PPT.Prev:=PH;
end;
PPC:=PPC.next
end;
end;
end;
for i:=0 to Procs.Count-1 do
SetProcStartTimes(Procs[i]);
for i:=0 to Procs.Count+Links.Count-1 do
if i mod 2 = 0 then SetProcTimes(Procs[i div 2])
else SetLinkTimes(Links[i div 2])
end;
procedure TSubMerger.ShowSubMerging(SG:TStringGrid);
var i,j,k:integer;
NumOfRows:integer;
List:TList;
PPT:PProcTask;
PLT:PLinkTask;
begin
NumOfRows:=1;
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
PPT:=List.last;
if NumOfRows<PPT.StartTime+PPT.Length then
NumOfRows:=PPT.StartTime+PPT.Length;
end;
end;
for i:=0 to Links.Count-1 do
begin
List:=Links[i];
if List.Count<>0 then
begin
PLT:=List.last;
if NumOfRows<PLT.StartTime+PLT.Length then
NumOfRows:=PLT.StartTime+PLT.Length;
end;
end;
// Чистимсетку //
SG.RowCount:=NumOfRows;
if Procs.Count<>0 then SG.ColCount:=2*Procs.Count
else SG.ColCount:=0;
for i:=1 to SG.RowCount-1 do
for j:=1 to SG.ColCount-1 do SG.Cells[j,i]:='';
for i:=1 to SG.RowCount-1 do
SG.Cells[0,i]:=inttostr(i);
for i:=1 to SG.ColCount-1 do
if i mod 2 = 1 then SG.Cells[i,0]:=inttostr((i div 2)+1)
else SG.Cells[i,0]:='->';
if Selected<>nil then
for i:=MinProcNum-1 to MaxProcNum-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
if(PProcTask(List.first).MayBeBefore)or(Selected=List.first)then
SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]
end
else
SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]
end;
SG.Cells[0,0]:='';
if SG.ColCount<>1 then
begin
SG.FixedCols:=1;
SG.FixedRows:=1;
end;
// Вывод
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
for j:=0 to List.Count-1 do
begin
PPT:=List[j];
for k:=PPT.StartTime to PPT.StartTime+PPT.Length-1 do
begin
SG.Cells[2*i+1,k]:=inttostr(PPT.UIN);
if Selected = PPT then SG.Cells[2*i+1,k]:='s'+SG.Cells[2*i+1,k]
else
if PPT.MayBeAfter then SG.Cells[2*i+1,k]:='m'+SG.Cells[2*i+1,k]
end
end;
end;
for i:=0 to Links.Count-1 do
begin
List:=Links[i];
for j:=0 to List.Count-1 do
begin
PLT:=List[j];
for k:=PLT.StartTime to PLT.StartTime+PLT.Length-1 do
SG.Cells[2*i+2,k]:=inttostr(PLT.fromUIN)+':'+inttostr(PLT.toUIN);
end;
end;
end;
procedure TSubMerger.SelectTask(UIN:integer);
var i,j:integer;
PPP,tmpPPP:PProcPoint;
PPC,prevPPC:PProcCon;
PPT:PProcTask;
PH:PHolder;
List:TList;
newStartIndex,StartIndex,EndIndex:integer;
Reset:boolean;
begin
Selected:=GetProcTaskByUIN(UIN);
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
PPT.MayBeAfter:= PPT.UIN<>UIN;
PPT.MayBeBefore:=PPT.MayBeAfter
end;
List:=TList.Create;
MinProcNum:=1;
MaxProcNum:=Procs.Count;
PPP:=GetProcPointByUIN(UIN);
PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if PPT.ProcNum > MinProcNum then MinProcNum:=PPT.ProcNum;
PPC:=PPC.Next
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if PPT.ProcNum < MaxProcNum then MaxProcNum:=PPT.ProcNum;
PPC:=PPC.Next
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.first;
GetProcTaskByUIN(tmpPPP.UIN).MayBeAfter:=false;
List.Delete(0);
PPC:=tmpPPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.next
end;
end;
PPC:=PPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.first;
GetProcTaskByUIN(tmpPPP.UIN).MayBeBefore:=false;
List.Delete(0);
PPC:=tmpPPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.next
end;
end;
{ PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
PPT.MayBeAfter:= not (PPT.ProcNum < MinProcNum);
prevPPC:=PPC.toPoint.Prev;
while prevPPC<>nil do
begin
List.Add(prevPPC.toPoint);
prevPPC:=prevPPC.Next
end;
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.First;
List.delete(0);
PPT:=GetProcTaskByUIN(tmpPPP.UIN);
PPT.MayBeAfter:=false;
PPC:=tmpPPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
end;
//<<<
PPC:=PPP.Next;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
PPT.MayBeBefore:= not (PPT.ProcNum > MaxProcNum);
prevPPC:=PPC.toPoint.Next;
while prevPPC<>nil do
begin
List.Add(prevPPC.toPoint);
prevPPC:=prevPPC.Next
end;
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.First;
List.delete(0);
PPT:=GetProcTaskByUIN(tmpPPP.UIN);
PPT.MayBeBefore:=false;
PPC:=tmpPPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
end;
}
List.Destroy;
for i:=1 to MinProcNum-1 do
begin
List:=Procs[i-1];
for j:=0 to List.Count-1 do
begin
PPT:= PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false
end;
end;
for i:=MaxProcNum+1 to Procs.Count do
begin
List:=Procs[i-1];
for j:=0 to List.Count-1 do
begin
PPT:= PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false
end;
end;
for i:=MinProcNum to MaxProcNum do
begin
List:=Procs[i-1];
Reset:=false;
for j:=0 to List.Count-1 do
if Selected<>List[j] then
begin
if Reset then
begin
PPT:=PProcTask(List[j]);
PPT.MayBeAfter:=false;
end
else Reset:=not PProcTask(List[j]).MayBeAfter
end;
Reset:=false;
for j:=List.Count-1 downto 0 do
if Selected<>List[j] then
begin
if Reset then
begin
PPT:=PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false;
end
else Reset:=not PProcTask(List[j]).MayBeBefore
end;
end;
end;
procedure TSubMerger.DeselectTask;
var i:integer;
PPT:PProcTask;
begin
Selected:=nil;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
PPT.MayBeAfter:= false;
PPT.MayBeBefore:=false;
end;
end;
procedure TSubMerger.MoveSelectedAfter(ProcNum,UIN:integer);
var i:integer;
PPT:PProcTask;
begin
if Selected<>nil then
begin
if UIN<>-1 then
begin
PPT:=GetProcTaskByUIN(UIN);
if PPT.MayBeAfter then
begin
Selected.ProcNum:=PPT.ProcNum;
AllProcTasks.delete(AllProcTasks.IndexOf(Selected));
AllProcTasks.insert(AllProcTasks.IndexOf(PPT)+1,Selected);
FormLinkTasksAndSetTimes(Procs.Count);
end;
end
else
begin
Selected.ProcNum:=ProcNum;
AllProcTasks.delete(AllProcTasks.IndexOf(Selected));
i:=0;
while i<AllProcTasks.Count do
begin
if PProcTask(AllProcTasks[i]).ProcNum=ProcNum then break;
i:=i+1
end;
AllProcTasks.insert(i,Selected);
end;
FormLinkTasksAndSetTimes(Procs.Count);
end;
end;
function TSubMerger.IncNumOfProc:boolean;
var List:TList;
begin
if Procs.Count<>0 then
begin
List:=TList.Create;
Procs.Add(List);
List:=TList.Create;
Links.Add(List);
List:=nil;
Result:=true
end
else Result:=false
end;
function TSubMerger.DecNumOfProc:boolean;
var i,FoundNum:integer;
PPT:PProcTask;
begin
FoundNum:=0;
while FoundNum<Procs.Count do
begin
if TList(Procs[FoundNum]).Count=0 then break;
FoundNum:=FoundNum+1
end;
if FoundNum<Procs.Count then
begin
Procs.Delete(FoundNum);
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
if PPT.ProcNum>FoundNum then PPT.ProcNum:=PPT.ProcNum-1;
end;
FormLinkTasksAndSetTimes(Procs.Count);
Result:=true
end
else Result:=false;
end;
procedure TSubMerger.ClearPossibleMoves(var List:TList);
var PMT:PPossibleMove;
begin
while List.Count<>0 do
begin
PMT:=List.first;
List.delete(0);
dispose(PMT)
end;
List.Destroy
end;
function TSubMerger.GetPossibleMoves(UIN:integer):TList;
var i:integer;
PMT:PPossibleMove;
PPT:PProcTask;
List:TList;
begin
Result:=TList.Create;
SelectTask(UIN);
for i:=MinProcNum-1 to MaxProcNum-1 do
begin
List:=Procs[i];
if(List.Count=0)or((List.Count<>0)and(PProcTask(List.first).MayBeBefore)
or(Selected=List.first))then
begin
new(PMT);
PMT.UIN:=UIN;
PMT.processor:=i+1;
PMT.afterUIN:=-1;
PMT.Time:=$7FFFFFFF;
PMT.ProcCount:=$7FFFFFFF;
PMT.CurrentState:=false;
Result.Add(PMT);
end;
end;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
if PPT.MayBeAfter then
begin
new(PMT);
PMT.UIN:=UIN;
PMT.processor:=PPT.ProcNum;
PMT.afterUIN:=PPT.UIN;
PMT.Time:=$7FFFFFFF;
PMT.ProcCount:=$7FFFFFFF;
PMT.CurrentState:=false;
Result.Add(PMT);
end;
end;
DeselectTask;
end;
function TSubMerger.GetTime:integer;
var i:integer;
PPT:PProcTask;
List:TList;
begin
Result:=0;
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
PPT:=List.Last;
if Result < PPT.StartTime+PPT.Length-1 then Result :=
PPT.StartTime+PPT.Length-1
end;
end;
end;
function TSubMerger.GetProcCount:integer;
var i:integer;
begin
Result:=0;
for i:=0 to Procs.Count-1 do
if TList(Procs[i]).Count<>0 then Result:=Result+1
end;
function TSubMerger.OptimizeOneStep(L1,L2:TLabel):boolean;
var i,j:integer;
List,AllMoves:TList;
PPM,bestPPM,workPPM:PPossibleMove;
PPT:PProcTask;
BackUpList:TList;
BackUpNOP:integer;
BestFit:integer;
CurProcCount,CurTime:integer;
MinTime:integer;
Unique:boolean;
PH:PHolder;
CurUIN,MinProcessor:integer;
begin
DeselectTask;
AllMoves:=TList.create;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
List:=GetPossibleMoves(PPT.UIN);
for j:=0 to List.Count-1 do AllMoves.add(List[j]);
List.clear;
List.Destroy;
end;
CurProcCount:=GetProcCount;
CurTime:=GetTime;
BackUpNOP:=Procs.Count;
SaveBackUp(BackUpList);
for i:=0 to AllMoves.Count-1 do
begin
PPM:=AllMoves[i];
Selected:=GetProcTaskByUIN(PPM.UIN);
Unique:=true;
if Selected.ProcNum = PPM.processor then
begin
List:=Procs[Selected.ProcNum-1];
PPT:=nil;
for j:=0 to List.Count-1 do
begin
if PProcTask(List[j]).UIN = PPM.UIN then break;
PPT:=List[j];
end;
if((PPT<>nil)and(PPT.UIN=PPM.afterUIN))or
((PPT=nil)and(PPM.afterUIN=-1))then Unique:=false;
end;
PPM.CurrentState := not Unique;
if Unique then
begin
if PPM.afterUIN<>-1 then
(GetProcTaskByUIN(PPM.afterUIN)).MayBeAfter:=true;
MoveSelectedAfter(PPM.processor,PPM.afterUIN);
while GetProcCount<>Procs.Count do DecNumOfProc;
PPM.Time:=GetTime;
PPM.ProcCount:=Procs.Count;
RestoreBackUp(BackUpList,BackUpNOP,false);
end
else
begin
PPM.Time:=CurTime;
PPM.ProcCount:=CurProcCount;
end;
end;
Selected:=nil;
RestoreBackUp(BackUpList,BackUpNOP,true); //??
MinTime:=$7FFFFFFF;
for i:=0 to AllMoves.Count-1 do
if MinTime>PPossibleMove(AllMoves[i]).Time then
MinTime:=PPossibleMove(AllMoves[i]).Time;
//-->>
{ Memo.Lines.Clear;
for i:=0 to AllMoves.Count-1 do
begin
PPM:=AllMoves[i];
Memo.Lines.Add(inttostr(PPM.UIN)+' <>
'+inttostr(PPM.processor)+':'+inttostr(PPM.afterUIN)+' Time=
'+inttostr(PPM.Time)+' PC='+inttostr(PPM.ProcCount));
if PPM.CurrentState then Memo.Lines.Add('Was current state!')
end;}
//<<--
// выделяем минимальные времена
i:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.Time > MinTime then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
MinProcessor:=$7FFFFFFF;
for i:=0 to AllMoves.Count-1 do
if MinProcessor>PPossibleMove(AllMoves[i]).ProcCount then
MinProcessor:=PPossibleMove(AllMoves[i]).ProcCount;
i:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.ProcCount > MinProcessor then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
i:=0;
CurUIN:=0;
MinProcessor:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.UIN<>CurUIN then
begin
CurUIN:=PPM.UIN;
MinProcessor:=PPM.processor;
j:=i+1;
while j<>AllMoves.Count do
begin
workPPM:=AllMoves[j];
if workPPM.UIN<>CurUIN then break;
if workPPM.processor<MinProcessor then
MinProcessor:=workPPM.processor;
j:=j+1;
end;
end;
if (PPM.CurrentState)or(PPM.processor>MinProcessor)
then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
i:=0;
if MinTime = CurTime then
while i<AllMoves.Count do
begin
PPM:=AllMoves[i];
PPT:=GetProcTaskByUIN(PPM.UIN);
if PPM.processor = PPT.ProcNum then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
BestFit:=AllMoves.Count-1;
for i:=0 to AllMoves.Count-2 do
begin
PPM:=AllMoves[i];
bestPPM:=AllMoves[BestFit];
if(PPM.Time<bestPPM.Time)or
((PPM.Time=bestPPM.Time)and(PPM.ProcCount<bestPPM.ProcCount))
then BestFit:=i
end;
if BestFit<>-1 then
begin
bestPPM:=AllMoves[BestFit];
Selected:=GetProcTaskByUIN(bestPPM.UIN);
if bestPPM.afterUIN<>-1 then
(GetProcTaskByUIN(bestPPM.afterUIN)).MayBeAfter:=true;
MoveSelectedAfter(bestPPM.processor,bestPPM.afterUIN);
while GetProcCount<>Procs.Count do DecNumOfProc;