记录编号	39495	评测结果	AAAAAEEEEA
题目名称	登山	最终得分	60
用户昵称	IMSL77	是否通过	未通过
代码语言	Pascal	运行时间	0.478 s
提交时间	2012-07-12 14:37:11	内存使用	1.16 MiB

program hike2;
type
  integer=longint;
const
  maxn=4000;
  maxm=40000;
  c:array[1..4,1..2] of integer=((0,1),(0,-1),(1,0),(-1,0));
var
  n,m:integer;
  s,t,tot:integer;
  a:array[1..61,1..61] of integer;
  ver:array[1..maxn] of integer;
  en,next:array[1..maxm] of integer;
  Cap,Flow,Cost:array[1..maxm] of integer;
  d:array[1..maxn] of integer;
  mark:array[1..maxn] of boolean;
  Q:array[1..maxn*10] of integer;
  pre,bef:array[1..maxn] of integer;

  procedure Fopen;
  begin
    assign(input,'hike.in'); reset(input);
    assign(output,'hike.out'); rewrite(output);
  end;

  procedure Fclose;
  begin
    close(input); close(output);
  end;

  function id(x,y,c:integer):integer;
  begin
    exit(((x-1)*m+y) shl 1+c);
  end;

  procedure addedge(u,v,ca,co:integer);
  begin
    inc(tot);
    en[tot]:=v; next[tot]:=ver[u]; ver[u]:=tot;
    Cap[tot]:=ca; Cost[tot]:=co;
  end;

  procedure SetGraph;
  var
    i,j:integer;
    x,y,dx,dy:integer;
  begin
    readln(n,m);
    for i:=1 to n do
    for j:=1 to m do
      read(a[i,j]);
    fillchar(ver,sizeof(ver),0);
    fillchar(next,sizeof(next),0);
    tot:=1;
    s:=id(n,m,1)+1; t:=id(n,m,1)+2;
    for x:=1 to n do
    for y:=1 to m do
    begin
      addedge(s,id(x,y,0),1,0);
      addedge(id(x,y,0),s,0,0);
      addedge(id(x,y,0),id(x,y,1),1,1);
      addedge(id(x,y,1),id(x,y,0),0,-1);
      for i:=1 to 4 do
      begin
        dx:=x+c[i,1]; dy:=y+c[i,2];
        if (dx<1)or(dx>n)or(dy<1)or(dy>m) then continue;
        if a[dx,dy]>a[x,y] then
        begin
          addedge(id(x,y,1),id(dx,dy,0),1,0);
          addedge(id(dx,dy,0),id(x,y,1),0,0);
        end;
      end;
    end;
  end;

  function Spfa:boolean;
  var
   head,tail:integer;
   k,x,y:integer;
  begin
    for k:=1 to t do d[k]:=-(maxlongint shr 2);
    d[s]:=0;
    fillchar(mark,sizeof(mark),true);
    mark[s]:=false;
    head:=1; tail:=2;
    Q[1]:=s;
    repeat
      x:=Q[head];
      k:=ver[x];
      while k>0 do
      begin
        y:=en[k];
        if (Cap[k]>Flow[k]) and (d[x]+Cost[k]>d[y]) then
        begin
          d[y]:=d[x]+Cost[k];
          pre[y]:=k;
          bef[y]:=x;
          if mark[y] then
          begin
            mark[y]:=false;
            Q[tail]:=y;
            inc(tail);
          end;
        end;
        k:=next[k];
      end;
      mark[x]:=true;
      inc(head);
    until head=tail;
    exit(d[t]>-(maxlongint shr 2));
  end;

  function MinCostFlow:integer;
  var
    mincost:integer;
    now,delta:integer;
  begin
    fillchar(Flow,sizeof(Flow),0);
    mincost:=0;
    while Spfa do
    begin
      now:=t;
      delta:=maxlongint;
      while now<>s do
      begin
        if Cap[pre[now]]-Flow[pre[now]]<delta then
          delta:=Cap[pre[now]]-Flow[pre[now]];
        now:=bef[now];
      end;
      now:=t;
      while now<>s do
      begin
        inc(Flow[pre[now]],delta);
        dec(Flow[pre[now] xor 1],delta);
        now:=bef[now];
      end;
      inc(mincost,d[t]*delta);
    end;
    exit(mincost);
  end;

  procedure Solve;
  var
    i,j:integer;
    ans,p:integer;
  begin
    ans:=0;
    for i:=1 to n do
    for j:=1 to m do
    begin
      addedge(id(i,j,0),t,2,0);
      addedge(t,id(i,j,0),0,0);
      p:=MinCostFlow;
      if p>ans then ans:=p;
      inc(t);
    end;
    writeln(ans+1);
  end;

begin
  Fopen;
  SetGraph;
  Solve;
  Fclose;
end.