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>