Cod sursa(job #700759)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 1 martie 2012 11:50:02
Problema Arbore partial de cost minim Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.5 kb
program kruskal;

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

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

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


  procedure kruskal;
  var i,j,k:integer;
  begin
    k:=1;
      repeat
        while arb(m[k,1])=arb(m[k,2]) do
          inc(k);
        inc(nrmuchii);
        i:=m[k,1];
        j:=m[k,2];
        inc(costtot,m[k,3]);
        inc(nrs);
        select[nrs,1]:=i;
        select[nrs,2]:=j;

        if h[i]=h[j] then
          begin
              t[i]:=j;
              h[j]:=h[j]+1;
          end
        else
          if h[i]<h[j] then
            t[i]:=j
          else
            t[j]:=i;
        inc(k);

      until nrmuchii=n-1;
  end;

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

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

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

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

    procedure sift(n,k:integer);
    var fiu:integer;
    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:integer;
  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;

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.