Доброго времени суток.
В той или иной степени интересуюсь алгоритмами. Наткнулся на свежую статью
«Поиск повторений в двумерном массиве, или вычислительная сложность на примере» http://habrahabr.ru/post/141258/. Автор стати,Singerofthefall, довольно интересно рассказывает про решение задачи и оптимизации алгоритма. Очень интересно. Однако, по моему мнению, прежде всего необходимо было определить не алгоритм, а инструмент которым будет решаться задача. И вот инструмент был выбран неправильный, отсюда вся сложность и оптимизации.
Для решения задачи автора более всего подходили инструменты БД, соответственно и надо было их использовать.
Возможны 2 пути.
- Обращение к файлу xls как к базе данных, поподробнее можно прочитать тут http://vbadud.blogspot.com/2008/05/using-excel-as-database.html
- Перегон данных в БД и обработка с последующим выводом.
Т.к. по работе часто сталкиваюсь с похожей задачей, обработка двумерного массива, но не в файлах xls, а в AutoCAD и с координатами, то попробую показать как это работает.
Простейшее решение
- Создаем БД, для простоты пользуюсь DAO. Если критична скорость, имеет смысл создавать базу на РамДиске.
- Создаем таблицу для приема данных
- Перегоняем исходные данные в таблицу
- Выполняем простейший SQL запрос, группируя и сортируя данные.
- Выводим данные.
'Комментарии сознательно стер, так как при вставке их из 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
