Курсовая работа: Градиентный метод первого порядка
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;
if L1<>nil then L1.Caption:=inttostr(bestPPM.Time);
if L2<>nil then L2.Caption:=inttostr(bestPPM.ProcCount);
Result:=true
end
else Result:=false;
//-->>
{ Memo.Lines.Add('');
Memo.Lines.Add('--- Min ---');
Memo.Lines.Add('');
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;}
//<<--
ClearPossibleMoves(AllMoves);
DeselectTask;
end;
function ComparePPT(Item1, Item2: Pointer): Integer;
begin
if PProcTask(Item1).StartTime<PProcTask(Item2).StartTime then Result:=-
1
else
if PProcTask(Item1).StartTime>PProcTask(Item2).StartTime then Result:=1
else Result:=0
end;
procedure TSubMerger.OptimizeAuto(Form:TForm;L1,L2:TLabel);
var i,j,k:integer;
List,UINList:TList;
PPT,nextPPT:PProcTask;
Time:integer;
MatchError:boolean;
NewProc:TList;
NOP:integer;
NoChange:boolean;
StartFrom,NewStartFrom:integer;
BackList:TList;
BackTime:integer;
begin
while OptimizeOneStep(L1,L2) do Form.Update;
Time:=GetTime;
UINList:=TList.Create;
NewStartFrom:=0;
repeat
StartFrom:=NewStartFrom;
NoChange:=true;
for i:=0 to Procs.Count-2 do
begin
NewStartFrom:=i+1;
List:=Procs[i];
for j:=0 to List.Count-1 do UINList.Add(List[j]);
List:=Procs[i+1];
for j:=0 to List.Count-1 do UINList.Add(List[j]);
UINList.Sort(ComparePPT);
MatchError:=false;
PPT:=UINList.first;
for j:=1 to UINList.Count-1 do
begin
nextPPT:=UINList[j];
if (PPT.StartTime = nextPPT.StartTime) or
(PPT.StartTime+PPT.Length>nextPPT.StartTime) then
begin
MatchError:=true;
break
end;
PPT:=nextPPT;
end;
if not MatchError then
begin
SaveBackUp(BackList);
BackTime:=GetTime;
NOP:=Procs.Count-1;
ClearLinks(true);
ClearProcs(false);
for j:=0 to UINList.Count-1 do
begin
PPT:=UINList[j];
PPT.ProcNum:=i+1;
AllProcTasks.delete(AllProcTasks.indexOf(PPT));
end;
for j:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[j];
if PPT.ProcNum>i+1 then PPT.ProcNum:=PPT.ProcNum-1
end;
for j:=0 to UINList.Count-1 do AllProcTasks.add(UINList[j]);
FormLinkTasksAndSetTimes(NOP);
if BackTime>=GetTime then
begin
NoChange:=false;
NewStartFrom:=0;
while BackList.Count<>0 do
begin
PPT:=BackList.first;
BackList.delete(0);
dispose(PPT)
end;
end
else RestoreBackUp(BackList,NOP+1,true);
break;
end;
UINList.Clear;
end;
UINList.Clear;
until NoChange;
UINList.Destroy;
end;
procedure TSubMerger.SaveBackUp(var List:Tlist);
var backPPT,PPT:PProcTask;
i:integer;
begin
List:=TList.Create;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
new(backPPT);
backPPT^:=PPT^;
backPPT.Prev:=nil;
List.add(backPPT);
end;
end;
procedure TSubMerger.RestoreBackUp(var
List:Tlist;NOP:integer;ClearCurrent:boolean);
var backPPT,PPT:PProcTask;
i:integer;
begin
Selected:=nil;
ClearLinks(true);
ClearProcs(true);
for i:=0 to List.Count-1 do
begin
backPPT:=List[i];
new(PPT);
PPT^:=backPPT^;
AllProcTasks.add(PPT);
if ClearCurrent then dispose(backPPT);
end;
if ClearCurrent then List.Destroy;
FormLinkTasksAndSetTimes(NOP);
end;
end.