YUGI - Yugi-Oh

Tác giả: RR

Ngôn ngữ: Pascal

{$R+,Q+}
PROGRAM YUGI;
CONST
  FINP='';
  FOUT='';
  maxn=200;
  maxm=20000;
  oo=1000000;
VAR
  c:array[1..maxn,1..maxn] of longint;
  hu,hv:array[1..maxm] of longint;
  eu,ev,father:array[1..maxn] of longint;
  n,k,hsize:longint;
procedure swap(var a,b:longint);
var
  temp:longint;
begin
  temp:=a; a:=b; b:=temp;
end;
procedure downHeap(i:longint);
var
  j:longint;
begin
  j:=i shl 1;
  while j<=hsize do
    begin
      if (j<hsize) and (c[hu[j+1],hv[j+1]]<c[hu[j],hv[j]]) then inc(j);
      if (c[hu[j],hv[j]]<c[hu[i],hv[i]]) then
        begin
          swap(hu[j],hu[i]);
          swap(hv[j],hv[i]);
        end;
      i:=j; j:=i shl 1;
    end;
end;
procedure upHeap(i:longint);
var
  j:longint;
begin
  j:=i shr 1;
  while (j>=1) and (c[hu[j],hv[j]]>c[hu[i],hv[i]]) do
    begin
      swap(hu[i],hu[j]);
      swap(hv[i],hv[j]);
      i:=j; j:=i shr 1;
    end;
end;
procedure push(u,v:longint);
begin
  inc(hsize);
  hu[hsize]:=u; hv[hsize]:=v;
  upHeap(hsize);
end;
procedure pop(var u,v:longint);
begin
  u:=hu[1]; v:=hv[1];
  swap(hu[hsize],hu[1]);
  swap(hv[hsize],hv[1]);
  dec(hsize);
  downHeap(1);
end;
procedure readInput;
var
  f:text;
  i,j:longint;
begin
  assign(f,FINP); reset(f);
  readln(f,n,k);
  for i:=1 to n do
    for j:=1 to n do
      begin
        read(f,c[i,j]);
        if i<j then push(i,j);
      end;
  close(f);
end;
function getRoot(u:longint):longint;
begin
  while father[u]>0 do u:=father[u];
  getRoot:=u;
end;
procedure union(r1,r2:longint);
var
  x:longint;
begin
  x:=father[r1]+father[r2];
  if father[r1]<father[r2] then
    begin
      father[r2]:=r1;
      father[r1]:=x;
    end
  else
    begin
      father[r1]:=r2;
      father[r2]:=x;
    end;
end;
procedure Kruskal;
var
  i,r1,r2,u,v,count:longint;
begin
  for i:=1 to n do
    father[i]:=-1;
  count:=0;
  while hsize>0 do
    begin
      pop(u,v);
      r1:=getRoot(u);
      r2:=getRoot(v);
      if r1<>r2 then
        begin
          inc(count);
          eu[count]:=u; ev[count]:=v;
          if count=n-1 then exit;
          union(r1,r2);
        end;
    end;
end;
function min(a,b:longint):longint;
begin
  if a<b then min:=a else min:=b;
end;
procedure writeOutput;
var
  ans,i:longint;
  f:text;
begin
  assign(f,FOUT); rewrite(f);
  ans:=oo;
  for i:=n-1 downto n-k+1 do
    ans:=min(ans,c[eu[i],ev[i]]);
  writeln(f,ans);
  close(f);
end;
BEGIN
  readInput;
  Kruskal;
  writeOutput;
END.

Download