Cod sursa(job #560549)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 18 martie 2011 16:10:00
Problema Arbore partial de cost minim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.81 kb
type muchie=^nod;
     nod = record n,c:longint; a:muchie; end;

var v:array[1..2, 1..200000] of muchie;
    arb:array[0..400000] of record x, y:longint; c:integer; end;
    aux:record x, y:longint; c:integer; end;
    viz:array[1..200000] of boolean;
    fin:array[1..2, 1..200000] of longint;
    buf:array[1..1 shl 17] of char;
    cost:int64;
    m, n, i, x, y, c, an, tot:longint;
    p, r:muchie;
    ok:boolean;
    f, g:text;

procedure inheap (a:longint);
  begin
  if a<> 1 then
  begin
  while (arb[a].c<arb[a div 2].c) and (a<>1) do
    begin
    aux.x:=arb[a].x; arb[a].x:=arb[a div 2].x; arb[a div 2].x:= aux.x;
    aux.y:=arb[a].y; arb[a].y:=arb[a div 2].y; arb[a div 2].y:= aux.y;
    aux.c:=arb[a].c; arb[a].c:=arb[a div 2].c; arb[a div 2].c:= aux.c;
    a:=a div 2;
    end;
  end;
  end;

procedure exheap (a:longint);
var b:longint;
  begin
  b:=1;
  while b<>0 do
    begin
    b:=0;
    if a*2<=an then
      begin
      b := a*2;
      if (a*2+1<=an) and (arb[a*2+1].c<arb[a*2].c) then b:=a*2+1;
      end;
    if arb[a].c<arb[b].c then b:=0;
    if b<>0 then
      begin
      aux.x:=arb[a].x; arb[a].x:=arb[b].x; arb[b].x:=aux.x;
      aux.y:=arb[a].y; arb[a].y:=arb[b].y; arb[b].y:=aux.y;
      aux.c:=arb[a].c; arb[a].c:=arb[b].c; arb[b].c:=aux.c;
      a:=b;
      end;
    end;
  end;


begin
assign (f, 'apm.in'); settextbuf (f, buf); reset (f);

read (f, n, m);
for i:= 1 to n do begin new(v[1, i]); v[1, i]^.n:=0; end;

for i := 1 to m do
  begin
  read (f, x, y, c);
  if v[1, x]^.n <>0 then p:=v[2, x]
                    else p:=v[1, x];

  inc(v[1, x]^.n);
  new (r); r^.n:=y; p^.a:=r; r^.c:=c; v[2, x]:=r;

  if v[1, y]^.n <>0 then p:=v[2, y]
                    else p:=v[1, y];

  inc(v[1, y]^.n);
  new (r); r^.n:=x; p^.a:=r; r^.c:=c; v[2, y]:=r;
  end;

  {
for i := 1 to n do
  begin
  p:=v[1, i];
  for j := 1 to v[1, i]^.n do
    begin
    p:=p^.a;
    writeln (i, ' ', p^.n, ' ', p^.c);
    end;
  end;
   }

x:=1; viz[1]:=true; tot:=1; an:=0; cost:=0;
while tot < n do
  begin
  p:=v[1, x];
  for i := 1 to v[1, x]^.n do
    begin
    p:=p^.a;
    if viz[p^.n] = false then
      begin
      an:=an+1;
      arb[an].x:=x;arb[an].y:=p^.n; arb[an].c:=p^.c;
      inheap(an);
      end;
    end;
  ok:= true;
  while ok do
    begin
    if viz[arb[1].y] = false then
      begin
      viz[arb[1].y]:=true;
      fin[1, tot]:=arb[1].x; fin [2, tot]:=arb[1].y;
      ok:= false;
      x:=arb[1].y;
      tot:=tot+1;
      cost:=cost+arb[1].c;
      end;
    arb[1]:=arb[an]; an:=an-1;
    exheap(1);
    end;
  end;

close (f);
assign (g, 'apm.out'); settextbuf (g, buf); rewrite (g);
writeln (g, cost);
writeln (g, tot-1);
for i := 1 to tot-1 do writeln (g, fin[1, i], ' ', fin [2, i]);

close (g);
end.