скачать рефераты
  RSS    

Меню

Быстрый поиск

скачать рефераты

скачать рефератыКурсовая работа: Градиентный метод первого порядка

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.


Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9


Новости

Быстрый поиск

Группа вКонтакте: новости

Пока нет

Новости в Twitter и Facebook

  скачать рефераты              скачать рефераты

Новости

скачать рефераты

Обратная связь

Поиск
Обратная связь
Реклама и размещение статей на сайте
© 2010.