TNN RUS

ТЕрритория бЕз имЕни

    Ресурс разрабатывался с целью преодоления граничащего с преступлением недостатка информации и тех. средств в области геомеханики и комплексной обработки массивов цифровой информации (ни один пакет: Maple, Mathematica, и даже MathCad и MatLab - не показали должного уровня обработки именно такого типа информации. Delphi даже в расчёт не берётся).

    Уже в сентябре 2004 года текущие наработки и собранная литература не позволили автору игнорировать подобное положение вещей.

mykaralw@yandex.ru

Триангуляция в Microsoft Excel.


В данном проекте уделено особое внимание построению поверхностей и работа с ними средствами MS Excel.

Надстройка XlMatrix for MS Excel.

    В данном разделе не приводится описание вариантов построения триангуляции Делоне, а описывается конкретный алгоритм, реализованный в Visual Basic Application for MS Excel.

    В настоящем алгоритме производится:

  1. определение стартового активного "ребра",
  2. поиск активного "ребра",
  3. поиск "точки", удовлетворяющей условию Делоне,
  4. деактивация текущего активного "ребра",
  5. проверка найденных сопряжённых "рёбер".

    6. ПРИМЕЧАНИЕ.

Активное "ребро" - "ребро", для которого определена сопряжённая точка, либо её отсутствие.

Деактивированное "ребро" - "ребро", для которого определены обе сопряжённые точки, либо их отсутствие.

Неактивированное "ребро" - "ребро", для которого неопределенна ни одна сопряжённая точка, либо её отсутствие.

Переменные, задействованные в алгоритме.

Public Function TriangulationDelaunay(point As Variant) As Variant
Attribute TriangulationDelaunay.VB_Description = "Построение системы треугольников по набору точек point=mmatrix(XY)."
Dim n As Long
Dim nt As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim hn As Long
Dim hf As Boolean
Dim kt As Long
Dim kr As Double
Dim counta As Long
Dim counttr As Long
Dim minX As Double
Dim maxK As Double
Dim minlen As Double
Dim x1 As Double
Dim x2 As Double
Dim x3 As Double
Dim y1 As Double
Dim y2 As Double
Dim y3 As Double
Dim ax As Double
Dim ay As Double
Dim bx As Double
Dim by As Double
Dim xa As Double
Dim ya As Double
Dim sa As Double
Dim sb As Double
Dim sc As Double
Dim x As Double
Dim y As Double
Dim x0 As Double
Dim y0 As Double
Dim k1 As Double
Dim k2 As Double
Dim xx As Double
Dim yy As Double
Dim len1 As Double
Dim t1 As Double
Dim t2 As Double
Dim t3 As Double
Dim xc As Double
Dim yc As Double
Dim r2c As Double
Dim r2 As Double
Dim alive() As Long
Dim tri() As Long
Dim res() As Long
  n = UBound(point)
  nt = n * 10
  counta = 0
ReDim alive(1 To nt, 1 To 4)
ReDim tri(1 To nt, 1 To 3)

Определение стартового активного "ребра".

1. Поиск первой точки стартового "ребра", крайней точки по x.

  i = 1
  minX = point(1, 1)
  For h = 2 To n
    If point(h, 1) < minX Then
      minX = point(h, 1)
      i = h
    End If
  Next h
  alive(1, 1) = i

2. Поиск второй точки стартового "ребра".

  maxK = 0
  For h = 1 To n
    If h <> i Then
      If point(h, 1) = point(i, 1) Then
        j = h
        h = n
      Else
        kr = Abs((point(h, 2) - point(i, 2)) / (point(h, 1) - point(i, 1)))
        If kr > maxK Then
          maxK = kr
          j = h
        End If
      End If
    End If
  Next h
  alive(1, 2) = j

3. Данное "ребро" является стороной выпуклой оболочки, поэтому активизируем его, приписав ему отсутствие одной из смежных вершин.

  alive(1, 3) = -1
  counta = 1

Поиск активного "ребра".

4. Переходим к основному циклу алгоритма.

  counttr = 0
  h = 1
  kt = counta
  Do While (counta > 0 And kt < nt - 2)
    ...
  Loop

Данный цикл будет продолжаться до тех пор, пока счётчик активных "рёбер" не обнулится.

4.1. Поиск активного ребра.

    m = 0
    hf = False
    hn = 0
    For h = 1 To kt
      If (alive(h, 3) <> 0) And alive(h, 4) = 0 Then
        m = h
        h = kt
      End If
    Next h

Поиск "точки", удовлетворяющей условию Делоне.

4.2. Если активное "ребро" существует, найти третью точку, удовлетворяющую условию Делоне.

    If m > 0 Then
      counta = counta - 1
      i = alive(m, 1)
      j = alive(m, 2)
      k = alive(m, 3)
      x1 = point(i, 1)
      y1 = point(i, 2)
      x2 = point(j, 1)
      y2 = point(j, 2)
      hn = 0
      For h = 1 To n
        hf = False
        If (h <> i) And (h <> j) And (h <> k) Then
          x3 = point(h, 1)
          y3 = point(h, 2)
          sc = x1 * (y2 - y3) + x2 * (y3 - y1) + x3 * (y1 - y2)
          If sc <> 0 Then
            t1 = x1 ^ 2 + y1 ^ 2
            t2 = x2 ^ 2 + y2 ^ 2
            t3 = x3 ^ 2 + y3 ^ 2
            sa = t1 * (y2 - y3) + t2 * (y3 - y1) + t3 * (y1 - y2)
            sb = t1 * (x2 - x3) + t2 * (x3 - x1) + t3 * (x1 - x2)
            xc = 0.5 * sa / sc
            yc = -0.5 * sb / sc
            r2c = (x1 - xc) ^ 2 + (y1 - yc) ^ 2
            For l = 1 To n
              If (l <> i) And (l <> j) And (l <> h) Then
                hf = True
                x = point(l, 1)
                y = point(l, 2)
                r2 = (x - xc) ^ 2 + (y - yc) ^ 2
                If r2 < r2c Then
                  hf = False
                  hn = 0
                  l = n
                Else
                  hf = True
                End If
              End If
            Next l
          End If
        End If

Проверка условия Делоне производиться с помощью нахождения центра окружности, проходящей через три точки, с последующим нахождением квадрата радиуса этой окружности. Все остальные точки проверяются на непопадание в данную окружность.

Деактивация текущего активного "ребра".

4.3. Деактивация активного "ребра" производится уменьшением счётчика активных "рёбер" и записью в ребро второй сопряжённой "точки".

      counta = counta - 1
	...
        alive(m, 4) = hn

Эти строки входят в предыдущий и последующие части алгоритма.

Проверка найденных сопряжённых "рёбер".

4.4. Если третья точка существует, проверить найденные "рёбра" на активность. Если "ребро" является активным, деактивировать его. Если "ребро" неактивное, сделать его активным. Если новые "рёбра" отсутствуют записать в исходное ребро отсутствие второй сопряжённой "точки", иначе добавить новый треугольник в список tri.

      If hf Then
        alive(m, 4) = hn
        k = 0
        For h = 1 To kt
          If (alive(h, 1) = i And alive(h, 2) = hn) Or (alive(h, 1) = hn And alive(h, 2) = i) Then
            If alive(h, 3) <> 0 Then k = h
            h = kt
          End If
        Next h
        If k = 0 Then
          kt = kt + 1
          alive(kt, 1) = i
          alive(kt, 2) = hn
          alive(kt, 3) = j
          counta = counta + 1
        ElseIf k > 0 Then
          alive(k, 4) = j
          counta = counta - 1
        End If
        k = 0
        For h = 1 To kt
          If (alive(h, 1) = j And alive(h, 2) = hn) Or (alive(h, 1) = hn And alive(h, 2) = j) Then
            If alive(h, 3) <> 0 Then k = h
            h = kt
          End If
        Next h
        If k = 0 Then
          kt = kt + 1
          alive(kt, 1) = j
          alive(kt, 2) = hn
          alive(kt, 3) = i
          counta = counta + 1
        ElseIf k > 0 Then
          alive(k, 4) = i
          counta = counta - 1
        End If
        counttr = counttr + 1
        tri(counttr, 1) = i
        tri(counttr, 2) = j
        tri(counttr, 3) = hn
      Else
        alive(m, 4) = -1
      End If
    End If

5. Выдать результат.

ReDim res(1 To counttr, 1 To 3)
  For h = 1 To counttr
    For m = 1 To 3
      res(h, m) = tri(h, m)
    Next m
  Next h
  TriangulationDelaunay = res

Конец алгоритма.

См. полный листинг фукции.

ПРИМЕЧАНИЕ.

Для того, чтобы не производить каждый раз поиск сопряжённых "рёбер" в общем списке "рёбер", можно создать дополнительный симметричный массив links(1 to n, 1 to n) As Long, и для каждого нового "ребра" записывать в него номер записи в общем списке, например links(i, hn) = kt: links(hn, i) = kt. В результате процесс поиска заменяется процессом проверки одной ячейки массива links(i, hn), и если это значение равно 0, то "ребро" является неактивным, если это значение равно -1, то "ребро" является деактивированным, в остальных случаях сразу получаем номер записи искомого "ребра" без поиска. Это приводит к дополнительному расходу памяти, но убыстряет работу алгоритма.

При применении данной функции следует помнить, что в ней используются математические x и y. Поэтому, применяя её с геодезическими Xг и Yг, надо либо поменять стобцы Xг и Yг местами, либо переопределить подписи осей таким образом, чтобы соблюдалось x=Yг и y=Xг.

безымянный © copyright 2004

Опубликовано 7 апреля 2006г.

Made in Terra No Names.

Сайт управляется системой uCoz