Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.04.2008, 20:28   #1
Droid
Форумчанин
 
Аватар для Droid
 
Регистрация: 24.04.2008
Сообщений: 440
Вопрос Экономическое дерево

У мну такая проблема если кто поможет буду очень признателен ) У меня есть дерево мне надо соеденить 20 точек.Все растояния расчитываются по этой формуле:
res[i,j]:=sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]));
первые 2 точки у меня соединяются если между ними минимальное расстояние, последущие точки соединяются от этих 2 точек к любой точке которая ближе к этим 2 точкам по расстоянию, потом от 3-х точек до другой по миним. растоянию и так до последней, но надо сделать так чтоб не было цикла )
--------------------------------------------------------------------------
код написал по соединению 2-х мин точек а все остальные не получается как то
--------------------------------------------------------------------------
min:=3;
for i:=0 to 19 do
begin
for j:=i to 19 do
begin
if i<>j then
begin
res[i,j]:=sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]));
memo1.Lines.Add(inttostr(i+1)+','+i nttostr(j+1)+')'+floattostr(res[i,j]));
if res[i,j]<min then
begin
min:=res[i,j];
p1:=i;
p2:=j;
end;

end;
end;
end;
memo2.Lines.Add(inttostr(p1+1)+','+ inttostr(p2+1)+')'+floattostr(min)+ '**'+floattostr(x[p1])+'**'+floattostr(x[p2]));
moveto(round(x[p1]*350)+otstup+10,400-10-round(y[p1]*350));
lineto(round(x[p2]*350)+otstup+10,400-10-round(y[p2]*350));






___________________________________ _________________________
неправильный код
___________________________________ _________________________
for p1:=i to 19 do
begin
for p2:=j to 19 do
begin
if (p1<>p2) and (res[i,j]<min) then
begin
min:=res[i,j];
l1:=p1;
l2:=p2;
moveto(round(x[p1]*350)+otstup+10,400-10-round(y[p2]*350));
lineto(round(x[p1]*350)+otstup+10,400-10-round(y[p2]*350));
end;
end;
end;
1 старый программист, лучше новых 2-х
Droid вне форума Ответить с цитированием
Старый 25.04.2008, 21:56   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,527
По умолчанию

добавть z[i]
=true точка имеющая соединения
=false еще не соединеная точка
и условие расчета./проверки раccтояний

if z[i] and not z[j] //то есть первая точка дожна быть из списка соединенных а вторая из неприсоединенных
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 25.04.2008, 22:08   #3
Droid
Форумчанин
 
Аватар для Droid
 
Регистрация: 24.04.2008
Сообщений: 440
По умолчанию

я чет с координатами путаюсь чет ни как не получаестся наверное я где то неправильно опять написал (
1 старый программист, лучше новых 2-х
Droid вне форума Ответить с цитированием
Старый 25.04.2008, 23:12   #4
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,527
По умолчанию

// заполнить массив я все точки неиспользованы
for p1:=1 to n do z[p1]:=false;

for x:=1 to n do
begin
minres:=1000000; //заведомо большое расстояние
for p1:=1 to n
begin
for p2:=p1+1 to n // p2>p1
begin
if z[p1]<>z[p2] // точки имеют разный статус (оединенная и нет)
or (x=1) //особый первый случай когда все точки несоединенные
then
begin
r:=res(p1,p2); // расчет расстояния
if r<minres then //проверка минимальности
begin
minres:=r;
t1:=p1;
t2:=r2;
end;
end;
end;
end;
// вывод результата и фиксация соединения точек
s:=format('t1=%d t2=%d res=%f ', [t1,t2,res]]);
memo1,lines.add(s);
z[t1]:=true;
z[t2]:=true;
end;
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 25.04.2008 в 23:18.
evg_m вне форума Ответить с цитированием
Старый 25.04.2008, 23:16   #5
Droid
Форумчанин
 
Аватар для Droid
 
Регистрация: 24.04.2008
Сообщений: 440
По умолчанию

Ок огромное спасибо попробую если не получится напишу
1 старый программист, лучше новых 2-х
Droid вне форума Ответить с цитированием
Старый 26.04.2008, 11:18   #6
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

А если так:

Строим матрицу расстояний res как у Вас в примере. Дальше работаем только с частью этой матрицы над главной диагональю.

Ищем минимальный элемент. Соединяем две точки [i, j] этого элемента, в сам элемент записываем maxInt как признак того, что точки использованы.

Дальше рекурсия.
Есть две точки. Для каждой ищем минимальное расстояние (по столбцам и строкам матрицы для этих точек). Делаем соединение с новой точкой, помечаем ее использованной (maxInt). Теперь она крайняя и у нас снова две точки. Здесь рекурсивный вызов.

Рекурсия заканчивается, когда все элементы выше главной диагонали будут maxInt.
alexBlack вне форума Ответить с цитированием
Старый 26.04.2008, 11:21   #7
Droid
Форумчанин
 
Аватар для Droid
 
Регистрация: 24.04.2008
Сообщений: 440
По умолчанию

Цитата:
Сообщение от alexBlack Посмотреть сообщение
А если так:

Строим матрицу расстояний res как у Вас в примере. Дальше работаем только с частью этой матрицы над главной диагональю.

Ищем минимальный элемент. Соединяем две точки [i, j] этого элемента, в сам элемент записываем maxInt как признак того, что точки использованы.

Дальше рекурсия.
Есть две точки. Для каждой ищем минимальное расстояние (по столбцам и строкам матрицы для этих точек). Делаем соединение с новой точкой, помечаем ее использованной (maxInt). Теперь она крайняя и у нас снова две точки. Здесь рекурсивный вызов.

Рекурсия заканчивается, когда все элементы выше главной диагонали будут maxInt.
Если бы я знал как это сделать давно бы сделал ) я даже не знаю что такое maxint
я только учить начал делфи месяца 2 назад )
1 старый программист, лучше новых 2-х
Droid вне форума Ответить с цитированием
Старый 26.04.2008, 15:31   #8
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Надеюсь, это поможет:

Код:
procedure TForm1.Button2Click(Sender: TObject);
var P:array [0..19] of TPoint;
    R:array [0..19, 0..19] of integer;

  procedure DrawLine(P1, P2: integer);
  begin
     ListBox1.Items.add( intToStr(P1) + ' - ' + intToStr(P2));
     canvas.MoveTo(P[P1].X, P[P1].Y);
     canvas.LineTo(P[P2].X, P[P2].Y);
     // Признаки для соединенных точек
     R[P1, low(P)] := 1;
     R[P2, low(P)] := 1;
  end;

  // Возвращает ближайщую точку от P1
  function getNearest(P1:integer; var min:integer):integer;
  var i, j : integer;
  begin
     result := -1; // поиск может быть неудачным
     min := maxInt;
     // Поиск по столбцу
     for i:=low(P) to P1-1 do begin
        if (R[i, 0] = 0) and (R[i, P1] < min) then begin
           min := R[i, P1];
           result := i;
        end;
     end;
     // Поиск по строке
     for j:=P1+1 to high(P) do begin
        if (R[j, 0] = 0) and (R[P1, j] < min) then begin
           min := R[P1, j];
           result := j;
        end;
     end;
  end;

  procedure DrawLines;
  var min, min1, P0, P2, P1, k:integer;
  begin
     // Для всех уже соединенных точек проверяем остальные
     P2 := -1; min := maxInt; P0 := -1;
     for k:=Low(P) to High(P) do begin
        if R[k, 0] = 1 then begin     // Точка соединена
           P1 := getNearest(k, min1); // Ищем ближайшую точку k
           if min1 < min then begin
              P2 := P1;
              min := min1;
              P0 := k;                // Запомнили от какой точки
           end;
        end;
     end;
     if P2 <> -1 then begin            // Точка найдена
        DrawLine(P0, P2);              // Рисуем линию
        DrawLines;
     end;
  end;

var i, j, min, P1, P2:integer;
begin
   refresh;
   randomize;
   ListBox1.Clear;

   // Генерируем массив точек
   for i:=low(P) to high(P) do begin
      P[i].X := random(200);
      P[i].Y := random(200);
      // Сразу рисуем точки
      Canvas.Rectangle(P[i].X-2, P[i].Y-2, P[i].X+2, P[i].Y+2);
   end;

   // Создаем матрицу расстояний
   for i:=low(P) to high(P) do begin
      for j := i+1 to high(P) do begin
         // Нам без разницы расстояние это или квадрат расстояния
         R[i, j] := sqr(P[i].X-P[j].X) + sqr(P[i].Y-P[j].Y);
         // максимально 200^2 + 200^2 - умещается в integer
      end;
   end;

   // Первый столбец матрицы используем как признак соединенных точек
   for i:=low(P) to high(P) do begin
      R[i, low(P)] := 0
   end;

   // Ищем минимальное расстояние в матрице
   min := maxInt;   // максимальное integer
   P1 := 0; P2 := 0;
   for i:=low(P) to high(P) do begin
      for j := i+1 to high(P) do begin
         if R[i, j] < min then begin
            min := R[i, j];
            P1 := i;
            P2 := j;
         end;
      end;
   end;
   // Точки найдутся обязательно
   // Сразу рисуем
   DrawLine(P1, P2);
   DrawLines;
end;
alexBlack вне форума Ответить с цитированием
Старый 26.04.2008, 16:05   #9
Droid
Форумчанин
 
Аватар для Droid
 
Регистрация: 24.04.2008
Сообщений: 440
По умолчанию

ыыы Спасиб я пока ниче не понимаю, но буду разбираться )
1 старый программист, лучше новых 2-х
Droid вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Дерево MAcK Общие вопросы Delphi 7 13.06.2008 17:30
Дерево Rifler Паскаль, Turbo Pascal, PascalABC.NET 1 06.05.2008 08:42
Дерево Yoger БД в Delphi 3 25.01.2007 01:24