Чёрный квадрат Опции

[алекс ди]

Попалась тут мне недавно на глаза одна интересная задача, которую я не смог решить  ;D(я только начал изучать паскаль), но думаю что другим она "понравится"
Задача: В матрице А(m,n), состоящей из одних нулей и единиц, найти квадрат наибольшего размера, состоящий из нулей.
PS: ответьте мне, плиз, у всех ли эта задача вызвала затруднения? я лично на ней просто завис :-[

[GLuk]

{Алгоритм кривой ;) пока, если надо - оптимизирую}

Код

Uses
   Crt;
Const
    M = 140; {Лучше поставить значения поменьше, т.к. на моем 750 МГц он считал 1767 мс}
    N = 160;
    {a:array[1..M, 1..N] of Byte = ((0,0,0,1,0,0),
                                   (0,0,0,1,0,0),
                                   (0,0,0,1,0,0),
                                   (0,0,0,0,0,0));}
Var
  i,j:Word;
  Max, SideL:Word;
  Process:Boolean;
  a:array[1..M, 1..N] of Byte;
  T:LongInt;

Function FindSquare(SideL:Word):Boolean;
var
  MaxD,MaxR,i,j,k,j1,i1:Word;
  MaxS:Word;
  Find:Boolean;
begin
    MaxR:=N - SideL + 1;
    MaxD:=M - SideL + 1;
    k:=MaxR*MaxD;
    FindSquare:=False; j1:=1; i1:=1;
    For j1:=1 to MaxR do
    For i1:=1 to MaxD do
    begin
         Find:=True;
         For j:=j1 to j1+SideL-1 do
             For i:=i1 to i1+SideL-1 do
             begin
                  If a[i,j]=1 then Find:=False;
             end;
         If Find then FindSquare:=True;
    end;
end;
Begin
    ClrScr;
    If M>N then Max:=N else Max:=M;
    Randomize;
    For i:=1 to M do
    begin
         For j:=1 to N do
         begin
              a[i,j]:=Random(2);
              Write(a[i,j],#32);
         end;
         Write(#13#10);
    end;
    Process:=True;
    SideL:=Max;
    WriteLn(#13#10'Максимальная длина стороны квадрата  = ', SideL);
    T:=MemL[$40:$6c];
    While Process do
    begin
         If SideL=1 then Process:=False
         else
         If FindSquare(SideL) then Process:=False;
         Dec(SideL);
    end;
    WriteLn('Максимальная длина стороны квадрата = ',SideL+1);
    WriteLn('Общее время счета = ',MemL[$40:$6c]-T,' мс');
End.

Сообщение отредактировано: volvo - 17.12.2004 11:25

[алекс ди]

2 GLuk  :)
Принцип пока не очень понял, но вроде работает.
Но всё равно, спасибо за ответ. ;)