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

  D. Lakes in Berland 

 一：广搜

          1，在搜索过程中记录：
               a,lake的大小size[ ]
               b,点x,y所属的lake，ble[x,y]
               c,判断是否连接海洋
          2,搜索完成后，统计lake的个数，以便确定应该去掉的lake数
          3,在决定去掉哪个lake时，可以按size从小到大排序（好像比较麻烦），
          4,也可用两重循环，每次选出一个最小的，用choice数组标记
          5,输出时，把去掉的lake改为'*'
    二：深搜
          1，先搜完属于海洋的lake
          2，搜索lake，并标记代表节点sx[ ],sy[ ]及lake大小dd[ ]
          3，按dd[ ]排序
          4，执行visit过程，从代表节点开始扩展，递归去除lake
          5，根据a[i,j]是否为 1 决定输出
             注意细节就好 
   

<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(fo);
END.</span>