Расстояние между точками Опции

[kent]

Помогите с задачей... Дано множество А из N точек. Найти пару различных точек этого множества с минимальным|максимальным расстоянием между ними и само это расстояние(точки выводятся в том же порядке, в котором они перечислены при задании множества А). Мое решение получилось большим, но не это главное, в нем идет дублирование координат...

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.

Может испраить что-нибудь можно, или вообще другой алгоритм использовать?

Сообщение отредактировано: kent - 24.07.2005 13:16

[volvo]

Это все зачем?
Проще надо делать, не нужно усложнять:

{$n+}
type
  TPoint = record
    X, Y: integer;
  end;
function dist(a, b: TPoint): double;
begin
  dist := sqrt(sqr(a.x - b.x) + sqr(a.y - b.y));
end;

var
  A: array[1 .. 1000] of TPoint;
  i, j, N: Integer;
  min_dist, max_dist, curr_dist: double;
  max_first, max_second,
  min_first, min_second: integer;
begin
  { вводим число N }
  { вводим координаты N точек:}
  for i := 1 to n do begin
    write('точка №', i, ': X ='); readln(a[i].X);
    write('Y ='); readln(a[i].Y);
  end;

  min_dist := 100000;
  max_dist := 0;
  for i := 1 to N-1 do
    for j := i+1 to N do begin

      curr_dist := dist(a[i], a[j]);
      if curr_dist < min_dist then begin
        min_first := i; min_second := j; min_dist := curr_dist;
      end;
      if curr_dist > max_dist then begin
        max_first := i; max_second := j; max_dist := curr_dist;
      end;

    end;

  writeln('макс. расстояние: (между', max_first, ' и ', max_second, ') = ', max_dist);
  writeln('мин. расстояние: (между', min_first, ' и ', min_second, ') = ', min_dist);
end.

[kent]

Честно говоря не знал что элемент массива можно задавать в виде двух цифр, а то бы с самого начала так и сделал...
Спасибо, volvo, ты как всегда выручаешь. :thanks: