开始在各大OJ刷水题。这是一个MST,只是输入数据的时候需要重新构图,其他没什么
p.s.
Var
a,b,f:array[-1..100000]of longint;
e,xx,yy:array[-1..100000]of extended;
n,m,cases:longint;
sum:extended;
Procedure addgraph(x,y:longint;z:extended);
begin
inc(m);
a[m]:=x;b[m]:=y;e[m]:=z;
end;
Procedure setgraph;
var
i,j:longint;
begin
for i:=1 to n do
for j:=1 to n do if i<>j then
begin
ADDGRAPH(I,J,SQRT((XX[I]-XX[J])*(XX[I]-XX[J])+(YY[I]-YY[J])*(YY[I]-YY[J])));
end;
end;
Procedure init;
var
i:longint;
begin
readln(n);
if n=0 then halt;
for i:=1 to n do readln(xx[i],yy[i]);
fillchar(f,sizeof(f),0);
end;
Procedure qsort(l,r:longint);
var
i,j,y:longint;
x,z:extended;
begin
i:=l;j:=r;x:=e[(l+r)shr 1];
Repeat
while e[i]<x do inc(i);
while e[j]>x do dec(j);
if i<=j then
begin
y:=a[i];a[i]:=a[j];a[j]:=y;
y:=b[i];b[i]:=b[j];b[j]:=y;
z:=e[i];e[i]:=e[j];e[j]:=z;
inc(i);dec(j);
end;
until i>j;
if i<r then qsort(i,r);
if l<j then qsort(l,j);
end;
Function find(x:longint):longint;
var
k:longint;
begin
k:=x;
while f[k]<>0 do k:=f[k];
find:=k;
end;
Procedure kruskal;
var
i,j,p,q:longint;
begin
qsort(1,m);
sum:=0;
for i:=1 to m do
begin
p:=find(a[i]);
q:=find(b[i]);
if p<>q then
begin
f[q]:=p;
sum:=sum+e[i];
end;
end;
write('The minimal distance is: ');
writeln(sum:0:2);
end;
Begin
cases:=0;
n:=1;
while n<>0 do
begin
inc(cases);
init;
if (n<>0)and(cases<>1) then writeln;
writeln('Case #',cases,':');
m:=0;
setgraph;
kruskal;
end;
End.
ZOJ竟然让我体验了一把PE……