Codeforces Round #375 (Div. 2) D. Lakes in Berland

<span style="font-size:24px;">program O_O;
const
u:array[1..4] of -1..1=(0,0,1,-1);
v:array[1..4] of -1..1=(1,-1,0,0);
var
i,j,k,n,m,s,cnt,xx,yy,tx,ty,tmp:longint;
q:array[0..2500] of record x,y:longint;end;
a:array[0..100,0..100] of char;
b:array[0..100,0..100] of boolean;
bel:array[0..100,0..100] of longint;
size:array[0..2500] of longint;
pd,choice:array[0..2500] of boolean;
procedure init;
var
i,j:longint;
begin
readln(n,m,k);
for i:=1 to n do
begin
for j:=1 to m do
begin
read(a[i,j]);
if a[i,j]='.' then
b[i,j]:=true;
end;
readln;
end;
end;
procedure bfs(x,y:longint);
var
i,h,t:longint;
begin
b[x,y]:=false;bel[x,y]:=cnt;size[cnt]:=1;
if (x=1)or(x=n)or(y=1)or(y=m) then pd[cnt]:=true;
h:=0;t:=1;q[t].x:=x;q[t].y:=y;
while h<>t do
begin
inc(h);
tx:=q[h].x;ty:=q[h].y;
for i:=1 to 4 do
begin
xx:=tx+u[i];yy:=ty+v[i];
if b[xx,yy] then
begin
inc(t);
q[t].x:=xx;
q[t].y:=yy;
bel[xx,yy]:=cnt;
if (xx=1)or(xx=n)or(yy=1)or(yy=m) then
pd[cnt]:=true;
inc(size[cnt]);
b[xx,yy]:=false;
end;
end;
end;
end;
procedure main;
var
i,j,min,p:longint;
begin
for i:=1 to n do
for j:=1 to m do
if b[i,j] then
begin
inc(cnt);
bfs(i,j);
end;
tmp:=0;
for i:=1 to cnt do
if not pd[i] then inc(tmp);
for i:=1 to tmp-k do
begin
min:=maxlongint;
for j:=1 to cnt do
if (not pd[j])and(size[j]<min)and(not choice[j]) then
begin
min:=size[j];
p:=j;
end;
choice[p]:=true;
end;
end;
procedure print;
var
i,j,l:longint;
begin
l:=0;
for i:=1 to n do
begin
for j:=1 to m do
if choice[bel[i,j]] then
begin
a[i,j]:='*';
inc(l);
end;
end;
writeln(l);
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]);
writeln;
end;
end;
begin
init;
main;
print;
end.

</span>

<span style="font-size:24px;">USES Math;
CONST
tfi = '';
tfo = '';
d: array[1..4] of longint = (-1,1,0,0);
c: array[1..4] of longint = (0,0,-1,1);
VAR
fi,fo                   : text;
n,m,k,cnt,top           : longint;
a                       : array[0..50,0..50] of longint;
free,ins                : array[0..51,0..51] of boolean;
dd,sx,sy                : array[0..2500] of longint;

Procedure inp;
Var
i,j: longint;
ch: char;
Begin
Readln(fi,n,m,k);
For i:=1 to n do
begin
For j:=1 to m do
begin
read(fi,ch);
If ch='.' then a[i,j]:=1;
ins[i,j]:=true;
end;
readln(fi);
end;
End;

Procedure dfs(u,v: longint);
Var
x,y,k: longint;
Begin
If free[u,v] then exit;
free[u,v]:=true;
inc(cnt);
For k:=1 to 4 do
begin
x:=u+d[k];
y:=v+c[k];
If ins[x,y] and not free[x,y] and (a[x,y]=1) then dfs(x,y);
end;
End;

Procedure swap(var x,y: longint);
Var
tg: longint;
Begin
tg:=x; x:=y; y:=tg;
End;

Procedure qsort(l,r: longint);
Var
i,j,mid,key: longint;
Begin
i:=l;
j:=r;
mid:=l+random(r-l+1);
key:=dd[mid];
Repeat
While dd[i]<key do inc(i);
While dd[j]>key do dec(j);
If i<=j then
begin
swap(dd[i],dd[j]);
swap(sx[i],sx[j]);
swap(sy[i],sy[j]);
inc(i);
dec(j);
end;
Until i>j;
If i<r then qsort(i,r);
If l<j then qsort(l,j);
End;

Procedure visit(u,v: longint);
Var
x,y,k: longint;
Begin
a[u,v]:=0;
For k:=1 to 4 do
begin
x:=u+d[k];
y:=v+c[k];
If ins[x,y] and (a[x,y]=1) then visit(x,y);
end;
End;

Procedure process;
Var
i,j,res: longint;
Begin
For i:=1 to n do
begin
If a[i,1]=1 then dfs(i,1);
If a[i,m]=1 then dfs(i,m);
end;
For i:=1 to m do
begin
If a[1,i]=1 then dfs(1,i);
If a[n,i]=1 then dfs(n,i);
end;
For i:=1 to n do
For j:=1 to m do
If a[i,j]=1 then
begin
cnt:=0;
dfs(i,j);
If cnt<>0 then
begin
inc(top);
sx[top]:=i; sy[top]:=j;
dd[top]:=cnt;
end;
end;
qsort(1,top);
res:=0;
For i:=1 to top-k do
begin
visit(sx[i],sy[i]);
res:=res+dd[i];
end;
writeln(fo,res);
For i:=1 to n do
begin
For j:=1 to m do
If a[i,j]=1 then write(fo,'.')
else write(fo,'*');
writeln(fo);
end;
End;

BEGIN
assign(fi,tfi); reset(fi);
assign(fo,tfo); rewrite(fo);
inp;

process;
close(fi); close
4000
(fo);
END.</span>