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

[Tauka]

В матрице А(m,n), которая состоит из любых чисел найти найбольший квадрат (квадратную подматрицу), состоящий целиком из единиц.

Идеи какие-то есть и понимаю, что она несложная, но пока реализовать не получается.  ???

[Tauka]

уже сделано! Ура!  ;)

[Ivs]

уже сделано! Ура!  ;)

Выкладывай  свое решение, а вот мое, с небольшим наворотом:

Код

Program Black_Square;

Uses CRT;

Const
  N = 4;
  M = 4;
Var
  A    : Array [1..N, 1..M] of Integer;
  i, j : Integer;
  im,jm: Integer;
  k    : Integer;
  iMax : Integer;
  Max  : Integer;
  B    : Boolean;

Procedure ReadMatrix;
Begin
  for i := 1 to N do
  begin
     for j := 1 to M do
     begin
      Write('A[',i,',',j,']= ');
      ReadLn(A[i,j]);
     end;
  end;
End;

Procedure PrintMatrix;
Begin
  for i := 1 to N do
  begin
     for j := 1 to M do
     begin
      if (i >= im) and (i<= im + Max - 1) and
         (j >= jm) and (j<= jm + Max - 1)
      then TextColor(Red)
      else TextColor(LightGray);
      Write(A[i,j] : 2);
     end;
     WriteLn;
  end;
  TextColor(LightGray);
End;

Function Check : Boolean;
Var
  z : Integer;
Begin
  z := 1;
  while (A[i+k-z,j+k] = 1) and (A[i+k,j+k-z] = 1) and (k >= z) do z := z + 1;
  if (z = k + 1) then Check := TRUE
             else Check := FALSE;
End;

Begin
  FillChar(i, Ofs(B) - Ofs(i) + SizeOf(B), 0);
  ReadMatrix;
  {==========================================}
  for i := 1 to N do
     for j := 1 to M do
     begin
      if A[i,j] = 1 then
      begin
         B := TRUE;
         k := 1;
         if (Max = 0) then begin Max := 1; im := i; jm := j; end;
         while (A[i+k,j+k] = 1) and B do
         begin
            if Check then k := k + 1
                 else B := FALSE;
            if (k > Max) then begin Max := k; im := i; jm := j; end;
         end;
      end;
     end;
  {==========================================}
  WriteLn('Max Black Square is ', Max);
  PrintMatrix;
  ReadLn;
End.

[Tauka]

нет возможности выложить сюда  :-/
но, всё равно, спасибо :о)