evg
Дан план замка.
Напишите программу, которая определяет:
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.txt
4
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 5
Output.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.

Коментарии