Решение задачи о посылках

var
   a:array[1..15,1..15] of integer;
   i,j,m,n,s:integer;
   x,y:integer; {коордтнаты текущей ячейки}
   napr,shag:byte; {направление движения и размер шага соответственно}
begin
 n :=3;
 m :=8;
 randomize;
 writeln('Таблица');
 for i:=1 to n do
  begin
   for j:=1 to m do
    begin
     a[1,1]:=1;
     a[1,2]:=2;
     a[1,3]:=3;
     a[1,4]:=4;
     a[1,5]:=5;
     a[1,6]:=6;
     a[1,7]:=7;
     a[1,8]:=8;
     
     a[2,1]:=8;
     a[2,2]:=8;
     a[2,3]:=8;
     a[2,4]:=4;
     a[2,5]:=5;
     a[2,6]:=8;
     a[2,7]:=7;
     a[2,8]:=2;
     
     a[3,1]:=11;
     a[3,2]:=14;
     a[3,3]:=10;
     a[3,4]:=16;
     a[3,5]:=19;
     a[3,6]:=18;
     a[3,7]:=16;
     a[3,8]:=19;
     write(a[i,j]:4);
    end;
   writeln;
  end;
end.

uses
  crt;
const
  i_max = 8;  
type TArr = array[1..i_max] of integer;
const
  ci : TArr = ( 8, 8, 8, 4, 5, 8, 7, 2); //плата за хранение
  ti : TArr = (11,14,10,16,19,18,16,19); //время доставки
  a : TArr = (1,2,3,4,5,6,7,8); //первая последовательность
  b : TArr = (8,7,6,5,4,3,2,1); //последняя последовательность
var 
  min, i : integer; c : TArr;
function Cost(a : TArr) : integer; //стоимость хранения
var c, i, j : integer;
begin
  c := 0;
  for i := 1 to i_max-1 do
   for j := i+1 to i_max do
    c := c + ti[a[i]]*ci[a[j]];
  Cost := c;    
end;    
function Eq(a,b : TArr) : boolean; //проверяет одинаковы ли последовательности
var i : byte;
begin
  Eq := false;
  for i := 1 to i_max do
    If a[i]<>b[i] then exit;
  Eq := true;   
end;
procedure GetNext; //генерирует перестановку в лексикограф порядке
var i,j,temp : integer;
begin
  i := i_max;
  while (i>1) and (a[i]<a[i-1]) do dec(i);
  j := i_max;
  while a[j]<a[i-1] do dec(j);
  temp := a[i-1];
  a[i-1] := a[j];
  a[j] := temp;
  for j := 0 to (i_max-i+1) div 2 - 1 do begin
   temp := a[i+j];
   a[i+j] := a[i_max-j];
   a[i_max-j] := temp;
  end;
end;
begin
  clrscr;
//  writeln(Cost(a));
//  writeln(Cost(b)); 
  min := Cost(a);
  write('№ посылки             ');
  for i := 1 to i_max do write(i:4);
  writeln;  
  write('Ci, плата за хранение ');
  for i := 1 to i_max do begin 
    c[i] := a[i];
    write(ci[i]:4);
  end;
  writeln;
  write('Ti, время доставки    ');
  for i := 1 to i_max do write(ti[i]:4);  
  while Not(Eq(a,b)) do begin
    GetNext;
    If Cost(a)<min then begin
      min := Cost(a);
      for i := 1 to i_max do c[i] := a[i];
    end;
  end;
  writeln;
  writeln('№ посылки             ');
  for i := 1 to i_max do write(c[i]:4);
  writeln();
  writeln('Минимальная стоимость хранения : ',Cost(c));
  readln;
end.