Чёрный квадрат |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Чёрный квадрат |
алекс ди |
Сообщение
#1
|
Гость |
Попалась тут мне недавно на глаза одна интересная задача, которую я не смог решить ;D(я только начал изучать паскаль), но думаю что другим она "понравится"
Задача: В матрице А(m,n), состоящей из одних нулей и единиц, найти квадрат наибольшего размера, состоящий из нулей. PS: ответьте мне, плиз, у всех ли эта задача вызвала затруднения? я лично на ней просто завис :-[ |
GLuk |
Сообщение
#2
|
Профи Группа: Пользователи Сообщений: 775 Пол: Мужской Репутация: 0 |
{Алгоритм кривой ;) пока, если надо - оптимизирую}
Код 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 - |
алекс ди |
Сообщение
#3
|
Гость |
2 GLuk :)
Принцип пока не очень понял, но вроде работает. Но всё равно, спасибо за ответ. ;) |
Текстовая версия | 23.12.2024 20:36 |