ac1266.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

program tju1266;
const
  maxn=50;
  maxm=766;
var
  len:array[1..maxn,1..maxn]of word;
  id:array[1..maxn,1..maxn]of byte;
  father,root:array[1..maxn]of byte;
  adj:array[1..maxm,1..maxn-1]of boolean;
  wx,ordx:array[1..maxm]of word;
  my:array[1..maxn-1]of word;
  vx:array[1..maxm]of boolean;
  n,i,a,b,cx,cy:longint;
procedure pathcomp(x:byte);
  var
    r,t:byte;
  begin
    r:=x;while root[r]<>r do r:=root[r];
    while x<>r do begin t:=root[x];root[x]:=r;x:=t;end;
  end;
procedure tarjan(a:byte);
  var
    lca,b:byte;
  procedure up(a:byte);
    begin
      while a<>lca do begin
        if wx[cx]<len[a,father[a]] then adj[cx,id[a,father[a]]]:=true;
        a:=father[a];
      end;
    end;
  begin
    root[a]:=a;
    for b:=1 to n do
      if (len[a,b]>0) and (id[a,b]=0) and (root[b]>0) then begin
        inc(cx);wx[cx]:=len[a,b];
        pathcomp(b);lca:=root[b];
        up(a);up(b);
      end;
    for b:=1 to n do
      if (id[a,b]>0) and (root[b]=0) then begin
        father[b]:=a;
        tarjan(b);
      end;
    root[a]:=root[father[a]];
  end;
procedure qsort(s,t:word);
  var
    p,i,j,tmp,tw:word;
  begin
    if s>=t then exit;
    p:=s+random(t-s+1);
    tmp:=ordx[p];ordx[p]:=ordx[s];tw:=wx[tmp];
    i:=s;j:=t;
    repeat
      while (i<j) and (wx[ordx[j]]>=tw) do dec(j);
      if i=j then break;ordx[i]:=ordx[j];inc(i);
      while (i<j) and (wx[ordx[i]]<=tw) do inc(i);
      if i=j then break;ordx[j]:=ordx[i];dec(j);
    until i=j;
    ordx[i]:=tmp;
    qsort(s,i-1);
    qsort(i+1,t);
  end;
function aug(x:word):boolean;
  var
    y:byte;
  begin
    aug:=false;
    if vx[x] then exit;
    vx[x]:=true;
    for y:=1 to cy do
      if adj[x,y] and ((my[y]=0) or aug(my[y])) then begin
        my[y]:=x;aug:=true;exit;
      end;
  end;
begin
  repeat
    fillchar(len,sizeof(len),0);
    fillchar(id,sizeof(id),0);
    fillchar(father,sizeof(father),0);father[1]:=1;
    fillchar(root,sizeof(root),0);
    fillchar(adj,sizeof(adj),0);

    read(n,cx);
    for i:=1 to cx do begin
      read(a,b,len[a,b]);len[b,a]:=len[a,b];
    end;
    cy:=n-1;cx:=cy;
    for i:=1 to cy do begin
      read(a,b);
      id[a,b]:=i;id[b,a]:=i;
      adj[i,i]:=true;wx[i]:=len[a,b];
    end;
    tarjan(1);

    for i:=1 to cx do ordx[i]:=i;
    qsort(1,cx);
    fillchar(my,sizeof(my),0);
    a:=0;for i:=1 to cy do inc(a,wx[i]);b:=0;
    for i:=1 to cx do begin
      fillchar(vx,sizeof(vx),0);
      if aug(ordx[i]) then begin dec(a,wx[ordx[i]]);inc(b);end;
      if b=cy then break;
    end;
    writeln(a);
  until seekeof;
end.