Cod sursa(job #701975)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 1 martie 2012 18:49:20
Problema Arbore partial de cost minim Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.62 kb
program kruskal;

type heap=array[1..100000]of longint;

var fi,fo:text;
    m:array[1..20000,1..3]of longint;
    t,he:heap;
    select:array[1..400000]of longint;
    costtot,nrs,n,mm,i,nrmuchii:longint;

    function arb(k:longint):longint;
    begin
        while t[k]<>0 do
          k:=t[k];
          arb:=k;
    end;

  procedure afisare;
  var i:longint;
  begin
    writeln(fo,costtot);
    writeln(Fo,n-1);
      for i:=1 to n-1 do
        writeln(fo,m[select[i],1], ' ', m[select[i],2]);
  end;

      procedure swap(var a,b:longint); var c:longint; begin c:=a; a:=b; b:=c; end;

      function fiu_st(k:longint):longint; begin fiu_st:=k*2; end;

      function fiu_dr(k:longint):longint; begin fiu_dr:=k*2+1; end;

    procedure sift(n,k:longint);
    var fiu:longint;
    begin
        repeat
          fiu:=0;
          if fiu_st(k)<=n then
            begin
                fiu:=fiu_st(k);
                if (fiu_dr(k)<=n) and (m[fiu_dr(k),3]>m[fiu_st(k),3]) then
                   fiu:=fiu_dr(k);
                if m[k,3]>m[fiu,3] then
                   fiu:=0;
            end;
          if fiu<>0 then
            begin
                swap(m[k,1],m[fiu,1]);
                swap(m[k,2],m[fiu,2]);
                swap(m[k,3],m[fiu,3]);
                k:=fiu;
            end;
        until fiu=0;
    end;

  procedure sortare;
  var i:longint;
  begin
      //aranjez ca heap

      for i:=mm div 2 downto 1 do
        sift(mm, i);

      for i:= mm downto 2 do
      begin
        swap(m[i,1],m[1,1]);
        swap(m[i,2],m[1,2]);
        swap(m[i,3],m[1,3]);
        sift(i-1,1);
      end;
  end;

    function tata(nod:longint):longint;
    begin
        if t[nod]<0 then
          tata:=nod
        else
          begin
              t[nod]:=tata(t[nod]);
              tata:=t[nod];
          end;
    end;

  procedure kruskal;
  var i,a,b:longint;
  begin
      for i:=1 to n do
        t[i]:=-1;
      for i:=1 to mm do
        begin
            a:=tata(m[i,1]);
            b:=tata(m[i,2]);
            if a<>b then
              begin
                  t[a]:=t[a]+t[b];
                  t[b]:=a;
                  costtot:=costtot+m[i,3];
                  inc(nrmuchii);
                  select[nrmuchii]:=i;
              end;
        end;
  end;

begin
    assign(fi,'apm.in'); reset(fi);
    assign(fo,'apm.out'); rewrite(fo);

       readln(fi,n,mm);
       for i:=1 to mm do
         readln(fi, m[i,1], m[i,2], m[i,3]); //nod, nod, cost

       sortare;

       kruskal;

       afisare;

    close(Fi); close(Fo);
end.