Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 4 KB
program vizgy;
var h,w,e,f,g,l :integer;
a:array[0..10001,0..10001] of integer;
b:array[1..10000,1..10000] of char;
t,t1 :text;
procedure beolvas;
var i,j :integer;
begin
readln(t,h,w);
for i:=0 to h+1 do
begin
for j:=0 to w+1 do
begin
a[j,i]:=10001;
end;
end;
for i:=1 to h do
begin
for j:=1 to w do
begin
read(t,a[j,i]);
end;
end;
end;
function folyik (x1,y1,x2,y2 :integer) :boolean;
begin
folyik:=false;
if a[x1,y1]>a[x2,y2] then
begin
if (y1-1=y2) and (x1=x2) then
begin
if (a[x2,y2]<=a[x1,y1+1]) and (a[x2,y2]<=a[x1-1,y1]) and (a[x2,y2]<=a[x1+1,y1]) then folyik:=true;
end;
if (x1-1=x2) and (y1=y2) then
begin
if (a[x2,y2]<=a[x1,y1+1]) and (a[x2,y2]<a[x1,y1-1]) and (a[x2,y2]<=a[x1+1,y1]) then folyik:=true;
end;
if (x1+1=x2) and (y1=y2) then
begin
if (a[x2,y2]<=a[x1,y1+1]) and (a[x2,y2]<a[x1-1,y1]) and (a[x2,y2]<a[x1,y1-1]) then folyik:=true;
end;
if (x1=x2) and (y1+1=y2) then
begin
if (a[x2,y2]<a[x1,y1-1]) and (a[x2,y2]<a[x1-1,y1]) and (a[x2,y2]<a[x1+1,y1]) then folyik:=true;
end;
end;
end;
procedure bejar (x,y,z :integer);
var i,j :integer;
c :char;
s:array[1..10000,1..2] of integer;
begin
c:=chr(ord('a')+z-1);
i:=1;
j:=1;
s[1,1]:=x;
s[1,2]:=y;
b[x,y]:=c;
while i<=j do
begin
if (s[i,1]<w) and (b[s[i,1]+1,s[i,2]]='0') and (folyik(s[i,1]+1,s[i,2],s[i,1],s[i,2])) then
begin
b[s[i,1]+1,s[i,2]]:=c;
inc(j);
s[j,1]:=s[i,1]+1;
s[j,2]:=s[i,2];
end;
if (s[i,1]>1) and (b[s[i,1]-1,s[i,2]]='0') and (folyik(s[i,1]-1,s[i,2],s[i,1],s[i,2])) then
begin
b[s[i,1]-1,s[i,2]]:=c;
inc(j);
s[j,1]:=s[i,1]-1;
s[j,2]:=s[i,2];
end;
if (s[i,2]>1) and (b[s[i,1],s[i,2]-1]='0') and (folyik(s[i,1],s[i,2]-1,s[i,1],s[i,2])) then
begin
b[s[i,1],s[i,2]-1]:=c;
inc(j);
s[j,1]:=s[i,1];
s[j,2]:=s[i,2]-1;
end;
if (s[i,2]<h) and (b[s[i,1],s[i,2]+1]='0') and (folyik(s[i,1],s[i,2]+1,s[i,1],s[i,2])) then
begin
b[s[i,1],s[i,2]+1]:=c;
inc(j);
s[j,1]:=s[i,1];
s[j,2]:=s[i,2]+1;
end;
inc(i);
end;
end;
procedure betuz;
var i,j,z,k,l,m,n :integer;
begin
z:=0;
for i:=1 to h do
begin
for j:=1 to w do
begin
if b[j,i]='0' then
begin
k:=1;
l:=1;
m:=j;
n:=i;
while k<=l do
begin
if (m<w) and (folyik(m,n,m+1,n)) then
begin
inc(l);
m:=m+1;
end
else if (m>1) and (folyik(m,n,m-1,n)) then
begin
inc(l);
m:=m-1;
end
else if (n<h) and (folyik(m,n,m,n+1)) then
begin
inc(l);
n:=n+1;
end
else if (n>1) and (folyik(m,n,m,n-1)) then
begin
inc(l);
n:=n-1;
end;
inc(k);
end;
inc(z);
bejar(m,n,z);
end;
end;
end;
for i:=1 to h do
begin
for j:=1 to w do
begin
write(t1,b[j,i]);
if j<w then write(t1,' ');
end;
if i<h then writeln(t1);
end;
end;
begin
assign(t,'vizgy.be');
reset(t);
assign(t1,'vizgy.ki');
rewrite(t1);
readln(t,g);
for l:=1 to g do
begin
beolvas;
for e:=1 to w do
begin
for f:=1 to h do
begin
b[e,f]:='0';
end;
end;
writeln(t1,'Case #',l,':');
betuz;
if l<g then writeln(t1);
end;
close(t);
close(t1);
end.
