uses crt;
var a : array [1..1000] of Integer;
temp : array [1..1000] of Integer;
dif : array [1..1000] of Integer;
id_1 : array [1..1000] of Integer;
id_2 :array [1..1000] of Integer;
N,m,i,j : Integer;
indx, count_indx : Integer;
min,sec_min,id_min : Integer;
max,sec_max,id_max : Integer;
id_near_x1,id_near_x2 : Integer;
id_near_y1,id_near_y2 : Integer;
id_far_x1,id_far_x2 : Integer;
id_far_y1,id_far_y2 : Integer;
near_x1,near_x2 : Integer;
near_y1,near_y2 : Integer;
far_x1,far_x2 : Integer;
far_y1, far_y2 : Integer;
space_near, space_far : Real;
{----------------------------------------}
{Функция вычисления количества сочетаний}
Function Range(a,b : Integer) : Extended;
var p1,p2,p3 : Integer;
fac_a,fac_b,fac_dif : Extended;
begin
fac_a := 1; p1 := 1;
repeat
inc(p1);
fac_a := fac_a * p1;
until p1 = a;
fac_b := 1; p2 := 1;
repeat
inc(p2);
fac_b := fac_b * p2;
until p2 = b;
fac_dif := 1; p3 := 1;
repeat
inc(p3);
fac_dif :=fac_dif * p3;
until p3 = a - b;
Range := fac_a/(fac_b * fac_dif);
end;
{----------------------------------------}
begin
{$R+}
Clrscr;
Write('Input N:');
ReadLn(N);
Write('Input set N:');
for i := 1 to N do begin
Read(a[i]);
temp[i] := a[i];
end;
m := 2;
for i := 1 to m do a[i] := i;
indx := 0;
repeat
inc(indx);
for i := 1 to m do
if (i > 1) then begin
id_1[indx] := a[i - 1];
id_2[indx] := a[i];
end;
dif[indx] := abs(temp[id_1[indx]] - temp[id_2[indx]]);
i := m;
while (i > 1) and (a[i] = N - m + i) do dec(i);
inc(a[i]);
for j := i + 1 to m do a[j] := a[j - 1] + 1;
until (i = 0) or (indx = 1000) or (indx = Range(N,m));
count_indx := indx;
min := Maxint; sec_min := Maxint;
max := -32768; sec_max := -32768;
for indx := 1 to count_indx do begin
if (dif[indx] < min) then begin
id_min := indx;
min := dif[indx];
id_near_x1 := id_1[indx];
id_near_x2 := id_2[indx];
end;
if (dif[indx] > max) then begin
id_max := indx;
max := dif[indx];
id_far_x1 := id_1[indx];
id_far_x2 := id_2[indx];
end
end;
for indx := 1 to count_indx do begin
if (dif[indx] < sec_min) and (indx <> id_min) then begin
sec_min := dif[indx];
id_near_y1 := id_1[indx];
id_near_y2 := id_2[indx];
end;
if (dif[indx] > sec_max) and (indx <> id_max) then begin
sec_max := dif[indx];
id_far_y1 := id_1[indx];
id_far_y2 := id_2[indx];
end;
end;
for i :=1 to N do begin
if (i = id_near_x1) then
near_x1 := temp[i]
else if (i = id_near_x2) then
near_x2 :=temp[i];
if (i = id_near_y1) then
near_y1 := temp[i]
else if (i = id_near_y2) then
near_y2 := temp[i];
if (i = id_far_x1) then
far_x1 := temp[i]
else if (i = id_far_x2) then
far_x2 := temp[i];
if (i = id_far_y1) then
far_y1 := temp[i]
else if (i = id_far_y2) then
far_y2 := temp[i];
end;
space_near := sqrt(sqr(abs(near_x1 - near_x2)) + sqr(abs(near_y1 - near_y2));
space_far := sqrt(sqr(abs(far_x1 - far_x2)) + sqr(abs(far_y1 - far_y2)));
WriteLn;
WriteLn('Nearest points:',' (',near_x1,',',near_y1,')','-','(',near_x2,',',near_y2,');');
WriteLn('Nearest space:',space_near,';');
WriteLn('--------------------------------------');
WriteLn('Farthest points:',' (',far_x1,',',far_y1,')','-','(',far_x2,',',far_y2,');');
WriteLn('Farthest points:',space_far,';');
Readkey;
end.
Может испраить что-нибудь можно, или вообще другой алгоритм использовать?