Дана матрица, заполненная 0 и 1. Нули - вода, единицы - суша. Острова - это как одиночные, так и группы клеток с единицами, окруженными со всех сторон нулями или краями матрицы. Две единицы образуют один остров, только если их клетки соприкасаются сторонами (не углами) . Написать программу, которая подсчитывает количество островов.
program dvumerni_massiv;
const
maxn = 100;
maxm = 100;
type
tarray = array[1..maxn, 1..maxm] of integer;
var
a: tarray;
n, i, k, j, m, g, h: integer;
procedure Init(var x: tarray; k, l: integer); // создаем массив, где только 0 и 1
var
n, m: integer;
i, j: integer;
begin
for i := 1 to k do
for j := 1 to l do
begin
a[i, j] := random(2);
end;
end;
procedure Print(x: tarray; k, l: integer); //печатаем массив
var
i, j: integer;
begin
for i := 1 to k do
begin
for j := 1 to l do
write(x[i, j]:5);
writeln;
end;
writeln;
end;
function rec(a: tarray;Var i, j: integer): integer; // пытался рекурсией добится нахождения островов, но пишет, что вышел за границы массива.. .
begin
if a[i, j + 1] = 1 then rec(a, i, j); //вот где проблема
if a[i + 1, j] = 1 then rec(a, i, j);
if a[i - 1, j] = 1 then rec(a, i, j);
if a[i, j - 1] = 1 then rec(a, i, j);
end;
begin
randomize;
readln(n, m);
init(a, n, m); //создаём массив
print(a, n, m); // печатаем массив
k := 0;
h := 0; //второстепенные переменные
g := 0;
for i := 1 to n do
for j := 1 to m do
begin //вот где проблема
rec(a, i, j); //попытка рекурсией
inc(g); //увеличение счетчика
end;
writeln(g);
end.
Другие языки программирования и технологии
Помогите решить задачу по паскалю на двумерные массивы.
и какой только ерундой не займешься в воскресенье.. .
да и работать будет только на pascalabc...
uses
GraphABC;
type
TIslands = class
private
IslEt, IslTmp: array of array of integer;
IslReg: array of array of Color;
SizeX, SizeY: integer;
procedure DeleteIsland(x, y: integer; cl: color);
public
constructor Create();begin randomize end;
procedure GenerateNewIslandsMap(Size_X, Size_Y: integer);
function GetIslandsCount(): Integer;
procedure ShowIslands();
destructor Destroy();begin IslEt := nil; IslTmp := nil end;
end;
procedure TIslands.DeleteIsland(x, y: integer; cl: color);
begin
IslTmp[x, y] := 0;
IslReg[x, y] := cl;
if (x + 1 < SizeX) and (IslTmp[x + 1, y] = 1) then DeleteIsland(x + 1, y,cl);
if (x - 1 > -1) and (IslTmp[x - 1, y] = 1) then DeleteIsland(x - 1, y,cl);
if (y + 1 < SizeY) and (IslTmp[x, y + 1] = 1) then DeleteIsland(x, y + 1,cl);
if (y - 1 > -1) and (IslTmp[x, y - 1] = 1) then DeleteIsland(x, y - 1,cl);
end;
procedure TIslands.GenerateNewIslandsMap(Size_X, Size_Y: integer);
var
x, y: integer;
begin
SizeX := Size_X;
SizeY := Size_Y;
SetLength(IslEt, SizeX);
SetLength(IslTmp, SizeX);
SetLength(IslReg, SizeX);
for x := 0 to SizeX - 1 do
begin
SetLength(IslEt[x], SizeY);
SetLength(IslReg[x], SizeY);
for y := 0 to SizeY - 1 do
begin
IslEt[x, y] := random(2);
IslReg[x, y] := clLightGray;
end;
IslTmp[x] := copy(IslEt[x]);
end;
end;
function TIslands.GetIslandsCount(): Integer;
var
x, y, count: integer;
begin
for x := 0 to SizeX - 1 do
for y := 0 to SizeY - 1 do
if IslTmp[x, y] = 1 then
begin
DeleteIsland(x, y, clrandom);
inc(count);
end;
result := count;
end;
procedure TIslands.ShowIslands();
var
x, y: integer;
begin
for y := 0 to SizeY - 1 do
begin
for x := 0 to SizeX - 1 do
begin
Font.Color := IslReg[x, y];
write(IslEt[x, y],' ');
end;
writeln;
end;
end;
var
Islands: TIslands;
x,y:integer;
begin
Font.Size := 14;
Font.Style := fsBold;
Islands := TIslands.Create;
write('Укажите размер карты по оси X:'); readln(x); writeln(x);
write('Укажите размер карты по оси Y:'); readln(y); writeln(y);
Islands.GenerateNewIslandsMap(x, y);
writeln('Количество островов: ', Islands.GetIslandsCount());
writeln;
Islands.ShowIslands();
Islands.Destroy;
end.
да и работать будет только на pascalabc...
uses
GraphABC;
type
TIslands = class
private
IslEt, IslTmp: array of array of integer;
IslReg: array of array of Color;
SizeX, SizeY: integer;
procedure DeleteIsland(x, y: integer; cl: color);
public
constructor Create();begin randomize end;
procedure GenerateNewIslandsMap(Size_X, Size_Y: integer);
function GetIslandsCount(): Integer;
procedure ShowIslands();
destructor Destroy();begin IslEt := nil; IslTmp := nil end;
end;
procedure TIslands.DeleteIsland(x, y: integer; cl: color);
begin
IslTmp[x, y] := 0;
IslReg[x, y] := cl;
if (x + 1 < SizeX) and (IslTmp[x + 1, y] = 1) then DeleteIsland(x + 1, y,cl);
if (x - 1 > -1) and (IslTmp[x - 1, y] = 1) then DeleteIsland(x - 1, y,cl);
if (y + 1 < SizeY) and (IslTmp[x, y + 1] = 1) then DeleteIsland(x, y + 1,cl);
if (y - 1 > -1) and (IslTmp[x, y - 1] = 1) then DeleteIsland(x, y - 1,cl);
end;
procedure TIslands.GenerateNewIslandsMap(Size_X, Size_Y: integer);
var
x, y: integer;
begin
SizeX := Size_X;
SizeY := Size_Y;
SetLength(IslEt, SizeX);
SetLength(IslTmp, SizeX);
SetLength(IslReg, SizeX);
for x := 0 to SizeX - 1 do
begin
SetLength(IslEt[x], SizeY);
SetLength(IslReg[x], SizeY);
for y := 0 to SizeY - 1 do
begin
IslEt[x, y] := random(2);
IslReg[x, y] := clLightGray;
end;
IslTmp[x] := copy(IslEt[x]);
end;
end;
function TIslands.GetIslandsCount(): Integer;
var
x, y, count: integer;
begin
for x := 0 to SizeX - 1 do
for y := 0 to SizeY - 1 do
if IslTmp[x, y] = 1 then
begin
DeleteIsland(x, y, clrandom);
inc(count);
end;
result := count;
end;
procedure TIslands.ShowIslands();
var
x, y: integer;
begin
for y := 0 to SizeY - 1 do
begin
for x := 0 to SizeX - 1 do
begin
Font.Color := IslReg[x, y];
write(IslEt[x, y],' ');
end;
writeln;
end;
end;
var
Islands: TIslands;
x,y:integer;
begin
Font.Size := 14;
Font.Style := fsBold;
Islands := TIslands.Create;
write('Укажите размер карты по оси X:'); readln(x); writeln(x);
write('Укажите размер карты по оси Y:'); readln(y); writeln(y);
Islands.GenerateNewIslandsMap(x, y);
writeln('Количество островов: ', Islands.GetIslandsCount());
writeln;
Islands.ShowIslands();
Islands.Destroy;
end.
вопрос в латинице. программа в кириллице.
текст конвертирован самодельной программой.
------------------------------------------
DANA MATRICA, ZAPOLNENNAJ 0 I 1. NULI - VODA, EDINICY - SUSA. OSTROVA - ATO KAK ODINOCNYE, TAK I GRUPPY KLETOK S EDINICAMI, OKRUJENNYMI SO VSEH STORON NULJMI ILI KRAJMI MATRICY. DVE EDINICY OBRAZUUT ODIN OSTROV, TOL'KO ESLI IH KLETKI SOPRIKASAUTSJ STORONAMI (NE UGLAMI) . NAPISAT' PROGRAMMU, KOTORAJ PODSCITYVAET KOLICESTVO OSTROVOV.
ПРОГРАМ ДВУМЕРНИ_МАССИВ;
ЦОНСТ
МАКН = 100;
МАКМ = 100;
ТЫПЕ
ТАРРАЫ = АРРАЫ [1..МАКН, 1..МАКМ] ОФ ИНТЕГЕР;
ВАР
А: ТАРРАЫ;
Н, И, К, Ж, М, Г, Х: ИНТЕГЕР;
ПРОЦЕДУРЕ ИНИТ (ВАР К: ТАРРАЫ; К, Л: ИНТЕГЕР) ; // создаем массив, где только 0 и 1
ВАР
Н, М: ИНТЕГЕР;
И, Ж: ИНТЕГЕР;
БЕГИН
ФОР И := 1 ТО К ДО
ФОР Ж := 1 ТО Л ДО
БЕГИН
А [И, Ж] := РАНДОМ (2);
ЕНД;
ЕНД;
ПРОЦЕДУРЕ ПРИНТ (К: ТАРРАЫ; К, Л: ИНТЕГЕР) ; //печатаем массив
ВАР
И, Ж: ИНТЕГЕР;
БЕГИН
ФОР И := 1 ТО К ДО
БЕГИН
ФОР Ж := 1 ТО Л ДО
ВРИТЕ (К [И, Ж]: 5);
ВРИТЕЛН;
ЕНД;
ВРИТЕЛН;
ЕНД;
ФУНЦТИОН РЕЦ (А: ТАРРАЫ; ВАР И, Ж: ИНТЕГЕР) : ИНТЕГЕР; // пытался рекурсией добится нахождения островов, но пишет, что вышел за границы массива. . .
БЕГИН
ИФ А [И, Ж + 1] = 1 ТХЕН РЕЦ (А, И, Ж) ; //вот где проблема
ИФ А [И + 1, Ж] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ИФ А [И - 1, Ж] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ИФ А [И, Ж - 1] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ЕНД;
БЕГИН
РАНДОМИЗЕ;
РЕАДЛН (Н, М) ;
ИНИТ (А, Н, М) ; //создаём массив
ПРИНТ (А, Н, М) ; // печатаем массив
К := 0;
Х := 0; //второстепенные переменные
Г := 0;
ФОР И := 1 ТО Н ДО
ФОР Ж := 1 ТО М ДО
БЕГИН //вот где проблема
РЕЦ (А, И, Ж) ; //попытка рекурсией
ИНЦ (Г) ; //увеличение счетчика
ЕНД;
ВРИТЕЛН (Г) ;
ЕНД.
текст конвертирован самодельной программой.
------------------------------------------
DANA MATRICA, ZAPOLNENNAJ 0 I 1. NULI - VODA, EDINICY - SUSA. OSTROVA - ATO KAK ODINOCNYE, TAK I GRUPPY KLETOK S EDINICAMI, OKRUJENNYMI SO VSEH STORON NULJMI ILI KRAJMI MATRICY. DVE EDINICY OBRAZUUT ODIN OSTROV, TOL'KO ESLI IH KLETKI SOPRIKASAUTSJ STORONAMI (NE UGLAMI) . NAPISAT' PROGRAMMU, KOTORAJ PODSCITYVAET KOLICESTVO OSTROVOV.
ПРОГРАМ ДВУМЕРНИ_МАССИВ;
ЦОНСТ
МАКН = 100;
МАКМ = 100;
ТЫПЕ
ТАРРАЫ = АРРАЫ [1..МАКН, 1..МАКМ] ОФ ИНТЕГЕР;
ВАР
А: ТАРРАЫ;
Н, И, К, Ж, М, Г, Х: ИНТЕГЕР;
ПРОЦЕДУРЕ ИНИТ (ВАР К: ТАРРАЫ; К, Л: ИНТЕГЕР) ; // создаем массив, где только 0 и 1
ВАР
Н, М: ИНТЕГЕР;
И, Ж: ИНТЕГЕР;
БЕГИН
ФОР И := 1 ТО К ДО
ФОР Ж := 1 ТО Л ДО
БЕГИН
А [И, Ж] := РАНДОМ (2);
ЕНД;
ЕНД;
ПРОЦЕДУРЕ ПРИНТ (К: ТАРРАЫ; К, Л: ИНТЕГЕР) ; //печатаем массив
ВАР
И, Ж: ИНТЕГЕР;
БЕГИН
ФОР И := 1 ТО К ДО
БЕГИН
ФОР Ж := 1 ТО Л ДО
ВРИТЕ (К [И, Ж]: 5);
ВРИТЕЛН;
ЕНД;
ВРИТЕЛН;
ЕНД;
ФУНЦТИОН РЕЦ (А: ТАРРАЫ; ВАР И, Ж: ИНТЕГЕР) : ИНТЕГЕР; // пытался рекурсией добится нахождения островов, но пишет, что вышел за границы массива. . .
БЕГИН
ИФ А [И, Ж + 1] = 1 ТХЕН РЕЦ (А, И, Ж) ; //вот где проблема
ИФ А [И + 1, Ж] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ИФ А [И - 1, Ж] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ИФ А [И, Ж - 1] = 1 ТХЕН РЕЦ (А, И, Ж) ;
ЕНД;
БЕГИН
РАНДОМИЗЕ;
РЕАДЛН (Н, М) ;
ИНИТ (А, Н, М) ; //создаём массив
ПРИНТ (А, Н, М) ; // печатаем массив
К := 0;
Х := 0; //второстепенные переменные
Г := 0;
ФОР И := 1 ТО Н ДО
ФОР Ж := 1 ТО М ДО
БЕГИН //вот где проблема
РЕЦ (А, И, Ж) ; //попытка рекурсией
ИНЦ (Г) ; //увеличение счетчика
ЕНД;
ВРИТЕЛН (Г) ;
ЕНД.
Александр Рындин
42 613
Степан Тырышкин
так в чём у меня ошибка
Похожие вопросы
- Помогите решить задачи по Паскалю
- помогите решить задачу на паскале: напечатать "столбиком" значения sin2, sin3, ..sin 20.
- Помогите решить задачу в паскале
- Помогите решить задачу на паскале
- Помогите решить задачу в паскале. Задание: Заменить в строке все вхождения "да" на "нет".
- Уважаемые!Помогите решить задачу по Паскалю,пожайлуста!
- Помогите решить задачу в паскале
- Помогите решить задачу (в паскале)!
- Помогите решить задачу в паскале, пожалуйста! !
- помогите решить задачу на паскале