Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.02.2017, 09:26   #1
Kef1r
Форумчанин
 
Регистрация: 13.05.2016
Сообщений: 111
По умолчанию Найти макс. подматрицу из единиц максимального размера

Вводится матрица a(m,n) из 0 и 1. Найти в ней с помощью процедуры квадратную подматрицу из одних единиц максимального размера.
Код:
 Uses crt;
 
 var
  a, s: array[0..100 - 1, 0..100 - 1] of integer;
  n, m, i, j, max_i, max_j, MaxDim: integer;
 
begin
writeln('Введите кл-во строк');
readln(n);
writeln('Введите кл-во столбцов');
readln(m);
  for i := 1 to n do
  begin
    for j := 1 to m do
    begin
      a[i - 1, j - 1] := Random(2);
      Write(a[i - 1, j - 1] + ' ');
    end;
    Writeln;
  end; 
  
  for i := 0 to pred(n) do S[i, 0] := a[i, 0];
  for j := 0 to pred(m) do S[0, j] := a[0, j];
  
  for i := 1 to pred(n) do
  begin
    for j := 1 to pred(m) do
    begin
      if a[i, j] = 1 then
        S[i, j] := min(min(S[i, j - 1], S[i - 1, j]), S[i - 1, j - 1]) + 1
      else
        S[i, j] := 0;
    end;
  end;
  
  MaxDim := S[0, 0];max_i := 0;max_j := 0;
  for i := 0 to pred(n) do
  begin
    for j := 0 to pred(n) do
    begin
      if MaxDim < S[i, j] then
      begin
        MaxDim := S[i, j];
        max_i := i; 
        max_j := j;
      end;
    end;
  end;
  
  writeln('Размер максимального квадрата ', MaxDim + 'x' + MaxDim);
  
end.
В основном программа работает, но иногда почему то в плотную не видит подматрицу которая находится справа, обычно затрагивающая последний столбец матрицы. Не могу понять как и что исправить, помогите пожалуйста.
Изображения
Тип файла: png Безымянный.png (40.9 Кб, 36 просмотров)
Kef1r вне форума Ответить с цитированием
Старый 04.02.2017, 12:51   #2
digitalis
Старожил
 
Аватар для digitalis
 
Регистрация: 04.02.2011
Сообщений: 4,536
По умолчанию

Странно, что оно вообще работает. Непонятно, при чем тут pred(n) в параметрах цикла, которое совсем из другой оперы ? Почему не просто to n ?
digitalis вне форума Ответить с цитированием
Старый 04.02.2017, 13:56   #3
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Что-то типа такого. Randomize не забудь в начало воткнуть
Код:
  MaxDim:=0;
  for i:=0 to n-1 do
    for j:=0 to m-1 do
      for k:=1 to Min(n-i,m-j) do begin
        for i1:=i to i+k-1 do begin
          for j1:=j to j+k-1 do begin
            xOk:=a[i1,j1]=1;
            if not xOk then Break;
          end;
          if not xOk then Break;
        end;
        if not xOk then Break;
        if MaxDim<k then MaxDim:=k;
      end;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Графы. Найти блок максимального размера morozixa939 Помощь студентам 0 20.12.2012 20:45
Найти колво единиц в массиве igabenu Помощь студентам 5 09.03.2011 18:39
Найти байтс наибольшим числом единиц и найти байт с наибольшим чилом нулей. Найти разность число единиц м Beren42 Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 14.12.2010 17:44
Найти в матрице квадратную подматрицу Apis Помощь студентам 3 26.04.2010 21:18
Найти сумма единиц Bayram_662 Паскаль, Turbo Pascal, PascalABC.NET 6 22.10.2009 22:11