- •Рекурсивные алгоритмы (продолжение)
- •I, j: integer;
- •I, j: integer;
- •I, j: integer;
- •Метод динамического программирования
- •I, j: integer;
- •I, j: Integer;
- •I, j: integer;
- •Тип «Денежный»
- •Стандартные процедуры и функции для работы с любыми файлами
- •Текстовый файл
- •Стандартные процедуры для работы с текстовыми файлами
- •Условная компиляция
- •I, j: Integer;
- •I, j: Integer;
- •I, j: Integer;
- •I, j: integer;
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.