Поиск повторений в двумерном массиве, или правильно выбранный инструмент

в 7:12, , рубрики: vba, Алгоритмы, вычислительная сложность, Песочница, поиск по сходству, Программирование, метки: , ,

Доброго времени суток.

В той или иной степени интересуюсь алгоритмами. Наткнулся на свежую статью
«Поиск повторений в двумерном массиве, или вычислительная сложность на примере» http://habrahabr.ru/post/141258/. Автор стати,Singerofthefall, довольно интересно рассказывает про решение задачи и оптимизации алгоритма. Очень интересно. Однако, по моему мнению, прежде всего необходимо было определить не алгоритм, а инструмент которым будет решаться задача. И вот инструмент был выбран неправильный, отсюда вся сложность и оптимизации.
Для решения задачи автора более всего подходили инструменты БД, соответственно и надо было их использовать.

Возможны 2 пути.

  1. Обращение к файлу xls как к базе данных, поподробнее можно прочитать тут http://vbadud.blogspot.com/2008/05/using-excel-as-database.html
  2. Перегон данных в БД и обработка с последующим выводом.

Т.к. по работе часто сталкиваюсь с похожей задачей, обработка двумерного массива, но не в файлах xls, а в AutoCAD и с координатами, то попробую показать как это работает.

Простейшее решение

  1. Создаем БД, для простоты пользуюсь DAO. Если критична скорость, имеет смысл создавать базу на РамДиске.
  2. Создаем таблицу для приема данных
  3. Перегоняем исходные данные в таблицу
  4. Выполняем простейший SQL запрос, группируя и сортируя данные.
  5. Выводим данные.
'Комментарии сознательно стер, так как при вставке их из IDE VBA в форму получаю вот это "Ioeaea! Auiieiaiea i?ia?aiiu i?a?aaii!"
Sub grid()
    Dim retObj As AcadObject
    Dim retPnt As Variant

    Dim db As DAO.Database
    Dim rst As Recordset

    Dim ssetObj As AcadSelectionSet
    Dim Items As Object
    Dim handle As String

        mesto_db = Environ("APPDATA") & ""
        name_db = Environ("UserName") & "_grid"
            Set fs1 = CreateObject("Scripting.FileSystemObject")
            fs1.CreateTextFile mesto_db & name_db & ".mdb"
            fs1.DeleteFile mesto_db & name_db & ".mdb"

        Set db = DAO.CreateDatabase(mesto_db & name_db & ".mdb", dbLangCyrillic)

        db.Execute "CREATE TABLE Tabl1 " & "(x REAL, y REAL, h CHAR(10));"

    On Error Resume Next
    Set ssetObj = ThisDrawing.SelectionSets("Boxa")
    If Err <> 0 Then
        Err.Clear
        Set ssetObj = ThisDrawing.SelectionSets.Add("Boxa")
    End If
    ssetObj.Clear
    ssetObj.SelectOnScreen

    On Error GoTo fuck

Dim temp_block As AcadBlockReference

For Each item In ssetObj

        If item.ObjectName = "AcDbBlockReference" Then 
            If item.EffectiveName = "SV" Then
                Attributes = item.GetAttributes
                BlockProperties = item.GetDynamicBlockProperties
                point = item.insertionPoint
                point1 = CLng(point(0))
                point2 = CLng(point(1))
                Set temp_block = item
                handle = CStr(temp_block.handle)

   db.Execute "INSERT INTO Tabl1 (x,y,h) VALUES (" & point1 & ", " & point2 & ", '" & handle & "');"
            End If
        End If
Next

        Set rst = db.OpenRecordset("SELECT x, y, h FROM Tabl1 GROUP BY x, y, h  ORDER BY x, y, h ;")
        If rst.RecordCount > 0 Then
            rst.MoveFirst
            Do While Not rst.EOF = True
                X0 = rst.Fields(0)
                Y0 = rst.Fields(1)

               rst.MoveNext
            Loop
        End If

fuck:
If Err <> 0 Then ThisDrawing.Utility.Prompt (vbCrLf & "Error!" & vbCrLf)
    rst.Close
    db.Close
    Set db = Nothing

    ssetObj.Clear
    ssetObj.Delete
End Sub
Скорость выполнения:

Количество точек — время выполнения
100*100 — 5,89 сек
200*200 — 24,73 сек
400*200 — 47,33 сек
Линейная зависимость

Вывод:

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

PS

1. В примечание к тегу (source) VBA хоть и не указан, но работает.
2. Для отслеживания повторений в массиве можно использовать Коллекцию

                Dim x_col As New Collection
                Dim txt_arr() As Variant

                For Q = 1 To UBound(txt_arr) 
                    x_col_Item = txt_arr(Q)
                    x_col.Add x_col_Item, CStr(x_col_Item)
               Next

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

Автор: BoxaShu

* - обязательные к заполнению поля


https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js