maybe, you can give any tests where my program doesnt work?
my algo is :
var a : array[0..100001,1..3] of int64;
n,i,o,k,l : longint;
q,w,e,k1,k2,k3,k4 : int64;
s,d : real;
procedure sort(l,r: longint);
var i,j :longint;
x,y,z,w: int64;
begin
i := l;
j := r;
x := A[ (l + r) div 2,1 ];
repeat
while A[i,1] < x do inc(i);
while x < A[j,1] do dec(j);
if not (i>j) then
begin
y := A[i,1];
A[i,1] := A[j,1];
A[j,1] := y;
z := A[i,2];
A[i,2] := A[j,2];
A[j,2] := z;
w := A[i,3];
A[i,3] := A[j,3];
A[j,3] := w;
inc(i);
dec(j);
end;
until i>j;
if l < j then sort(l,j);
if i < r then sort(i,r);
end;
procedure vuv;
begin
if a[k1,3]<a[k2,3] then writeln(a[k1,3],' ',a[k2,3]) else writeln (a[k2,3],' ',a[k1,3]);
halt;
end;
begin
read(n);
for i:=1 to n do
begin
read(a[i,1],a[i,2]);
a[i,3]:=i;
end;
if n=2 then begin k1:=1;k2:=2;vuv;end;
sort(1,n);
k1:=n div 2;
d:=0;
if a[(n div 2)+1,1]=a[n div 2,1] then k2:=k1+1 else
if a[(n div 2)-1,1]<>a[n div 2,1] then
begin
for i:= 1 to n do
if (i<>k1){ and (a[i,1]<>a[k1,1])} then
begin
s:=abs((a[i,2]-a[k1,2])/(a[i,1]-a[k1,1]));
if s>d then begin d:=s;k2:=i;end;
end;
end else
if k1-1>0 then
begin
k3:=k1-1;
k4:=k1;
for i:=1 to n do
if (i<>k4) and (i<>k3) then
begin
s:=abs((a[i,2]-a[k3,2])/(a[i,1]-a[k3,1]));
if s>d then begin k1:=k3;d:=s;k2:=i;end;
s:=abs((a[i,2]-a[k4,2])/(a[i,1]-a[k4,1]));
if s>d then begin k1:=k4;d:=s;k2:=i;end;
end;
end;
vuv;
end.
thanks for all.
Edited by author 11.08.2006 14:54