Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
L05.doc
Скачиваний:
2
Добавлен:
12.11.2018
Размер:
124.42 Кб
Скачать

I, j: Integer;

begin

Assign(F, 'c:\a.txt');

Reset(F);

Readln(F, m);

if (m < 1) or (m > mMax) then Halt;

Readln(F, n);

if (n < 1) or (n > nMax) then Halt;

for i := 1 to m do

begin

for j := 1 to n do

begin

Read(F, C[i][j].CellPrice);

{$ifdef RECOURSIVE}

C[i][j].Frequency := 0;

{$else}

C[i][j].PathPrice := 0;

{$endif}

C[i][j].Direction := '?';

end;

Readln(F);

end;

Close(F);

end;

procedure ShowPrices(var C: MyArray);

var

I, j: Integer;

begin

Writeln('ShowPrices');

for i := 1 to m do

begin

for j := 1 to n do

Write(C[i][j].CellPrice : 5);

Writeln;

end;

end;

{$ifdef RECOURSIVE}

procedure ShowFrequencies(var C: MyArray);

var

I, j: Integer;

begin

Writeln('ShowFrequencies');

for i := 1 to m do

begin

for j := 1 to n do

Write(C[i][j].Frequency : 5);

Writeln;

end;

end;

{$endif}

procedure ShowDirections(var C: MyArray);

var

I, j: integer;

begin

Writeln('ShowDirections');

for i := 1 to m do

begin

for j := 1 to n do

Write(C[i][j].Direction : 3);

Writeln;

end;

end;

function Right(i, j: integer): boolean;

begin

if j < n then Right := true else Right := false;

end;

function Down(i, j: integer): boolean;

begin

if i < m then Down := true else Down := false;

end;

{$ifdef RECOURSIVE}

function BestPathRecoursive(i, j: integer; var C: MyArray): integer;

var

id, ir: integer;

begin

Inc(C[i][j].Frequency);

if (i = m) and (j = n) then

BestPathRecoursive := 0

else

begin

if Right(i, j) then

ir := C[i][j + 1].CellPrice + BestPathRecoursive(i, j + 1, C)

else

ir := -1;

if Down(i, j) then

id := C[i + 1][j].CellPrice + BestPathRecoursive(i + 1, j, C)

else

id := -1;

if (ir >= 0) and (id >= 0) then

begin

if ir < id then

begin

C[i][j].Direction := 'r';

BestPathRecoursive := ir;

end

else

begin

C[i][j].Direction := 'd';

BestPathRecoursive := id;

end;

end

else

if ir >=0 then

begin

C[i][j].Direction := 'r';

BestPathRecoursive := ir;

end

else

if id >= 0 then

begin

C[i][j].Direction := 'd';

BestPathRecoursive := id;

end

else

Halt;

end;

end;

{$else} // NonRecoursive

procedure BestPathNonRecoursive(var C: MyArray);

var

i, j, k, ir, id: integer;

begin

C[m][n].PathPrice := 0;

for k := m + n - 1 downto 1 do

for i := m downto 1 do

begin

j := k - i;

if j > n then break;

if j < 1 then continue;

if Right(i, j) then

ir := C[i][j + 1].CellPrice + C[i][j + 1].PathPrice

else

ir := -1;

if Down(i, j) then

id := C[i + 1][j].CellPrice + C[i + 1][j].PathPrice

else

id := -1;

if (ir >= 0) and (id >= 0) then

begin

if ir < id then

begin

C[i][j].Direction := 'r';

C[i][j].PathPrice := ir;

end

else

begin

C[i][j].Direction := 'd';

C[i][j].PathPrice := id;

end;

end

else

if ir >=0 then

begin

C[i][j].Direction := 'r'; C[i][j].PathPrice := ir;

end

else

if id >= 0 then

begin

C[i][j].Direction := 'd'; C[i][j].PathPrice := id;

end

else

Halt;

end;

end;

{$endif}

{$ifdef RECOURSIVE}

procedure ShowPath(var C: MyArray);

{$else}

procedure ShowPath(var C: MyArray; var p: integer);

{$endif}

var

k, i, j: integer;

begin

i := 1;

j := 1;

{$ifndef RECOURSIVE}

p := 0;

{$endif}

for k := 1 to m + n - 2 do

begin

Write(' ', C[i][j].Direction);

if C[i][j].Direction = 'r' then

Inc(j)

else

if C[i][j].Direction = 'd' then

Inc(i)

else

Halt;

{$ifndef RECOURSIVE}

p := p + C[i][j].CellPrice;

{$endif}

end;

Writeln;

end;

begin

InputArray(A);

ShowPrices(A);

tStart := Now();

{$ifdef RECOURSIVE}

p := BestPathRecoursive(1, 1, A);

tFinish := Now();

ShowPath(A);

{$else}

BestPathNonRecoursive(A);

tFinish := Now();

ShowPath(A, p);

{$endif}

Writeln('Price of best path = ', p,

' Elapsed Time = ', ((tFinish - tStart) * 86400.0):0:3);

ShowDirections(A);

{$ifdef RECOURSIVE}

ShowFrequencies(A);

{$endif}

Readln;

end.

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]