Cod sursa(job #1626371)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 3 martie 2016 07:31:21
Problema Arbore partial de cost minim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.97 kb
program apeme;
type element = record
           x, y, c:longint;
           end;
var f, g:text;
    t, sol:array[1..200005] of longint;
    v:array[1..400005] of element;
    i, n, m, rad1, rad2, k, suma:longint;
    bufin, bufout:array[1..1 shl 16] of byte;
function pivot(st, dr:longint):longint;
var i, j, di, dj, aux:longint;
    aux2:element;
begin
   di := 0; dj := 1;
   i := st; j := dr;
   while i < j do
      begin
         if v[i].c > v[j].c then
            begin
               aux2 := v[i];
               v[i] := v[j];
               v[j] := aux2;
               aux := di;
               di := dj;
               dj := aux;
            end;
         i := i + di;
         j := j - dj;
      end;
   pivot := i;
end;
procedure sort(st, dr:longint);
var p:longint;
begin
   if st < dr then
      begin
         p := pivot(st, dr);
         sort(st, p - 1);
         sort(p + 1, dr);
      end;
end;
function find(nod:longint):longint;
begin
   while t[nod] <> 0 do nod := t[nod];
   find := nod;
end;
function find2(nod:longint):longint;
var aux:longint;
begin
   aux := nod;
   while t[nod] > 0 do nod := t[nod];
   find2 := nod;
   while t[aux] > 0 do
      begin
        t[aux] := find2;
        aux := t[aux];
      end;
end;
begin
   assign(f, 'apm.in');
   reset(f);
   assign(g, 'apm.out');
   rewrite(g);
   settextbuf(f, bufin);
   settextbuf(f, bufout);
   readln(f, n, m);
   for i := 1 to m do
      readln(f, v[i].x, v[i].y, v[i].c);
   sort(1, m); k := 0;
   suma := 0;
   for i := 1 to m do
      begin
         rad1 := find2(v[i].x);
         rad2 := find2(v[i].y);
         if rad1 <> rad2 then
            begin
               t[rad2] := rad1;
               inc(k);
               sol[k] := i;
               suma := suma + v[i].c
            end;
      end;
   writeln(g, suma); writeln(g, k);
   for i := 1 to k do
     writeln(g, v[sol[i]].x,' ', v[sol[i]].y);
   close(f);
   close(g);
end.