Cod sursa(job #306953)

Utilizator mlazariLazari Mihai mlazari Data 22 aprilie 2009 14:52:29
Problema Arbore partial de cost minim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 4.24 kb
Program Apm;
type PNod=^Nod;
     Nod=record
       nr,cost : longint;
       next : PNod;
     end;
     Heap=record
       l : longint;
       nout,nin,c : array[0..200000] of longint;
     end;
     Muchie=record
       n1,n2 : longint;
     end;
var v : array[1..200000] of PNod;
    poz : array[1..200000] of longint;
    added : array[1..200000] of boolean;
    Mc : array[1..200000] of Muchie;
    nM,costTotal,n,m : longint;
    h : Heap;

procedure adauga(var lst : Pnod; x,c : longint);
var q : PNod;
begin
  new(q);
  q^.next:=lst;
  q^.nr:=x;
  q^.cost:=c;
  lst:=q;
end;

procedure Citeste;
var Intrare : text;
    i,x,y,c : longint;
begin
  assign(Intrare,'apm.in');
  reset(Intrare);
  readln(Intrare,n,m);
  for i:=1 to n do v[i]:=nil;
  for i:=1 to m do begin
    readln(Intrare,x,y,c);
    adauga(v[x],y,c);
    adauga(v[y],x,c);
  end;
  close(Intrare);
end;

function st(var h : Heap; x : longint) : longint;
begin
  if 2*x<=h.l then st:=2*x else st:=0;
end;

function dr(var h : Heap; x : longint) : longint;
begin
  if 2*x+1<=h.l then dr:=2*x+1 else dr:=0;
end;

function par(var h : Heap; x : longint) : longint;
begin
  par:=x div 2;
end;

procedure hcopy(var h : heap; var x,y : longint);
begin
  h.nout[x]:=h.nout[y];
  h.nin[x]:=h.nin[y];
  h.c[x]:=h.c[y];
  poz[h.nout[x]]:=x;
  x:=y;
end;

procedure sift(var h : heap; x : longint);
var s,d,nodout,nodin,cost : longint;
begin
  nodout:=h.nout[x];
  nodin:=h.nin[x];
  cost:=h.c[x];
  s:=st(h,x);
  d:=dr(h,x);
  while s>0 do begin
    if (h.c[s]<cost) or (h.c[d]<cost) then
     if h.c[s]<h.c[d] then hcopy(h,x,s) else hcopy(h,x,d)
    else begin
      h.nout[x]:=nodout;
      h.nin[x]:=nodin;
      h.c[x]:=cost;
      poz[nodout]:=x;
      break;
    end;
    s:=st(h,x);
    d:=dr(h,x);
  end;
  if s=0 then begin
    h.nout[x]:=nodout;
    h.nin[x]:=nodin;
    h.c[x]:=cost;
    poz[nodout]:=x;
  end;
end;

procedure percolate(var h : Heap; x : longint);
var p,nodout,nodin,cost : longint;
begin
  nodout:=h.nout[x];
  nodin:=h.nin[x];
  cost:=h.c[x];
  p:=par(h,x);
  while p>0 do begin
    if cost<h.c[p] then begin
      hcopy(h,x,p);
      p:=par(h,x);
    end
    else begin
      h.nout[x]:=nodout;
      h.nin[x]:=nodin;
      h.c[x]:=cost;
      poz[nodout]:=x;
      break;
    end;
  end;
  if p=0 then begin
    h.nout[x]:=nodout;
    h.nin[x]:=nodin;
    h.c[x]:=cost;
    poz[nodout]:=x;
  end;
end;

procedure adaugaInHeap(var h : Heap; nodout,nodin,cost : longint);
begin
  h.l:=h.l+1;
  h.nout[h.l]:=nodout;
  h.nin[h.l]:=nodin;
  h.c[h.l]:=cost;
  poz[nodout]:=h.l;
  percolate(h,h.l);
end;

procedure scoateMin(var h : Heap; var nodout,nodin,cost : longint);
begin
  nodout:=h.nout[1];
  nodin:=h.nin[1];
  cost:=h.c[1];
  h.nout[1]:=h.nout[h.l];
  h.nin[1]:=h.nin[h.l];
  h.c[1]:=h.c[h.l];
  h.l:=h.l-1;
  sift(h,1);
end;

procedure actualizeaza(var h : Heap; nodout,nodin,cost : longint);
var p : longint;
begin
  p:=poz[nodout];
  if p=0 then adaugaInHeap(h,nodout,nodin,cost)
  else begin
    if h.c[p]>cost then begin
      h.nin[p]:=nodin;
      h.c[p]:=cost;
      percolate(h,p);
    end;
  end;
end;

procedure actualizeazaVecini(var h : Heap; x : longint);
var q : PNod;
begin
  q:=v[x];
  while q<>nil do begin
    if not added[q^.nr] then actualizeaza(h,q^.nr,x,q^.cost);
    q:=q^.next;
  end;
end;

procedure adaugaMuchie(n1,n2,c : longint);
begin
  nM:=nM+1;
  Mc[nM].n1:=n1;
  Mc[nM].n2:=n2;
  added[n1]:=true;
  costTotal:=costTotal+c;
end;

procedure Calculeaza;
var i,nodout,nodin,cost : longint;
begin
  costTotal:=0;
  nM:=0;
  h.c[0]:=maxlongint;
  h.l:=0;
  added[1]:=true;
  for i:=2 to n do begin
    added[i]:=false;
    poz[i]:=0;
  end;
  actualizeazaVecini(h,1);
  for i:=2 to n do begin
    scoateMin(h,nodout,nodin,cost);
    AdaugaMuchie(nodout,nodin,cost);
    actualizeazaVecini(h,nodout);
  end;
end;

procedure Scrie;
var Iesire : text;
    i : longint;
begin
  assign(Iesire,'apm.out');
  rewrite(Iesire);
  writeln(Iesire,costTotal);
  writeln(Iesire,nM);
  for i:=1 to nM do writeln(Iesire,Mc[i].n1,' ',Mc[i].n2);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.