![]() |
|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
![]() |
|
Опции темы | Поиск в этой теме |
![]() |
#1 |
Новичок
Джуниор
Регистрация: 16.01.2013
Сообщений: 1
|
![]()
Задача 3 Площади островов
Карта моря задана матрицей размера N*M, состоящей из квадратиков, в которых записаны 0 или 1. 0 –это вода,1-суша. Два квадратика с единицами принадлежат одному острову, если они имеют общую сторону. Найти количество островов и площадь каждого острова. Площади островов вывести в порядке неубывания. Входные данные: в первой строке два целых числа N и M (1<=N,M<=100)- размеры матрицы:; В последующих N строках карта моря. В каждой строке M нулей и единиц, не разделенных пробелом. Выходные данные: В первой строке одно целое число – количество островов. Во второй строке площади островов, выведенные в порядке неубывания. Пример:Input.txt Output.tx 2 3 4 2 4 0110 0000 1111 Алгоритм решения этой задачи следующий. Просматривая двумерный массив построчно, найти единицу, принадлежащую острову. Рекурсивно или двумя очередями найти площадь острова, при этом потопив его. Повторять процесс поиска до тех пор пока есть острова. Найденные площади островов запоминаем в одномерном массиве. Когда все острова будут потоплены, сортируем массив площадей по неубыванию и выводим результат. program zad5; Const nmax=10; di:array[1..4]of integer=(0,1,0,-1); dj:array[1..4]of integer=(1,0,-1,0); Var n,m,io,jo,i,j,kolnew,kolold,kol:int eger; new,old:array[1..2,1..nmax] of integer; новая и старая очереди a:array[0..nmax+1,0..nmax+1]of integer; карта s:array[1..nmax*nmax div 2]of integer; массив площадей островов log:boolean; сигнал о том есть ли острова procedure Init; begin assign(input,’input.txt’); reset(input); readln(n,m); считываем размеры fillchar(a,sizeof(a),0); for i:=1 to n do begin for j:=1 to m do begin read(c); считываем символ if c=’1’ then a[i,j]:=1 и помещаем соответствующее значение в массив else a[i,j]:=0; end; readln; переходим на новую строку end; end; Procedure out; вывод результатов var i:integer; begin assign(Output,’Output.txt’); Rewrite(Output); writeln(kol); выводим количество и площади островов for i:=1 to kol do write(s[i],’ ‘); close(Output); end; procedure Poisk(var i0,j0:integer); ищем остров var i,j:integer; begin for i:=1 to n do for j:=1 to m do if a[i,j]=1 then если 1 найдена begin i0:=i; запоминаем ее координаты j0:=j; log:=true; сигнал о том, что остров найден exit; end; end; Procedure Solve; var t:integer; begin kol:=0; repeat повторяем пока есть острова log:=false; Poisk(io,jo); if log then если остров найден begin inc(kol); old[1,1]:=io; помещаем координаты острова в старую очередь old[2,1]:=jo; kolold:=1; количество элементов в старой очереди s[kol]:=1; площадь острова под номером kol равна 1 Repeat пока есть элементы в новой очереди повторяем fillchar(new,sizeof(new),0); очищаем новую очередь kolnew:=0; кол-во элементов в новой очереди равно 0 for i :=1 to kolold do бежим по старой очереди begin a[old[1,i],old[2,i]]:=0; топим кусочек острова for t:=1 to 4 do просматриваем 4 соседние клетки if a[old[1,i]+di[t],old[2,i]+dj[t]]=1 если в соседней клетке 1, то then begin inc(kolnew); кол-во элементов в новой очереди увеличиваем на 1 new[1,kolnew]:=old[1,i]+di[t]; заносим клетку с 1 в новую очередь new[2,kolnew]:=old[2,i]+dj[t]; inc(s[kol]); увеличиваем площадь острова на 1 a[old[1,i]+di[t],old[2,i]+dj[t]]:=0; топим кусочек острова end; end; old:=new; новую очередь делаем старой kolold:=kolnew; Until kolnew=0; end until not log; end; procedure sort; сортируем острова по неубыванию площадей var i,j,p:integer; begin for i:=1 to kol-1 do for j:=i+1 to kol do if s[i]>s[j] then begin p:=s[i]; s[i]:=s[j]; s[j]:=p; end; end; begin init; solve; sort; out; end. |
![]() |
![]() |
![]() |
![]() |
||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Олимпиадная задача. | Godziller | Фриланс | 6 | 28.05.2012 14:10 |
олимпиадная задача | quade1992 | Паскаль, Turbo Pascal, PascalABC.NET | 0 | 17.05.2012 18:57 |
Олимпиадная задача | Saidoz | Паскаль, Turbo Pascal, PascalABC.NET | 7 | 28.10.2011 13:02 |
Олимпиадная задача | Alexey_kor | Помощь студентам | 7 | 30.01.2011 02:22 |
Олимпиадная задача | Carbon | Общие вопросы C/C++ | 2 | 23.05.2007 22:07 |