Курсовая работа: Градиентный метод первого порядка
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;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
