Cod sursa(job #254868)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 7 februarie 2009 21:36:35
Problema Arbore partial de cost minim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.1 kb
type mch=record
     x,y,c:longint;
     end;
var
procedure load;
var i:longint;
begin
     assign(f,'apm.in'); reset(f);
     assign(g,'apm.out'); rewrite(g);
     readln(f,n,m);
     for i:=1 to m do readln(f,a[i].x,a[i].y,a[i].c);
end;
procedure heapup(k:longint);
var t:longint;
    aux:mch;
begin
     if k>1 then
     begin
          t:=k div 2;
          if a[t].c<a[k].c then
          begin
               aux:=a[t];
               a[t]:=a[k];
               a[k]:=aux;
               heapup(t);
          end;
     end;
end;
procedure buildh;
var i:longint;
begin
     for i:=2 to n do heapup(i);
end;
procedure heapdw(k,l:longint);
var x:longint;
    aux:mch;
begin
     if 2*k<=l then
     begin
          if 2*k+1<=l then x:=a[2*k+1].c
                      else x:=a[2*k].c-1;
          if a[2*k].c>x then
          begin
               if a[k].c<a[2*k].c
               begin
                    aux:=a[2*k];
                    a[2*k]:=a[k];
                    a[k]:=aux;
                    heapdw(2*k,l);
               end;
          end
                        else
               if a[k].c<x then
               begin
                    aux:=a[2*k+1];
                    a[2*k+1]:=a[k];
                    a[k]:=aux;
                    heapdw(2*k+1,l);
               end;
     end;
end;
procedure heapsort;
var aux:mch;
    l:longint;
begin
     l:=n;
     while l>1 do
     begin
          aux:=a[1];
          a[1]:=a[l];
          a[l]:=aux;
          dec(l);
          heapdw(1,l);
     end;
end;
begin
     load;
     heapsort;
     cc:=0;    nr:=0;
     fillchar(sel,sizeof(sel),false);
     for i:=1 to n do t[i]:=i;
     for i:=1 to m do
          if t[a[i].x]<>t[a[i].y] then
          begin
               inc(nr);
               for k:=1 to n do
                    if t[k]=t[a[i].x] then t[k]:=t[a[i].y];
               cc:=cc+a[i].c;
               sel[i]:=true;
          end;
     writeln(g,cc); writeln(g,nr);
     for i:=1 to m do
          if sel[i]=true then writeln(g,a[i].x,' ',a[i].y);
     close(g);
end.