|
Вопрос # 5 318/ вопрос открыт / |
|
Доброго времени суток, уважаемые эксперты!
Решаю задачу - в матрице из 1 и 0 найти самый большой прямоугольник из 0
Написала код, но он не работает((
Как устранить ошибку не знаю, проверяла логику уже сотни раз что-то исправляла, что то добавляла, но по прежнему не работает
В приложение прикладываю код с пометками, что, кто и как там
А в остальном не знаю что добавить
Очень надеюсь на вашу помощь
Заранее спасибо =-)
Приложение: Переключить в обычный режим- program Project1;
-
- {$APPTYPE CONSOLE}
-
- uses
- SysUtils;
-
- const n=10;{visota, stroki} m=5;{shirina, stolb}
- type mas=array[1..n,1..m]of integer;
- var i,j,q,w,e,w2:integer;
- a:mas;
- xnach,ynach:integer; {coordinati levogo verhnego tekushego}
- xcon,ycon:integer;
- x1,x2,y1,y2:integer;{koordinati max priam}
- smax,s:integer;
- k{shirina priam.},t{visota}:integer;
- rabotaem:boolean;{dlia prekrashenia poiska priamoygol'nika v tekyshei iacheike}
-
- procedure vivod(a:mas;n,m:integer);
- begin
- for i:=1 to n do
- begin
- for j := 1 to m do
- write(a[i,j],' ');
- writeln;
- end;
- end;
-
- begin
-
- randomize;
- for i:= 1 to n do
- for j:= 1 to m do
- a[i,j]:=random(2);
-
- vivod(a,n,m);
- s:=0; {s tekyshego}
- smax:=1; {max s poschitannay}
- rabotaem:=true;
-
- for i:=1 to n do
- for j:= 1 to m do
- if a[i,j]=0 then
- begin {5}
- xnach:=i; ynach:=j;
- t:=i; k:=j;{stroki}
- w:=0;
-
- while (a[t,k]=0) and (t<=n) do
- begin
- t:=t+1;
- w:=w+1;
- end;
- s:=s+w;
- xcon:=t-1; ycon:=k; writeln('1 ',t,' ',w,' ',s,' ',xcon,' ',ycon);
- if s>smax then
- begin
- smax:S;
- x1:=xnach;
- x2:=xcon;
- y1:=ynach;
- y2:=ycon;
- end;
-
- while (w<>0) do
- begin{3}
- w2:=0;{sravnenie kol-va stolbcov v dr.strokah}
- for e:=j+1 to m do
- begin {4}
- for q := 1 to w do if a[i+q-1,e]=0 then w2:=w2+1;
- s:=s+w;
- if w2=w then
- begin
- s:=s+w;
- ycon:=ycon+1;
- if s>smax then
- begin
- smax:S;
- y2:=ycon;
- end;
- end
- else
- begin
- w:=w-1;
- if w2<>0 then
- begin
- s:=s-(e-1);
- xcon:=xcon-1;
- if s>smax then
- begin
- smax:S;
- y2:=ycon;
- x2:=xcon;
- end;
- end;
- w2:=0;
- end;
- end; {4}
- w:=0;
- s:=0
- end;{3}
-
- end; {5}
- Writeln(smax,' ploshad ',x1,' ',y1,' ',x2,' ',y2);
- readln;
- end.
 |
Вопрос задала: Haenta (статус: Посетитель)
Вопрос отправлен: 25 мая 2011, 19:57
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 14; последнее сообщение — 26 мая 2011, 18:19; участников в обсуждении: 3.
|
min@y™ (статус: Доктор наук), 25 мая 2011, 20:07 [#1]:
Ты серьёзно реально думаешь, что кто-то будет копаться в этой жуткой писанине? Проще и быстрее с нуля написать.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Haenta (статус: Посетитель), 25 мая 2011, 20:18 [#2]:
Мы ещё только учимся, поэтому не всё сразу получается
В коде есть расшифровки
Если бы всё было так легко и просто, наверное, уже всё бы решили и написали..
Всё же надеюсь на помощь с указанием ошибки в коде..
А кофе на клавиатуру тоже вирус пролил?
|
|
|
min@y™ (статус: Доктор наук), 25 мая 2011, 20:25 [#3]:
Я ж вижу, что код был написано на турбо-паскале, причём писарь не знал, как переключать раскладку клавиатуры в DOS-окне и писал комменты транслитом, от которого глаза режет. Также блещут профессионализмом одно- и двухбуквенные имена переменных. Я сильно сомневаюсь, что кто-то на этои портале будет препарировать этот код и делать рефакторинг, т.к. на это уйдёт на порядок больше времени, чем на написание программы с нуля.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
Мережников Андрей (статус: Абитуриент), 25 мая 2011, 20:29 [#4]:
Что значит не работает? какую ошибку выдает?
|
|
|
Haenta (статус: Посетитель), 25 мая 2011, 20:33 [#5]:
А ошибки нет, просто работает не правильно: высчитывает непонятное число
А кофе на клавиатуру тоже вирус пролил?
|
|
|
Haenta (статус: Посетитель), 25 мая 2011, 20:48 [#7]:
Произвольную матрицу брала, смотрела какие значения у переменных получались и какие должны были быть
Значения не совпадали(
А кофе на клавиатуру тоже вирус пролил?
|
|
|
Мережников Андрей (статус: Абитуриент), 25 мая 2011, 21:01 [#8]:
Цитата (Haenta):
Произвольную матрицу брала, смотрела какие значения у переменных получались и какие должны были быть
это не логику проверяли, а результат работы. Поставьте себя на место компьютера. Возьмите небольшую произвольную матрицу и попробуйте выполнить программу вручную. Может найдете где ошибка в алгоритме.
|
|
|
Haenta (статус: Посетитель), 25 мая 2011, 21:05 [#9]:
Мережников Андрей:
>Возьмите небольшую произвольную матрицу и попробуйте выполнить программу вручную. Может найдете где ошибка в алгоритме.
Так тоже делала найти не получается
Точнее находила исправляла, находтла исправляла и все равно не работает
А кофе на клавиатуру тоже вирус пролил?
|
|
|
Мережников Андрей (статус: Абитуриент), 25 мая 2011, 22:07 [#10]:
min@y правильно сказал - переименуйте переменные так, чтобы понятно было какая за что отвечает и напишите нормальные комментарии - самой проще разобраться будет. Что такое, например, переменные w и w2? Черт ногу сломит.
|
|
|
Haenta (статус: Посетитель), 25 мая 2011, 23:16 [#11]:
ну вот..
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
const n=10;{высота, строки} m=5;{ширина, столбцы}
type mas=array[1..n,1..m]of integer;
var i,t,q:integer;{счетчики строк}
k,j,e:integer; {счетчики столбцов}
w,w2:integer;{w-кол-во подрядидущих 0 справа от текущего элемента матрицы}
a:mas; {w2-кол-во подряд идущих 0 справа от элемента под текущим в строке e}
xnach,ynach:integer; {координаты левого верхнего угла текущего прямоугольника}
xcon,ycon:integer; {координаты правого нижнего угла текущего}
x1,x2,y1,y2:integer;{координаты наибольшего прямоугольника}
smax,s:integer; {площади наибольшего и текущего}
procedure vivod(a:mas;n,m:integer);
begin
for i:=1 to n do
begin
for j := 1 to m do
write(a[i,j],' ');
writeln;
end;
end;
begin
randomize;
for i:= 1 to n do
for j:= 1 to m do
a[i,j]:=random(2);
vivod(a,n,m);
s:=0;
smax:=1;
for i:=1 to n do
for j:= 1 to m do
if a[i,j]=0 then {текущий элемент}
begin {5}
xnach:=i; ynach:=j;
t:=i; k:=j;
w:=0;
while (a[t,k]=0) and (t<=n) do {в право от текущего }
begin
t:=t+1;
w:=w+1; {считая 0}
end;
s:=s+w;
xcon:=t-1; ycon:=k; {сохраняем координаты правого нижнего угла текущего}
if s>smax then
begin
smax:S; {сравниваем площ.текузего с площ.максимального}
x1:=xnach;
x2:=xcon; {сохраняем координаты максимального}
y1:=ynach;
y2:=ycon;
end;
while (w<>0) do
begin{3}
w2:=0;
for e:=j+1 to m do {от столбца текущего до конечного}
begin {4}
for q := 1 to w do if a[i+q-1,e]=0 then w2:=w2+1;{*}
s:=s+w; {*считаем подряд идущие 0 справа от эл-та под текущим в строке e}
if w2=w then {если значения совпадают значит фигура прямоугольник}
begin
s:=s+w;
ycon:=ycon+1;
if s>smax then
begin
smax:S;
y2:=ycon;
end;
end
else
begin {не совпадают - уменьшаем W до тех пор пока колво 0 в строках не совпадет}
w:=w-1;
if w2<>0 then
begin {если w2=0 то площадь ненадо уменьшать}
s:=s-(e-1);
xcon:=xcon-1;
if s>smax then
begin
smax:S;
y2:=ycon;
x2:=xcon;
end;
end
else w:=0; {если w2=0 то следущие строки проверять не нужно}
w2:=0;
end;
end; {4}
w:=0;
s:=0;
end;{3}
end; {5}
Writeln(smax,' ploshad ',x1,' ',y1,' ',x2,' ',y2);
readln;
end.
А кофе на клавиатуру тоже вирус пролил?
|
|
|
Мережников Андрей (статус: Абитуриент), 26 мая 2011, 05:50 [#12]:
Цитата (Haenta):
while (a[t,k]=0) and (t<=n) do {в право от текущего } begin t:=t+1;
если t - это счетчик строк, то почему перемещение вправо - ассоциируется с перемещением по строкам?
|
|
|
min@y™ (статус: Доктор наук), 26 мая 2011, 08:10 [#13]:
Цитата (Haenta):
ну вот..
Понятней не стало.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Haenta (статус: Посетитель), 26 мая 2011, 18:19 [#14]:
было напутано со стороками и столбцами, но не работает по прежнему..(
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
const n=10;{высота, строки} m=5;{ширина, столбцы}
type mas=array[1..n,1..m]of integer;
var i,t,q:integer;{счетчики строк}
k,j,e:integer; {счетчики столбцов}
w,w2:integer;{w-кол-во подрядидущих 0 справа от текущего элемента матрицы}
a:mas; {w2-кол-во подряд идущих 0 справа от элемента под текущим в строке e}
xnach,ynach:integer; {координаты левого верхнего угла текущего прямоугольника}
xcon,ycon:integer; {координаты правого нижнего угла текущего}
x1,x2,y1,y2:integer;{координаты наибольшего прямоугольника}
smax,s:integer; {площади наибольшего и текущего}
procedure vivod(a:mas;n,m:integer);
begin
for i:=1 to n do
begin
for j := 1 to m do
write(a[i,j],' ');
writeln;
end;
end;
begin
randomize;
for i:= 1 to n do
for j:= 1 to m do
a[i,j]:=random(2);
vivod(a,n,m);
s:=0;
smax:=1;
for i:=1 to n do {строки}
for j:= 1 to m do {столбцы}
if a[i,j]=0 then {текущий элемент}
begin {5}
ynach:=i; xnach:=j;
t:=i; k:=j;
w:=0;
while (a[t,k]=0) and (k<=m) do {в право от текущего }
begin
k:=k+1;
w:=w+1; {считая 0}
end;
s:=s+w;
ycon:=t; xcon:=k-1; {сохраняем координаты правого нижнего угла текущего}
if s>smax then
begin
smax:S; {сравниваем площ.текузего с площ.максимального}
x1:=xnach;
x2:=xcon; {сохраняем координаты максимального}
y1:=ynach;
y2:=ycon;
end;
while (w<>0) do
begin{3}
w2:=0;
for q:=i+1 to n do {от столбца текущего до конечного}
begin {4}
for e := 1 to w do if a[q,j+e-1]=0 then w2:=w2+1;{*}
s:=s+w; {*считаем подряд идущие 0 справа от эл-та под текущим в строке q}
if w2=w then {если значения совпадают значит фигура прямоугольник}
begin
s:=s+w;
ycon:=ycon+1;
if s>smax then
begin
smax:S;
y2:=ycon;
end;
end
else
begin {не совпадают - уменьшаем W до тех пор пока колво 0 в строках не совпадет}
w:=w-1;
if w2<>0 then
begin {если w2=0 то площадь ненадо уменьшать}
s:=s-(e-1);
xcon:=xcon-1;
if s>smax then
begin
smax:S;
y2:=ycon;
x2:=xcon;
end;
end
else w:=0; {если w2=0 то следущие строки проверять не нужно}
w2:=0;
end;
end; {4}
w:=0;
s:=0;
end;{3}
end; {5}
Writeln(smax,' ploshad ',x1,' ',y1,' ',x2,' ',y2);
readln;
end.
А кофе на клавиатуру тоже вирус пролил?
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
