Cod sursa(job #246803)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 21 ianuarie 2009 14:21:16
Problema Arbore partial de cost minim Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.47 kb
{Arbore partial de cost minim}

type    elem    = record x,y,c: integer; end;
        list    = array [1..200000] of elem;

var     n,m,cost     : longint;
        t       : array [1..200000] of longint;
        uz      : array [1..200000] of byte;
        muchii  : list;


function  tata       (x:longint):longint;
var     tx           : longint;
begin
tx := x;
while (t[tx]>0) do tx := t[tx];
tata := tx;
end;

procedure join       (x,y,tx,ty:longint);
begin
if t[tx] < t[ty] then
   begin
   t[tx] := t[tx] + t[ty];
   t[y] := tx;
   end
else
   begin
   t[ty] := t[tx] + t[ty];
   t[x] := ty;
   end;
end;


procedure       rezolva;
        var
        i,count,tx,ty,x,y : longint;
        begin
        count := 0;
        i     := 1;
        cost  := 0;
        repeat
         x  := muchii[i].x;
         y  := muchii[i].y;
         tx := tata(x);
         ty := tata(y);
         if (tx <> ty) then
            begin
            join (x,y,tx,ty);
            inc(count);
            cost := cost + muchii[i].c;
            uz[i]:= 1;
            end;
         inc (i);
        until count = n-1;
        end;

procedure       citire;
        var
        i,j     : longint;
        x,y,c   : integer;
        f       : text;
        begin
        assign(f,'apm.in');
        reset(f);
        readln(f,n,m);
        for i:=1 to n do t[i] := -1;
        for i:=1 to m do
            begin
            readln(f,x,y,c);
            muchii[i].x := x;
            muchii[i].y := y;
            muchii[i].c := c;
            end;
        close(f);
        end;

procedure       scrie;
var             f: text;
                i: longint;
begin
assign  (f,'apm.out');
rewrite (f);
writeln (f,cost);
writeln (f,n-1);
for i:=1 to m do
    if (uz[i] = 1) then
       writeln (f, muchii[i].x, ' ', muchii[i].y);
close   (f);
end;

procedure       QuickSort(var A: List; Lo, Hi: Integer);

procedure       Sort(l, r: Integer);
        var
        i, j    : integer;
        x, y    : elem;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i].c < x.c do i := i + 1;
    while x.c < a[j].c do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin {QuickSort};
  Sort(Lo,Hi);
end;

begin
 citire;
 QuickSort(muchii,1,m);
 rezolva;
 scrie;
end.