bzoj 1001

Bzoj 1001

题目大意：在一个平面图上（网格图+斜边），求最小割；

解：因为点数可以去到10000000，所以网络流不行= =，我自己一开始自信满满地说好水啊，结果尼玛直接wa掉了，检查半天不出错，去看discuz，发现是用平面图转构图（参见国家集训队2008day2周冬神牛地论文）然后最短路。自己一个数组写小了，因为特殊的原因，提交在wa和re徘徊，自己检查一晚上代码..还以为是构图写错了，去q群里吐槽一下发现时数组的问题= =，改了立马ac..

// bzoj 1001 [beijing 2006]
const
        maxn=1001;
        goal=maxn*maxn;
        bilibili=maxlongint >> 1;
        inf='1.txt';
type
        type_edge=record
          cost, dest, next: longint;
        end;
var
        edge: array[0..maxn*maxn*6]of type_edge;
        dist, heap, poss, vect: array[0..maxn*maxn*2]of longint;
        hptot, source, sink, n, m, ans, tot: longint;
procedure add(x, y, z: longint);
begin
  inc(tot);
  with edge[tot] do begin
    dest := y;
    cost := z;
    next := vect[x];
    vect[x] := tot;
  end;
  inc(tot);
  with edge[tot] do begin
    dest := x;
    cost := z;
    next := vect[y];
    vect[y] := tot;
  end;
end;

procedure init;
var
        cost, x, y, i, j: longint;
begin
  tot := 0; ans := 0;
  fillchar(vect, sizeof(vect), 0);
  readln(n, m);
  if (n=1)and(m=1) then begin
    writeln(0);
    close(input); close(output);
    halt;
  end;                        {key point}
  source := 0; sink := (n*(m-1)+(n-1)*m+(m-1)*(n-1))-n*m+2;
  for i := 1 to n do begin
    for j := 1 to m-1 do begin
      read(cost);
      //y := (i-1)*2*(m-1)+j; x := y - (m-1);
      x := (2*i-3)*(m-1)+j;
      y := (2*i-2)*(m-1)+j;
      if x<source then x := source;
      if y>sink then y := sink;
      add(x, y, cost);
    end;
    //if m<>1 then readln;
  end;
  for i := 1 to n-1 do begin
    for j := 1 to m do begin
      read(cost);
      //x := 2*(i-1)*(m-1)+j-1; y := x + m;
      x := 2*(i-1)*(m-1)+j-1;
      y := 2*(i-1)*(m-1)+j-1+m;
      if j=1 then x := sink;
      if j=m then y := source;
      add(x, y, cost);
    end;
    //if n<>1 then readln;
  end;
  for i := 1 to n-1 do begin
    for j := 1 to m-1 do begin
      read(cost);
      //x := 2*(i-1)*(m-1)+j; y := x + m - 1;
      x := (2*i-2)*(m-1)+j;
      y := (2*i-1)*(m-1)+j;
      add(x, y, cost);
    end;
    //readln;
  end;
end;

procedure up(x: longint);
var
        tmp, i: longint;
begin
  i := x;
  tmp := heap[i];
  while i>1 do begin
    if dist[tmp]<dist[heap[i >> 1]] then begin
      heap[i] := heap[i >> 1];
      poss[heap[i]] := i;
      i := i >> 1;
    end
      else break;
  end;
  poss[tmp] := i;
  heap[i] := tmp;
end;

procedure down(x: longint);
var
        i, j, tmp: longint;
begin
  i := x;
  tmp := heap[i];
  while i << 1 <= hptot do begin
    j := i << 1;
    if (j+1<=hptot)and(dist[heap[j]]>dist[heap[j+1]]) then inc(j);
    if dist[tmp] > dist[heap[j]] then begin
      heap[i] := heap[j];
      poss[heap[i]] := i;
      i := j;
    end
      else break;
  end;
  poss[tmp] := i;
  heap[i] := tmp;
end;

procedure main;
var
        u, i: longint;
begin
  fillchar(poss, sizeof(poss), 0);
  for i := source to sink do dist[i] := bilibili;
  hptot := 0; poss[source] := -1;
  dist[source] := 0; u := source;
  repeat
    if u=sink then break;
    i := vect[u];
    while i<>0 do
      with edge[i] do begin
        if (dist[u] + cost < dist[dest])and(poss[dest]<>-1) then begin
          dist[dest] := dist[u] + cost;
          if poss[dest]=0 then begin
            inc(hptot);
            poss[dest] := hptot;
            heap[hptot] := dest;
            up(hptot);
          end
            else up(poss[dest]);
        end;
        i := next;
      end;
    u := heap[1];
    poss[u] := -1;
    heap[1] := heap[hptot];
    poss[heap[1]] := 1;
    dec(hptot);
    down(1);
  until false;
  ans := dist[sink];
end;

procedure print;
begin
  writeln(ans);
end;

begin
  assign(input,inf); reset(input);
  init;
  main;
  print;
end.