Напишите программу, которая определяет:
1) Количество комнат в замке; 2) Площадь крупнейшей комнаты; 3) Какую стену в замке нужно удалить, чтобы получить комнату наибольшей площади; 4) Замок условно разделен на m ∙ n ячеек (1≤ m ≤ 50, 1≤ n ≤ 50). Каждая такая клетка может иметь от 0 до 4 стен.
Входные данные: план замка размещается во входном файле с именем Input.txt в виде последовательности чисел - по одному числу, характеризующий каждую клеточку. В первой строке файла записано число клеток в направлении с севера на юг. Во второй строке - число клеток в направлении с запада на восток. В следующих строках каждая клетка описывается числом р (0 ≤ р ≤ 15). Это число является суммой следующих номеров:
1 - если ячейка имеет западную стену; 2 - если ячейка имеет северную стену; 4 - если ячейка имеет восточную стену; 8 - если ячейка имеет южную стену.
Считается, что внутренняя стена принадлежит обоим клеточкам. Например, южная стена в ячейке (1, 1) также является северной стеной в ячейке (2, 1). Замок содержит минимум две комнаты.
Выходные данные: в исходном файле Output.txt должно быть три строки. В первой строке содержится число комнат, во втором - площадь крупнейшей комнаты (измеряется количеством ячеек). Третью строчку определяет стену, которую необходимо удалить: номер строки и номер столбца ячейки, содержит стену, которую необходимо удалить, и положение этой стены в клетке (N - север, W - запад, S - юг, E - восток)
Пример ввода и вывода: Input.txt4 7 11 6 11 6 3 10 6 7 9 6 13 5 15 5 1 10 12 7 13 7 5 13 11 10 8 10 12 13 5Output.txt
9 4 1 ЕРешение: Код не мой, но немного мной модифицирован для ABCpascal.
var
inp, out: text ;
procedure Init ;
begin
assign(inp, 'input3.txt') ;
reset(inp) ;
assign(out, 'output3.txt') ;
rewrite(out) ;
end { Init } ;
procedure Fini ;
begin
close(inp) ;
close(out)
end { Fini } ;
const
MaxM = 50 ;
MaxN = 50 ;
west=1;
north=2;
east=3;
south=4;
Test=false;
type
Row = 1..MaxM ;
Column = 1..MaxN ;
Direction = array[1..4] of boolean;{(west, north, east, south) ;}
Module = record
wall:array[1..4] of boolean;
nr: integer ; { room number, -1 if unknown }
end { Module } ;
var
M: Row ;
N: Column ;
Map: array [Row, Column] of Module ;
procedure ReadInput ;
{ read M, N, and Map ; initialize room numbers to -1 }
var r: Row ; c: Column ; w: integer ; d: byte ;b:boolean;
begin
readln(inp, M, N) ;
if Test then writeln('Number of rows is ', M:1, ', number of columns ', N:1) ;
for r := 1 to M do begin
for c := 1 to N do begin
read(inp, w) ; { w encodes the walls of module Map[r, c] }
for d := 1 to 4 do begin
b:= odd(w);
Map[r, c].wall[d] := b ;
w := w div 2
end { for d } ;
Map[r, c].nr := -1
end { for c with Map } ;
readln(inp)
end { for r } ;
if Test then writeln('Input read') ;
end { ReadInput } ;
procedure WriteCastle ;
{ write Map to output }
var r: Row ; c: Column ;
begin
for c := 1 to N do
if Map[1, c].wall[north] then write(' _') else write(' ') ;
writeln ;
for r := 1 to M do begin
for c := 1 to N do begin
if (c = 1) then if Map[r, c].wall[west] then write('|') else write(' ') ;
if Map[r, c].wall[south] then write('_') else write(' ') ;
if Map[r, c].wall[east] then write('|') else write(' ')
end { for c with Map } ;
writeln
end { for r }
end { WriteCastle } ;
type
RoomNumber = 0..MaxM*MaxN ;
var
rooms: RoomNumber ; { number of rooms completely painted }
procedure PaintMap ;
{ paint the map }
procedure PaintRoom(r: Row; c: Column) ;
{ if Map[r, c] is unpainted then paint it and all modules connected to it }
var t:Module;
begin
if Map[r, c].nr = -1 then begin
Map[r, c].nr := rooms ;
if not Map[r, c].wall[west] then PaintRoom(r, c-1) ;
if not Map[r, c].wall[north] then PaintRoom(r-1, c) ;
if not Map[r, c].wall[east] then PaintRoom(r, c+1) ;
if not Map[r, c].wall[south] then PaintRoom(r+1, c)
end { if }
end { PaintRoom } ;
var r: Row ; c: Column ;
begin
rooms := 0 ;
for r := 1 to M do
for c := 1 to N do
if Map[r, c].nr = -1 then begin
PaintRoom(r, c) ;
rooms := succ(rooms)
end { if }
end { PaintMap } ;
procedure WriteColors ;
{ write Map colors to output }
var r: Row ; c: Column ;
begin
for r := 1 to M do begin
for c := 1 to N do write(Map[r, c].nr:2) ;
writeln
end { for r }
end { WriteColors } ;
var
area: array[RoomNumber] of integer ; { area[n] is area of room nr. n }
maxarea: integer ; { maximum room area }
procedure MeasureRooms ;
var r: Row ; c: Column ; n: RoomNumber ;
begin
for n := 0 to pred(rooms) do area[n] := 0 ;
for r := 1 to M do
for c := 1 to N do
inc(area[Map[r, c].nr]) ;
maxarea := 0 ;
for n := 0 to pred(rooms) do
if area[n] > maxarea then maxarea := area[n]
end { MeasureRooms } ;
var
bestrow: Row ; bestcol: Column ; bestdir: byte ;
procedure BestWall ;
var r: Row ; c: Column ; maxp: integer ;
procedure Update(k1, k2: RoomNumber; d: byte) ;
var p: integer ;
begin
if k1 = k2 then p := area[k1] else p := area[k1] + area[k2] ;
if p > maxp then begin
maxp := p ; bestrow := r ; bestcol := c ; bestdir := d
end { if }
end { Update } ;
begin
maxp := 0 ;
for c := 1 to N do
for r := 1 to M do
begin
if (r
M) and Map[r, c].wall[south] then Update(Map[r, c].nr, Map[r+1, c].nr, south) ;
if (c
N) and Map[r, c].wall[east] then Update(Map[r, c].nr, Map[r, c+1].nr, east) ;
end { for c with Map }
end { BestWall } ;
procedure ComputeAnswer ;
begin
PaintMap ;
if Test then WriteColors ;
MeasureRooms ;
BestWall
end { ComputeAnswer } ;
procedure WriteOutput ;
begin
if Test then begin
writeln('Number of rooms = ', rooms:1) ;
writeln('Maximum room area = ', maxarea:1) ;
writeln('Best wall to remove = ', bestrow:1, ' ', bestcol:1, ' ', bestdir:1)
end { if Test } ;
writeln(out, rooms:1) ;
writeln(out, maxarea:1) ;
write(out, bestrow:1, ' ', bestcol:1, ' ') ;
case bestdir of
south: writeln(out, 'S') ;
east: writeln(out, 'E') ;
end { case }
end { WriteOutput } ;
begin
Init ;
ReadInput ;
if Test then WriteCastle;
ComputeAnswer ;
WriteOutput ;
Fini
end.