program mst2(input,output);

const
   maxnumverts=50;
   MAXNUMBUCS=100;
#include "m-type.i"
   PQptr=^PQnode;
   PQnode=record
         S,F:vertex;
         nxt:PQptr
        end;
   buckindex=0..MAXNUMBUCS;
#include "m-var.i"
   PARENT,SIZE:array[vertex] of integer;
   PQhead:PQptr;
   i,u,v:vertex;
   HEAD,TAIL:array[buckindex] of PQptr;
   numbuckets:buckindex; 
   dist:array[vertex,vertex] of real;
   maxdist:real;

#include "m-rw.i"
#include "g-distance.i"


procedure dumpPQ(p:PQptr);
begin
while p<>nil do
  begin
   writeln(p^.S:4,' -> ',p^.F:4,'    dist=',distance(loc[p^.S],loc[p^.F]):8:4);
   p:=p^.nxt
  end
end;



procedure initPQ;

var i:buckindex;

procedure dumpbuckets;
var i:buckindex;
begin
 writeln('dumping buckets');
 for i:=0 to numbuckets do if HEAD[i]<>nil then
  begin
    writeln('BUCKET',i:4);
    dumpPQ(HEAD[i])
  end;
 writeln('end of bucket dump')
end;

procedure calcdist;
var
 d:real;
 u,v:vertex;
begin
 maxdist:=0.0;
 for u:=1 to numverts do for v:=1 to numverts do
  begin
    d:=distance(loc[u],loc[v]);
    if d>maxdist then maxdist:=d;
    dist[u,v]:=d;
    dist[v,u]:=d
  end
end;

procedure fillbuckets;
var
 b:buckindex;
 p:PQptr;
 u,v:vertex;
begin
 for b:=0 to numbuckets do begin HEAD[b]:=nil; TAIL[b]:=nil end;
 for u:=1 to numverts-1 do for v:=u+1 to numverts do
    begin
      b:=trunc(numbuckets*dist[u,v]/maxdist);
      new(p);
      p^.S:=u;
      p^.F:=v;
      p^.nxt:=HEAD[b];
      HEAD[b]:=p;
      if TAIL[b]=nil then TAIL[b]:=p
    end
end;

procedure sortlist(h:PQptr);
var
  p,q:PQptr;
  moreswaps:boolean;
  temp:vertex;
begin
  if h<>nil
  then
  repeat 
     p:=h;
     q:=p^.nxt;
     moreswaps:=false;
     while q<>nil do
      begin
       if dist[p^.S,p^.F]>dist[q^.S,q^.F]
       then begin
              moreswaps:=true;
              temp:=p^.S;
              p^.S:=q^.S;
              q^.S:=temp;
              temp:=p^.F;
              p^.F:=q^.F;
              q^.F:=temp;
            end;
       p:=q;
       q:=p^.nxt
      end 
  until not moreswaps
end;

procedure getnext(var i:integer);
begin
 i:=i+1;
 while (HEAD[i]=nil) and (i<=numbuckets) do i:=i+1
end;

procedure concatenate;
var
 i:integer;
 p:PQptr;
begin
   i:=-1;
   getnext(i);
   PQhead:=HEAD[i];
   p:=TAIL[i];
   while i<=numbuckets do
     begin
       getnext(i);
       if (i<=numbuckets)
       then
         begin
            p^.nxt:=HEAD[i];
            p:=TAIL[i]
         end
     end
end;

begin
 calcdist;
 if numverts*(numverts-1) < 2*MAXNUMBUCS
 then numbuckets:=numverts*(numverts-1) div 2
 else numbuckets:=MAXNUMBUCS;
 fillbuckets;
 for i:=0 to numbuckets do sortlist(HEAD[i]);
 concatenate
end;

procedure takemin(var u,v:vertex);
begin
 if PQhead=nil then writeln('empty PQ');
 u:=PQhead^.S;
 v:=PQhead^.F;
 PQhead:=PQhead^.nxt
end;


{--------------------------------------------------------------}
{ Union - Find DS }


function find(u:vertex):vertex;
var v:vertex;
begin
 v:=u;
 while PARENT[v]<>0 do v:=PARENT[v];
 find:=v
end;

procedure union(u,v:vertex);
begin
 if SIZE[u]>SIZE[v]
 then begin PARENT[v]:=u; SIZE[u]:=SIZE[u]+SIZE[v] end
 else begin PARENT[u]:=v; SIZE[v]:=SIZE[u]+SIZE[v] end
end;

procedure initPandS;
var u:vertex;
begin
 for u:=1 to numverts do begin SIZE[u]:=1; PARENT[u]:=0 end
end;

begin
 readgraph;
 initPandS;
 initPQ;
 dumpPQ(PQhead);
 for i:=numverts downto 2 do
 begin
    takemin(u,v);
    while find(u)=find(v) do takemin(u,v);
    A[u,v]:=true;
    A[v,u]:=true;
    union(find(u),find(v))
 end;
 writegraph
end.
