Cod sursa(job #39917)

Utilizator gurneySachelarie Bogdan gurney Data 27 martie 2007 09:11:13
Problema Cc Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.37 kb
type
  coada=^elem;
  elem=record
      urm:coada;x:longint;
    end;
var a:array[0..101,0..101] of longint;
    ult:array[0..201] of longint;
    este:array[1..201] of boolean;
    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:longint;
    cap,lst,aux,aux2:coada;
    cost:longint;
    f1,f2:text;
procedure cauta(x:longint);
  var
    i:longint;
  begin
    if x>n then
      begin
        for i:=1 to n do
          if b[i,x] then
            cauta(i);
        for i:=1 to n do
          if b[i,x] then
            if c[i]>c[x]-a[i,x-n] then
              begin
                c[i]:=c[x]-a[i,x-n];
                ult[i]:=x;
              end;
      end
    else
      begin
        for i:=n+1 to 2*n do
          if b[x,i]=false then
            cauta(i);
        for i:=n+1 to 2*n do
          if b[x,i]=false then
            if c[i]>c[x]+a[x,i-n] then
              begin
                c[i]:=c[x]+a[x,i-n];
                ult[i]:=x;
              end;
      end;
  end;

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 2*n+1 do
        este[j]:=false;
      new(cap);cap^.urm:=nil;lst:=cap;
      for j:=1 to n do
        if b[0,j]=false then
          begin
            new(aux);
            aux^.x:=j;
            c[j]:=0;
            este[j]:=true;
            lst^.urm:=aux;
            aux^.urm:=nil;
            lst:=aux;
          end;
      aux:=cap^.urm;
      while aux<>nil do
        begin
          if aux^.x<=n then
            begin
              for j:=1 to n do
                if b[aux^.x,j]=false then
                  if este[n+j] then
                    begin
                      if c[n+j]>c[aux^.x]+a[aux^.x,j] then
                        begin
                          c[n+j]:=c[aux^.x]+a[aux^.x,j];
                          ult[n+j]:=aux^.x;
                        end;
                    end
                  else
                    begin
                      if c[n+j]>c[aux^.x]+a[aux^.x,j] then
                        begin
                          c[n+j]:=c[aux^.x]+a[aux^.x,j];
                          ult[n+j]:=aux^.x;
                          este[n+j]:=true;
                          new(aux2);
                          aux2^.x:=n+j;
                          lst^.urm:=aux2;
                          aux2^.urm:=nil;
                          lst:=aux2;
                        end;
                    end;
            end
          else
            begin
              for j:=1 to n do
                if b[j,aux^.x-n] then
                  if este[j] then
                    begin
                      if c[j]>c[aux^.x]-a[j,aux^.x-n] then
                        begin
                          c[j]:=c[aux^.x]-a[j,aux^.x-n];
                          ult[j]:=aux^.x;
                        end;
                    end
                  else
                    begin
                      if c[j]>c[aux^.x]-a[j,aux^.x-n] then
                        begin
                          c[j]:=c[aux^.x]-a[j,aux^.x-n];
                          ult[j]:=aux^.x;
                          este[j]:=true;
                          new(aux2);
                          aux2^.x:=j;
                          lst^.urm:=aux2;
                          aux2^.urm:=nil;
                          lst:=aux2;
                        end;
                    end;
            end;
          aux2:=aux;
          aux:=aux^.urm;
          este[aux2^.x]:=false;
          dispose(aux2);
        end;
      for j:=n+1 to 2*n do
        if (c[2*n+1]>c[j]) and (b[j,n+1]=false) then
          begin
            c[2*n+1]:=c[j];
            ult[2*n+1]:=j;
          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[k,ult[k]-n]:=not b[k,ult[k]-n]
          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.