Наибольшая подматрица - Turbo Pascal

Узнай цену своей работы

Формулировка задачи:

Дано прямоугольную матрицу натуральных чисел A x B. Найти наибольшую прямоугольную подматрицу, которая состоит из одинаковых чисел. Все числа в матрице не превышают 99 (1 <= A, b <100) Например: 4 2 2 5 7 8 9 3 2 2 5 1 1 1---- -1 1 1 9 2 2 4 1 1 1 -----1 1 1 4 5 6 1 1 1 1------1 1 1 14 1 1 1 1 1------1 1 1 9 9 9----9 9 9 9 9 9----9 9 9 9 9 9----9 9 9

Решение задачи: «Наибольшая подматрица»

textual
Листинг программы
const a=99;b=99;
type mas=array[1..a,1..b] of integer;
var ar:mas;
    i,j,n,m:integer;
    rez,rezi1,rezj1,rezi2,rezj2,tmp,tmpi,tmpj:integer;
{rez-результат,rezi1,rezj1-левый верхний угол искомой подматрицы,}
{rezj1,rezj2-правый нижний}
procedure viv(x:mas;row1,col1,row2,col2:integer);
var i,j:integer;
begin
 for i:=row1 to row2 do
  begin
   for j:=col1 to col2 do write(x[i,j]:3);
   writeln
  end
end;  
function pod(x:mas;i1,j1:integer;var i2,j2:integer):integer;
{нахождение максимальной подматрицы с позиции i1,j1} 
{c элементом a[i1,j1]; i2,j2 - правый нижний угол такой подматрицы}
var ii,jj,ii1,jj1,mm:integer;
    max:integer;
    f:boolean;
begin 
    max:=0;mm:=m;
    for ii:=i1 to n do
     begin
      jj:=j1;
      while jj<=mm do
       begin
        f:=true;ii1:=i1;
        while f and (ii1<=ii) do
         begin
          jj1:=j1;
          while f and (jj1<=jj) do
           begin
            if x[i1,j1]<>x[ii1,jj1] then begin f:=false;mm:=jj1 end; 
            {если нашли элемент отличный от "одинакового" то уменьшаем пространство поиска}
            inc(jj1)
           end;
          inc(ii1)
         end;
        if f and((ii1-i1)*(jj1-j1)>max) 
         then begin max:=(ii1-i1)*(jj1-j1);i2:=ii1-1;j2:=jj1-1 end;
        inc(jj)
       end;
     end;
     pod:=max
end;
begin
 randomize;
 n:=7;m:=9;{readln(n,m);}
 writeln('матрица:');
 for i:=1 to n do
  for j:=1 to m do ar[i,j]:=random(3{100});
 viv(ar,1,1,n,m);
 rezi1:=1;rezj1:=1;
 rez:=pod(ar,rezi1,rezj1,rezi2,rezj2);
 {для каждого элемента ищем подматрицу максимального размера}
 for i:=1 to n do
  for j:=1 to m do
   begin
    tmp:=pod(ar,i,j,tmpi,tmpj);
    if tmp>rez then begin rez:=tmp;rezi1:=i;rezj1:=j;rezi2:=tmpi;rezj2:=tmpj end
   end;
 writeln('наибольшая подматрица из одинаковых элементов:');  
 viv(ar,rezi1,rezj1,rezi2,rezj2);
 writeln('левый верхний угол: a[',rezi1,',',rezj1,']');
 writeln('правый нижний угол: a[',rezi2,',',rezj2,']');
 readln
end.

Объяснение кода листинга программы

const a = 99; b = 99; type mas = array[1..a, 1..b] of integer; var ar: mas; i, j, n, m: integer; rez, rezi1, rezj1, rezi2, rezj2, tmp, tmpi, tmpj: integer; procedure viv(x: mas; row1, col1, row2, col2: integer); var i, j: integer; begin for i := row1 to row2 do begin for j := col1 to col2 do write(x[i, j]: 3); writeln; end; end; end; function pod(x: mas; i1, j1: integer; var i2, j2: integer): integer; var ii, jj, ii1, jj1, mm: integer; max: integer; f: boolean; begin max := 0; mm := m; for ii := i1 to n do begin jj := j1; while jj <= mm do begin f := true; ii1 := i1; while f and (ii1 <= ii) do begin jj1 := j1; while f and (jj1 <= jj) do begin if x[i1, j1] <> x[ii1, jj1] then begin f := false; mm := jj1; end; inc(jj1); end; inc(ii1); end; if f and ((ii1 - i1) (jj1 - j1) > max) then begin max := (ii1 - i1) (jj1 - j1); i2 := ii1 - 1; j2 := jj1 - 1; end; inc(jj); end; inc(ii1); end; end; end; end; return max; end; begin randomize; n := 7; m := 9; writeln('матрица:'); for i := 1 to n do for j := 1 to m do ar[i, j] := random(3{100}); viv(ar, 1, 1, n, m); rezi1 := 1; rezj1 := 1; rez := pod(ar, rezi1, rezj1, rezi2, rezj2); for i := 1 to n do for j := 1 to m do tmp := pod(ar, i, j, tmpi, tmpj); if tmp > rez then begin rez := tmp; rezi1 := i; rezj1 := j; rezi2 := tmpi; rezj2 := tmpj; end; writeln('наибольшая подматрица из одинаковых элементов:'); viv(ar, rezi1, rezj1, rezi2, rezj2); writeln('левый верхний угол: a[', rezi1, ',', rezj1, ']'); writeln('правый нижний угол: a[', rezi2, ',', rezj2, ']'); readln; end.

Оцени полезность:

11   голосов , оценка 4.091 из 5
Похожие ответы