Курсовая работа: Градиентный метод первого порядка
PPP.Prev:=PPC
end;
while PPP.Next<>nil do
begin
PPC:=PPP.Next.Next;
dispose(PPP.Next);
PPP.Next:=PPC
end;
dispose(PPP)
end;
ClearLinks(true);
ClearProcs(true);
AllProcTasks.Clear;
{
while FProcTasks.Count<>0 do
begin
PPT:=FProcTasks.first;
FProcTasks.delete(0);
dispose(PPT)
end;
while FLinkTasks.Count<>0 do
begin
PLT:=FLinkTasks.first;
FLinkTasks.delete(0);
dispose(PLT)
end;
}
end;
function TSubMerger.GetProcPointByUIN(UIN:integer):PProcPoint;
var i:integer;
begin
Result:=nil;
for i:=0 to Points.Count-1 do
if PProcPoint(Points[i]).UIN = UIN then
begin
Result:=Points[i];
break
end;
end;
function TSubMerger.GetProcTaskByUIN(UIN:integer):PProcTask;
var i:integer;
begin
Result:=nil;
for i:=0 to AllProcTasks.Count-1 do
if PProcTask(AllProcTasks[i]).UIN = UIN then
begin
Result:=AllProcTasks[i];
break
end;
end;
procedure TSubMerger.Init(GPoints,GConnections:TList);
var i:integer;
PP:PPoint;
PC:PConnection;
PPP:PProcPoint;
PPC:PProcCon;
begin
Clear;
for i:=0 to GPoints.Count-1 do
begin
PP:=GPoints[i];
new(PPP);
PPP.UIN := PP.Uin;
PPP.Value := PP.Value;
PPP.UBorder:=0;
PPP.DBorder:=$8FFFFFFF;
PPP.UFixed:=false;
PPP.DFixed:=false;
PPP.UCon:=0;
PPP.DCon:=0;
PPP.Prev:=nil;
PPP.Next:=nil;
Points.Add(PPP);
end;
for i:=0 to GConnections.Count-1 do
begin
PC:=GConnections[i];
PPP := GetProcPointByUIN(PC.fromPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.toPoint.UIN);
PPC.Next := PPP.Next;
PPP.Next := PPC;
PPP := GetProcPointByUIN(PC.toPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.fromPoint.UIN);
PPC.Next := PPP.Prev;
PPP.Prev := PPC;
end;
end;
procedure SetUBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.UBorder < Value then PPP.UBorder := Value;
PPC:=PPP.Prev;
Fix:=true;
while PPC<>nil do
begin
if not PPC.toPoint.DFixed then
begin
Fix:=false;
Break
end;
PPC:=PPC.Next
end;
PPP.UFixed:=Fix
end;
procedure SetDBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.DBorder > Value then PPP.DBorder := Value;
PPC:=PPP.Next;
Fix:=true;
while PPC<>nil do
begin
if not PPC.toPoint.UFixed then
begin
Fix:=false;
Break
end;
PPC:=PPC.Next
end;
PPP.DFixed:=Fix
end;
procedure SetUBorderDown(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
workPPP:PProcPoint;
List:TList;
begin
List:=TList.create;
if PPP.UBorder < Value then
begin
PPP.UBorder := Value;
List.Add(PPP);
while List.Count<>0 do
begin
workPPP:=List[0];
List.delete(0);
PPC:=workPPP.Next;
while PPC<>nil do
begin
if PPC.toPoint.UBorder < workPPP.UBorder+1 then
begin
PPC.toPoint.UBorder:=workPPP.UBorder+1;
List.Add(PPC.toPoint)
end;
PPC:=PPC.Next
end;
end;
end;
List.Destroy;
end;
procedure SetDBorderUp(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
workPPP:PProcPoint;
List:TList;
begin
List:=TList.create;
if PPP.DBorder > Value then
begin
PPP.DBorder := Value;
List.Add(PPP);
while List.Count<>0 do
begin
workPPP:=List[0];
List.delete(0);
PPC:=workPPP.Prev;
while PPC<>nil do
begin
if PPC.toPoint.DBorder > workPPP.DBorder-1 then
begin
PPC.toPoint.DBorder:=workPPP.DBorder-1;
List.Add(PPC.toPoint)
end;
PPC:=PPC.Next
end;
end;
end;
List.Destroy;
end;
procedure SetProcToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
begin
PPP.UBorder:=Value;
PPP.DBorder:=Value;
PPP.UFixed:=true;
PPP.DFixed:=true;
PPP.Merged:=true;
PPC:=PPP.Prev;
while PPC<>nil do
begin
if not PPC.toPoint.Merged then
begin
//if PPC.toPoint.DBorder>PPP.UBorder-1 then
SetDBorderToPPP(PPC.toPoint,PPP.UBorder-1);
SetDBorderToPPP(PPC.toPoint,PPP.UBorder-1);
PPC.toPoint.DCon:=PPC.toPoint.DCon+PPC.Value;
end;
PPC:=PPC.Next;
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
if not PPC.toPoint.Merged then
begin
//if PPC.toPoint.UBorder<PPP.DBorder+1 then
SetUBorderToPPP(PPC.toPoint,PPP.DBorder+1);
SetUBorderToPPP(PPC.toPoint,PPP.DBorder+1);
PPC.toPoint.UCon:=PPC.toPoint.UCon+PPC.Value;
end;
PPC:=PPC.Next;
end;
end;
procedure TSubMerger.DoBazovoe;
var i,j,p:integer;
PPP:PProcPoint;
PPC:PProcCon;
PW,newPW:PWay;
WorkList : TList;
WaysList : TList;
MaxWayLength : integer;
s : string;
//-->>
Pretender:PProcPoint;
NoChange:boolean;
PretenderCon : integer;
//-->>
PPT:PProcTask;
begin
ClearLinks(true);
ClearProcs(true);
AllProcTasks.Clear;
WaysList := TList.Create;
WorkList := TList.Create;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
PPP.UBorder:=0;
PPP.DBorder:=$7FFFFFFF;
PPP.UCon:=0;
PPP.DCon:=0;
PPP.UFixed:=false;
PPP.DFixed:=false;
PPP.Merged:=false;
WorkList.Add(PPP)
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
PPC:=PPP.Next;
while PPC<>nil do
begin
for j:=0 to WorkList.Count-1 do
if PPC.toPoint = WorkList[j] then
begin
WorkList.delete(j);
break
end;
PPC:=PPC.Next
end;
end;
for i:=0 to WorkList.Count-1 do
begin
PPP:=WorkList[i];
new(PW);
PW.Length:=1;
PW.Numbers:=inttostr(PPP.UIN)+',';
PW.Weight:=PPP.Value;
PW.Current:=PPP;
WorkList[i]:=PW
end;
while WorkList.Count<>0 do
begin
PW:=WorkList.first;
WorkList.delete(0);
if PW.Current.Next=nil then WaysList.Add(PW)
else
begin
PPC:=PW.Current.Next;
while PPC<>nil do
begin
new(newPW);
newPW.Length:=PW.Length+1;
newPW.Weight:=PW.Weight+PPC.Value+PPC.toPoint.Value;
newPW.Numbers:=PW.Numbers+inttostr(PPC.toPoint.UIN)+',';
newPW.Current:=PPC.toPoint;
WorkList.Add(newPW);
PPC:=PPC.Next
end;
dispose(PW)
end;
end;
MaxWayLength := 0;
for i:=0 to WaysList.Count-1 do
begin
PW:=WaysList[i];
if PW.Length > MaxWayLength then MaxWayLength:=PW.Length
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if PPP.Prev = nil then SetUBorderDown(PPP,1);
if PPP.Next = nil then SetDBorderUp(PPP,MaxWayLength);
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if PPP.UBorder = PPP.DBorder then SetProcToPPP(PPP,PPP.UBorder);
end;
Pretender:=nil;
PretenderCon:=0;
repeat
NoChange:=true;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if not PPP.merged then
begin
if PPP.UFixed and PPP.DFixed then
begin
if PPP.UCon > PPP.DCon then SetProcToPPP(PPP,PPP.UBorder)
else SetProcToPPP(PPP,PPP.DBorder);
Pretender:=nil;
NoChange:=false;
break
end
else
begin
if PPP.UFixed then
begin
if(Pretender = nil)or(PretenderCon < PPP.UCon) then
begin
Pretender:=PPP;
PretenderCon := PPP.UCon
end;
end
else
if PPP.DFixed then
begin
if(Pretender = nil)or(PretenderCon < PPP.DCon) then
begin
Pretender:=PPP;
PretenderCon := PPP.DCon
end;
end;
end;
end;
end;
if Pretender<>nil then
begin
if Pretender.UFixed then SetProcToPPP(Pretender,Pretender.UBorder)
else SetProcToPPP(Pretender,Pretender.DBorder);
Pretender:=nil;
PretenderCon:=0;
NoChange:=false;
end;
until NoChange;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
new(PPT);
PPT.ProcNum:=PPP.UBorder;
PPT.ProcNum:=PPP.DBorder;
PPT.Ready:=0;
PPT.UIN:=PPP.UIN;
PPT.StartTime:=0;
PPT.Length:=PPP.Value;
PPT.Prev:=nil;
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false;
PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT.Ready:=PPT.Ready+1;
PPC:=PPC.next
end;
j:=0;
while j<=AllProcTasks.Count-1 do
begin
if PProcTask(AllProcTasks[j]).Ready > PPT.Ready then break;
j:=j+1;
end;
AllProcTasks.Add(PPT);
end;
FormLinkTasksAndSetTimes(MaxWayLength);
end;
procedure SetProcTimes(List:TList);
var i,j:integer;
PPT:PProcTask;
PH:PHolder;
Time,dTime:integer;
begin
Time:=1;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
PPT.StartTime:=Time;
Time:=Time+PPT.Length;
end;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
Time:=PPT.StartTime;
PH:=PPT.Prev;
while PH<>nil do
begin
if PH.Task<>nil then
begin
if Time < PH.Task.StartTime+PH.Task.Length then
Time:= PH.Task.StartTime+PH.Task.Length
end
else
begin
if Time < PH.Link.StartTime+PH.Link.Length then
Time:= PH.Link.StartTime+PH.Link.Length
end;
PH:=PH.Next
end;
if Time > PPT.StartTime then
begin
dTime:=Time-PPT.StartTime;
PPT.StartTime:=Time;
for j:=i+1 to List.Count-1 do
PProcTask(List[j]).StartTime:=PProcTask(List[j]).StartTime+dTime
end;
end;
end;
procedure SetProcStartTimes(List:TList);
var i:integer;
PPT:PProcTask;
Time:integer;
begin
Time:=1;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
PPT.StartTime:=Time;
Time:=Time+PPT.Length;
end;
end;
function PLT_TimeCompare(I1,I2:Pointer):integer;
var D1,D2:integer;
Item1,Item2:PLinkTask;
begin
Item1:=I1;
Item2:=I2;
if Item1.StartTime<Item2.StartTime then Result:=-1
else
if Item1.StartTime>Item2.StartTime then Result:=1
else
begin
if Item1.toProc = Item2.toProc then
begin
if Item1.toTask.StartTime<Item2.toTask.StartTime then Result:=-1
else
if Item1.toTask.StartTime>Item2.toTask.StartTime then Result:=1
else Result:=0
end
else
begin
D1:=Item1.toProc - Item1.fromProc;
D2:=Item2.toProc - Item2.fromProc;
if D1>D2 then Result:=1
else
if D1<D2 then Result:=-1
else
begin
if Item1.toProc<Item2.toProc then Result:=-1
else
if Item1.toProc>Item2.toProc then Result:=1
else
Result:=0
end;
end;
end;
end;
procedure SetLinkTimes(List:TList);
var i:integer;
PLT:PLinkTask;
Time:integer;
begin
for i:=0 to List.Count-1 do
begin
PLT:=List[i];
if PLT.PrevTask<>nil then
Time:= PLT.PrevTask.StartTime+PLT.PrevTask.Length
else
Time:= PLT.PrevLink.StartTime+PLT.PrevLink.Length;
PLT.StartTime:=Time;
end;
List.Sort(PLT_TimeCompare);
Time:=1;
for i:=0 to List.Count-1 do
begin
PLT:=List[i];
if Time>PLT.StartTime then PLT.StartTime:=Time;
Time:=PLT.StartTime+PLT.Length;
end;
end;
зrocedure TSubMerger.FormLinkTasksAndSetTimes(NumOfProcs:integer);
var i,j,k:integer;
PPT,toPPT:PProcTask;
PLT:PLinkTask;
PPP:PProcPoint;
PPC:PProcCon;
PH:PHolder;
tmpPoint : pointer;
List:TList;
begin
ClearLinks(true);
ClearProcs(false);
if NumOfProcs<>0 then
begin
List:=TList.Create;;
Procs.Add(list);
for i:=1 to NumOfProcs-1 do
begin
List:=TList.Create;;
Procs.Add(list);
List:=TList.Create;
Links.Add(List)
end;
end;
for i:=0 to AllProcTasks.Count-1 do
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]
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9
