Search for repetitions in a two-dimensional array, or a correctly selected tool

Good day.

To one degree or another, I'm interested in algorithms. I came across a recent article
“Search for repetitions in a two-dimensional array, or computational complexity using an example” http://habrahabr.ru/post/141258/ . The author of the article , Singerofthefall , talks quite interestingly about solving a problem and optimizing an algorithm. Very interesting. However, in my opinion, first of all, it was necessary to determine not an algorithm, but a tool by which the problem will be solved. And the wrong tool was chosen, hence the whole complexity and optimization.
To solve the author’s problem, DB tools were most suitable, respectively, and it was necessary to use them.

2 ways are possible.
  1. Accessing the xls file as a database can be found in more detail here http://vbadud.blogspot.com/2008/05/using-excel-as-database.html
  2. Transferring data to the database and processing with subsequent output.

Because I often encounter a similar task when working, processing a two-dimensional array, but not in xls files, but in AutoCAD and with coordinates, then I will try to show how it works.

Simplest solution

  1. We create a database, for simplicity I use DAO. If speed is critical, it makes sense to create a base on RamDisk.
  2. Create a table for receiving data
  3. We overtake the source data into a table
  4. We perform the simplest SQL query by grouping and sorting data.
  5. We display the data.


'Комментарии сознательно стер, так как при вставке их из 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


Execution speed:

Number of points - lead time
100 * 100 - 5.89 s
200 * 200 - 24.73 s
400 * 200 - 47.33 s
Linear dependence

Conclusion:

The conclusions in the article, which I referred to at the beginning, are very good and I have two hands for them.
I will add only the third point, which is always the best result will give the most suitable tool.

PS

1. Although not indicated in the note to the (source) tag, VBA works.
2. To track repetitions in an array, you can use the Collection
                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

When adding an item to the collection with the key already in it, you will get an error. When processing it, you will receive a set of only repeating elements.

Also popular now: