Cod sursa(job #37045)

Utilizator gurneySachelarie Bogdan gurney Data 24 martie 2007 15:22:39
Problema Cc Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.72 kb
var a:array[0..101,0..101] of integer;
    ult:array[0..201] of integer;
    b:array[0..101,0..101] of boolean;
    c:array[0..201] of longint;
    l:array[1..100] of boolean;
    n,i,j,k,p,q:integer;
    cost:longint;
    f1,f2:text;
begin
  assign (f1,'cc.in');
  assign (f2,'cc.out');
  reset (f1);
  readln (f1,n);
  for i:=1 to n do
    begin
      for j:=1 to n do
        read (f1,a[i,j]);
      readln (f1);
    end;
  for i:=1 to n do
    begin
      fillchar (ult,sizeof(ult),0);
      fillchar (c,sizeof(c),1);
      for j:=1 to n do
        if b[0,j]=false then
          c[j]:=0;
      for p:=1 to n do
        begin
          for j:=1 to n do
            for q:=1 to n do
              begin
                if (c[j]>c[q+n]-a[j,q]) and (b[j,q]) then
                  begin
                    c[j]:=c[q+n]-a[j,q];
                    ult[j]:=q+n;
                  end;
                if (c[q+n]>c[j]+a[j,q]) and (not(b[j,q])) then
                  begin
                    c[q+n]:=c[j]+a[j,q];
                    ult[q+n]:=j;
                  end;
              end;
            j:=2*n+1;
            for q:=1 to n do
                if (c[j]>c[q+n])and not(b[q,j-n]) then
                  begin
                    c[j]:=c[q+n];
                    ult[j]:=q+n;
                  end;
          end;
      inc(cost,c[2*n+1]);
      k:=2*n+1;
      b[ult[k]-n,n+1]:=true;
      k:=ult[k];
      while ult[k]<>0 do
        begin
          if ult[k]>k then
          b[ult[k]-n,k]:=not b[ult[k]-n,k]
          else
          b[ult[k],k-n]:=not b[ult[k],k-n];
          k:=ult[k];
        end;
      b[0,k]:=true;
    end;
  rewrite(f2);
  writeln (f2,cost);
  close(f2);
end.