Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Найти минимальное расстояние между точками
 
#1
21.11.2018 00:41:08
Добрый день.
Имеется массив данных из 25 колонок и 50 строк (где 1 и 2 строка координата точек X и Y соответственно).
Необходимо найти минимальное расстояние между всеми точками. Я думал, что единственный вариант это сделать с помощью VBA т.к. необходимо перебрать все возможное варианты?
В примере всего 15 точек, но подразумевается, что может быть вариант и с 625 точками. (Может можно как-то игнорировать пустые значения?)
Расстояние между точками будет по формуле D = ((x_2 - x_1) ^ 2 + (y_2 - y_1) ^ 2) ^ 0.5
Я что-то начал делать в VBA, но у меня нет идей и достаточных знаний чтобы это реализовать. Поэтому обращаюсь за помощью.
Буду благодарен за любую помощь, спасибо.

П.С. Если не достаточно понятно объяснил
 
 
 
#2
21.11.2018 01:28:35
Цитата
Teklan написал:
Я что-то начал делать в VBA,
Это точно.
Сам алгоритм не поддерживаю, но в помощь код написал
Есть ошибка, разбираться некогда.Не видит макрос соседние точки в строке.
Изменено: doober - 21.11.2018 01:46:09
 
 
 
#3
21.11.2018 01:48:09
Цитата
Teklan написал:
что может быть вариант и с 625 точками
это 194 376 вариантов.
В принципе - не так уж и много...
Изменено: Михаил С. - 21.11.2018 01:54:11
 
 
 
#4
21.11.2018 03:51:55
Пара замечаний по постановке задачи:
1. Скорее всего, нужно не просто вычислить минимальное расстояние, а определить точки с минимальным расстоянием. Тогда это нужно явно написать, т.к. в коде потребуется запоминать эти точки, а не только минимальное расстояние.
2. Теоретически точка может быть с X=0 и Y=0. Тогда в примере без всякого расчета видно, что минимальное растояние - нулевое, так как точек с нулевыми координатами не менее 2-х. Поэтому ячейки, которые нужно игнорировать, должны быть либо пустыми (или нечисловыми), либо нужно явно декларировать, что точки с X=0 и Y=0 игнорировать.
Изменено: ZVI - 21.11.2018 03:57:35
 
 
 
#5
21.11.2018 08:16:37
ZVI, Да, Вы правы. Необходимо вывести так же точки между которыми расстояние минимилаьное. Но как это сделать я точно не знаю :(

Да, игнорировать можно ячейки где значения нулевые.
То что мне приходит в голову это ограничивать границу массива т.к. точки заполняются с лева на право и сверху вниз.
Соответственно вводить в расчет не 25*50 размер массива, а скажем 8*6, как у меня в примере.

doober, Спасибо. Может когда будет время тогда.
Изменено: Teklan - 21.11.2018 08:25:57
 
 
 
#6
21.11.2018 19:51:56
Teklan, вот что получилось. Функция возвращает массив из 5 чисел. Для визуализации добавил условное форматирование. На втором листе заполнил часть диапазона функцией СЛЧИС. При пересчете по F9 основное время занимает пересчет УФ.
Код
Function Te(data As Range) As Variant()
Dim r&, c&, i&, j&, im&, jm&, d#, dm#, v(), x#(), y#()
  v = data.Value2
'определение границ массива по первому столбцу и первой строке
  For r = UBound(v) To 1 Step -2
    If v(r, 1) <> 0 Then Exit For
  Next
  r = r \ 2
  For c = UBound(v, 2) To 1 Step -1
    If v(1, c) <> 0 Then Exit For
  Next
'данные - в одномерные массивы
  ReDim x(1 To r * c), y(1 To r * c)
  For i = 1 To c
    For j = 1 To r
      im = im + 1
      x(im) = v(j * 2 - 1, i): y(im) = v(j * 2, i)
    Next
  Next
'нахождение мин
  dm = 1E+99
  For i = 1 To r * c - 1
    If x(i) <> 0 And y(i) <> 0 Then
      For j = i + 1 To r * c
        If x(j) <> 0 And y(j) <> 0 Then
          d = (x(j) - x(i)) ^ 2 + (y(j) - y(i)) ^ 2
          If d < dm Then dm = d: im = i: jm = j
        End If
      Next
    End If
  Next
  Te = Array(Sqr(dm), x(im), x(jm), y(im), y(jm))
End Function
 
 
 
#7
21.11.2018 20:24:31
Вау, супер. Большое спасибо.
При первом взгляде на код не понятно ))) попробую разобраться как оно работает.
Например данная функция, что она далает ? Первый раз вижу на VBA такое оформление )))
Код
x(im) = v(j * 2 - 1, i): y(im) = v(j * 2, i)
 
 
 
#8
21.11.2018 22:12:07
Teklan, переписываю данные из исходного двумерного массива (значение диапазона, тип Variant) в два одномерных типа Double. Чтобы потом находить разности было удобнее и быстрее.
Пройдите этот цикл по шагам: точку останова на 14 строку, обновить функцию - она будет вызвана и произойдет останов, далее F8 и смотрите содержимое переменных в Locals.
 
 
 
Страницы: 1
Наверх