INFOMAN брой 2
{ This is the input data; N; M; Lines; . . .
40 4
8 *
* 28
-4 4
42 42
ЗАТВОРЕНИ ОБЛАСТИ
-----------------
Област за чертане е квадратна област с размери N x N пиксела. Всеки пик-
сел е определен с координатите си по x и по y - цели числа от 0 до N-1 и мо-
жа да е или черен или бял. В областта за чертане могат да се чертаят прави.
Те биват хоризонтални,вертикални или диагонални (под 45ø и 135ø), които се
задават съответно с двойка координати от вида (*,b), (a,*), (a,b), където a
е x-координатата на пресечната точка на съответната права с x-оста, а b -
y-координатата на пресечната точка на правата с y-оста. Двойката (0,0) зада-
ва правата (0,0)-(N-1,N-1). Пресечните точки с координатните оси могат и да
са извън областта за чертаене. Част от областта е затворена област,ако е ог-
радена отвсякъде с части от прави. При зададен размер на квадратната област
за чертаене N и M на брой прави, зададени по описания начин, да се състави
програма, която намира площтта на най-голямата по площ затворена област.
РЕШЕНИЕ: Ще представим областта като матрица N x N от 16-битови стойности.
Първо ще инициализираме матрицата с нули и след това последователно ще пос-
тавим в нея правите от входния файл. Всеки пиксел, на който лежи права, ще
отбелязваме в матрицата с константата aLine. Ще намерим всичките области на
матрицата като я сканираме отгоре надолу и отляво надясно и оцветяваме съсе-
дните пиксели, върху които няма линия (които не са черни) с някакъв цвят.Ко-
гато стигнем линия, увеличаваме с 1 номера на цвета. Така следващата област
оцветяв. с друг цвят и в крайна сметка всяка област трябва да остане оцвете-
на с различен цвят. По броя на квадратчетата оцветени с всеки от цветовете
можем да намерим най-голямата област и площтта й. Съседни наричаме квадрат-
четата отгоре, отдолу, отляво и отдясно на текущото. Понеже оцветяваните об-
ласти могат да имат триъгълни стени, ако оцветяваме с един и същ цвят само
съседните пиксели, понеже сканираме отляво надясно, може да се получи така,
че два съседни пиксела от една и съща област да имат различен цвят. Затова
след като един пиксел се оцвети,се проверява дали съседният му пиксел вляво
има друг цвят и ако има, този пиксел се боядисва с цвета на другия и общия
брой използвани цветове се намалява с едно,защото увеличаването на броя цве-
тове се е оказало грешна стъпка. Това може да се получи само ако при скани-
рането се преминава отляво надясно и се премине през диагонална линия накло-
нена на 45ø, която е стена на област, която се започната да се оцветява. За
повече подробности разгледайте програмата. Понеже броя на областите може да
не се събере в 1 байт, се използва word. Програмата е реализирана до N=500
стига разбира се броя на областите да не надвишава 32767 (заради проблеми с
паметта). След като всички области се намерят, се премахват тези, които не
са затворени. Една област не е затворена, ако някой неин пиксел граничи със
стена от областта за чертане.
}
CONST InFileName = 'in1.txt';
OutFileName = '';
MaxN = 500;
aLine = MaxInt;
TYPE EdinRed = array[0..MaxN] of integer;
TOblastiSize = array[1..MaxInt] of word;
VAR N,BrOblasti: integer;
K: array[0..MaxN] of ^EdinRed;
OblastiSize: ^TOblastiSize;
Procedure ReadData; { Прочита входните данни и чертае линиите в матрицата K }
Procedure HorizontalLine(y:integer);
Var x: integer;
Begin { Нанася в K хоризонтална права (0,y)-(N-1,y) }
if y in[0..N-1] then
for x:= 0 to N-1 do
k[x]^[y]:= aLine;
End;
Procedure VerticalLine(x:integer);
Var y: integer;
Begin { Нанася в K вертикална права (x,0)-(x,N-1) }
if x in[0..N-1] then
for y:= 0 to N-1 do
k[x]^[y]:= aLine;
End;
Procedure DiagonalLine(x,y:integer);
Begin { Нанася в K диагонална права (x,0)-(0,y) на 135ø или на 45ø }
if (x = y) and (x<>0) then
begin { правата е на 135ø }
x:=x; y:=0;
repeat
if (x>=0) and (y>=0) and (x<=N-1) and (y<=N-1) then
k[x]^[y]:=aLine;
x:= x-1; y:= y+1;
until x < 0;
end
else
begin { правата е на 45ø }
x:=x; y:=0;
repeat
if (x>=0) and (y>=0) and (x<=N-1) and (y<=N-1) then
k[x]^[y]:=aLine;
x:= x+1; y:= y+1;
until x > N-1;
end
End;
Procedure GetCislo(var s: string; var c:integer);
Var sign: integer; { Извлича числото, с което започва низа s }
Begin
s:=s+'@';
if s[1]='-' then
begin delete(s,1,1); sign:=-1; end
else sign:=1;
c:=0;
while S[1] in['-','0'..'9'] do
begin c:= c*10 + ord(S[1])-48; delete(S,1,1); end;
c:=sign*c;
End;
Var F: Text;
M,a,b: integer;
S: string;
Begin
Assign(F,InFileName); Reset(F);
ReadLn(F,N,M);
for N:= 0 to N-1 do
begin New(K[N]); FillChar(K[N]^,SizeOf(K[N]^),0); end;
Inc(N);
for M:= 1 to M do
begin { Прочита и чертае в работната област M-те линни от входния файл }
ReadLn(F,S);
if S[1] = '*' then
begin
delete(S,1,2);
GetCislo(s,b);
HorizontalLine(b);
end
else
if S[length(S)] = '*' then
begin
GetCislo(s,a);
VerticalLine(a);
end
else
begin
GetCislo(s,a);
delete(s,1,1);
GetCislo(s,b);
DiagonalLine(a,b);
end;
end;
Close(F);
End;
Procedure FindOblasti;
Function Min(a,b:integer): integer;
Begin if A<B then Min:=A else Min:=B; end;
Function Get(x,y:integer): integer;
Begin
if (x<0) or (X>N-1) or (y<0) or (y>N-1) or
(K[x]^[y]=0) or (K[x]^[y]=aLine) then Get:=aLine
else Get:=K[x]^[y];
End;
Var x,y,m,Left,Up: integer;
Begin
BrOblasti:=0;
for y:= 0 to N-1 do
for x:= 0 to N-1 do
if K[x]^[y]<>aLine then
begin
Left:= Get(x-1,y);
Up:= Get(x,y-1);
m:= Min(Left,Up);
if m = aLine then
begin Inc(BrOblasti); K[x]^[y]:=BrOblasti; end
else
begin
K[x]^[y]:=m;
if (Left > m) and (Left<>aLine) then
begin Dec(BrOblasti); K[x-1]^[y]:=m; end
end;
end;
End;
Procedure FindOblastiSize;
Type TFalshiviOblasti = array[1..MaxInt] of boolean;
Var i,x,y,obl: integer;
FalshivaOblast: ^TFalshiviOblasti;
Begin
New(OblastiSize);
FillChar(OblastiSize^,SizeOf(OblastiSize^),0);
New(FalshivaOblast);
FillChar(FalshivaOblast^,SizeOf(FalshivaOblast^),false);
{Calculate all oblasti size}
for x:= 0 to N-1 do
for y:= 0 to N-1 do
begin
Obl:=k[x]^[y];
if (x=0) or (y=0) or (x=N-1) or (y=N-1) then
if Obl <> aLine then
FalshivaOblast^[Obl]:=true;
Inc(OblastiSize^[Obl]);
end;
{Remove falshivite oblasti}
for I:= 1 to BrOblasti do
if FalshivaOblast^[i] then
OblastiSize^[i]:=0;
Dispose(FalshivaOblast);
End;
Procedure WriteSolutionToFile;
Var F: Text;
MaxOblastSize,i: word;
Begin
Assign(F,OutFileName); Rewrite(F);
MaxOblastSize:=0;
for i:= 1 to BrOblasti do
if OblastiSize^[i] > MaxOblastSize then
MaxOblastSize:= OblastiSize^[i];
WriteLn(F,MaxOblastSize);
Close(F);
End;
BEGIN
ReadData;
FindOblasti;
FindOblastiSize;
WriteSolutionToFile;
END.