Дана матрица 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.