Дана матрица N*N, заполненная положительными числами. Путь по матрице начинается в левом верхнем углу. За один ход можно пройти в соседнюю по вертикали или горизонтали клетку (если она существует). Нельзя ходить по диагонали, нельзя оставаться на месте. Требуется найти максимальную сумму чисел, стоящих в клетках по пути длиной K (клетку можно посещать несколько раз).
    Ограничения: 2 ≤ N ≤ 15, элементы матрицы имеют значения от 1 до 999, 1 ≤ K ≤ 20, все числа целые, время 5с.
    Ввод из файла route2.in. В первой строке находятся разделенные пробелом числа N и K. Затем идут N строк по N чисел в каждой.
    Вывод в файл route2.out. Вывести одно число - максимальную сумму. [1].

    Комментарии вы можете посмотреть на шаге 11.

    Приведем текст программы:

Program Problem6_5; 
Uses crt;
Var
    f, f1: text;{Файлы: исходный и тот, который надо получить}
    n,k,i,j,z: integer;
    a: array[1..15,1..15]of integer;{Первоначальная матрица}
    sum: array[0..16,0..16]of longint;{Массив сумм}
    b: array[1..15,1..15] of string[100];{Массив пути следования}
    max: longint;
    h: string[4];
    g,w,w1: string;
{----- Код основной программы --------}
Begin
  ClrScr;
  assign(f,'route2.in');{Установка связи между файловой переменной и файлом}
  assign(f1,'route2.out');
  {$I-}reset(f);{$I+}{Проверка открытия файла}
  If IoResult <> 0 Then writeln(' Ошибка в чтении файла !!!!!')
  else
   Begin
    read(f,n,k); {Чтение из файла размерности матрицы и длины пути}
    If (n>15) Or (n<2) Or (k>20) Or (k<1) Then 
              writeln(' Переменные не удовлетворяют условию задачи.')
    else
     Begin
       Writeln(' Длина пути: ',k);{Вывод на экран размерности матрицы и длины пути}
       Writeln(' Матрица :');
       Writeln;
       i:= 1;
       While i <= n Do{Чтение из файла элементов матрицы и их вывод на экран}
         Begin
           For j:= 1 To n Do
            Begin
             read(f,a[i,j]);
             Case a[i,j] Of{Для большей наглядности}
               1..9: h:= '   ';
               10..99: h:= '  ';
               100..999:h:= ' ';
               else h:= '';
             end;
             write(a[i,j],' ', h);
            end;
           writeln;
           i:= i+1;
         end;
       For i:= 0 To n+1 Do{"обнуление" матрицы sum}
         For j:= 0 To n+1 Do
           sum[i,j]:= 0;
       sum[1,1]:= a[1,1];{Первый элемент матрицы sum}
       str(1,w);
       b[1,1]:= w + ',' + w; {Первый элемент матрицы B – строка}
       For z:= 2 To k Do{Заполнение матрицы sum и B}
        Begin
          For i:= 0 To n Do
           For j:= 0 To n Do
             If odd(i+j) <> odd(z) Then{Чтобы не ходил по диагонали}
               Begin
                 max:= 0;{Обнуление}
                 g:= '';
                 {Нахождение максимального элемента}
                 If sum[i+1,j] > max Then{Если элемент справа больше}
                                 Begin
                                   max:= sum[i+1,j];
                                   g:= b[i+1,j];
                                 end;
                 If sum[i-1,j] > max Then{Если элемент слева больше}
                                 Begin
                                   max:= sum[i-1,j];
                                   g:= b[i-1,j];
                                 end;
                 If sum[i,j-1] > max Then{Если элемент сверху больше}
                                 Begin
                                   max:= sum[i,j-1];
                                   g:= b[i,j-1];
                                 end;
                 If sum[i,j+1] > max Then{Если элемент снизу больше}
                                 Begin
                                   max:= sum[i,j+1];
                                   g:= b[i,j+1];
                                 end;
                 If max <> 0 Then{Заполение матриц sum и B}
                                 Begin
                                   sum[i,j]:= max + a[i,j];
                                   str(i,w);
                                   str(j,w1);
                                   b[i,j]:= g + '->' + w + ',' + w1;
                                 end;
               end;
         end;
       max:= 0;
       {Поиск максимального значения в матрице sum}
       For i:= 0 To n Do
         For j:= 0 To n Do
           If sum[i,j] > max Then
             Begin
               max:= sum[i,j];{Максимальная сумма}
               g:= b[i,j];{Путь ее получения}
             end;
       writeln('  Максимальная сумма : ',max);{Вывод на экран максимальной суммы}
       writeln;
       writeln(' Путь следования : ',g);{и пути ее получения}
       {$I-}rewrite(f1);{$I+}{Создание файла}
       If IoResult <> 0 Then writeln('Ошибка !!!!!'){Проверка на ошибки}
        else
          Begin
             writeln(f1,max);{Запись в файл}
             writeln(f1,g);
          end;
       close(f1);{Закрытие файла}
    end;
   end;
  close(f);{Закрытие файла}
  ReadKey;
End.
Текст этой программы можно взять здесь.


(1)Меньшиков Ф.В. Олимпиадные задачи по программированию. - СПб: Питер, 2006. - 315с.