QAT Code: The Visual Cluster Method

edit

The QAT Code {{{1}}}

---

The Warehouse if Pairs Expansion then Visual Scatter else Visual Cluster redim Bracketing Clusters while Event Chemistry wend SLIP class redim

Answer sought in the review of Vintage VB6 Code is about the existence test of random pairs assembled from A,B sets randomly

Question: Is the index of the Cartesian product table randomly selected?

I reckon it has to be. Standby...

Private Sub iFnData_ClusterAtomsRadial(ByRef oTopic As iTopic, Optional ByVal MaxKiloIters As String = "100")

    Dim AtomA As clsAtom
    Dim AtomB As clsAtom
    Dim intGap As Integer
    Dim intDifference As Integer
    Dim ndx As Long 'max value past four billion
    Dim strPair As String 'holds "**" delimited pair-names of two randomly selected Atoms
    Dim atomX As clsAtom
    Dim strMember As String
    Dim intAngle1 As Integer
    Dim intAngle2 As Integer
    Dim strTemp As String
    Dim strTabulation As String
    
    Dim lngMaxIters As Long
    Dim lngStartingIters As Long
    
    Dim col As Collection 'pair counter with hash
    'Const cHeat = 0.05
    'Const cHeat = 0.3
    Const cHeat = 0.67
    'Const cHeat = 1
    'Const cHeat = 1.33
    
    On Error Resume Next
    
    Set col = New Collection
    
    Screen.MousePointer = vbArrowHourglass  '   because DoEvents is in a loop,
                                            '   allowing IterationEnabled to be toggled
                                            '   while iterating
    '   Cypher stop point
    lngMaxIters = CSng(MaxKiloIters) * 1000
    lngStartingIters = oTopic.Meta.Iters
    
    RaiseEvent CommandResponse("Clustering in progress...")
    
    '   Loop until disabled (grammatical Stop)
    Randomize ' Randomize the seed of the Rnd statement
    Data.IterationEnabled = True
    
    While mbooIteration And (ndx < lngMaxIters)
        
        DoEvents 'allowing IterationEnabled to be toggled
        
        With oTopic.Atoms
            '   Randomly select two atoms
            Set AtomA = .Item(CInt(Rnd * (.Count - 1)) + 1) 'retrieve Atom by random ordinal
            Set AtomB = .Item(CInt(Rnd * (.Count - 1)) + 1)
        End With
        
        '   Build a name-pair from randomly selected Atoms
        strPair = AtomA.Name & "**" & AtomB.Name
        
        'col.Add strPair, strPair
        
        'If Err = 0 Then
        '    Debug.Print col.Count; strPair
        'End If
        Err.Clear
        
        '   Seek for the presence of the pair in the tabular pairs buffer 
        '   [Convention: retro-note: 2023 this buffer is the Cartesian product of categories of two sets]
        '
        '   If found the pair is moved closer together
        '
        If PairExists(strPair) Then
            'Debug.Print "Pair count: " & CStr(col.Count)
            '   Move the two atoms closer,
            '   leaving the separation at
            '   cHeat portion of the original radial gap
    
            '   Store the smaller degree as Angle1 and larger degree as Angle2
            If (AtomA.Degree < AtomB.Degree) Then
                intAngle1 = AtomA.Degree
                intAngle2 = AtomB.Degree
            Else
                intAngle1 = AtomB.Degree
                intAngle2 = AtomA.Degree
            End If
    
            '   Store the difference in angles
            intGap = intAngle2 - intAngle1
    
            Select Case (intGap)
                Case Is <= 180
                    intAngle1 = (cHeat * intGap / 2) + intAngle1
                    intAngle2 = intAngle2 - (cHeat * intGap / 2)
                Case Is > 180
                    intGap = 360 - intGap
                    intAngle1 = intAngle1 - (cHeat * intGap / 2)
                    intAngle2 = (cHeat * intGap / 2) + intAngle2
            End Select
    
            '   Normalize the degrees, should any have lapsed negative
            If intAngle1 < 0 Then intAngle1 = intAngle1 + 360
            If intAngle1 > 360 Then intAngle1 = intAngle1 - 360
            If intAngle2 < 0 Then intAngle2 = intAngle2 + 360
            If intAngle2 > 360 Then intAngle2 = intAngle2 - 360
    
            AtomA.Degree = intAngle1
            AtomB.Degree = intAngle2
        End If 'PairExists(strPair)
        
        '   Increment the index
        ndx = ndx + 1
    

        '   Every 10000 iterations,
        '   or every attainment of MaxIters,
        '   save and update the plot
        If (ndx Mod 10000) = 0 Or ndx >= lngMaxIters Then
            
            '   Update the memory instance of oTopic
            oTopic.Meta.Iters = lngStartingIters + ndx
            
            'Debug.Print atomA.Name; atomB.Name
            'Debug.Print oTopic.Meta.Iters; ndx
            
            '   Send notifacation message
            RaiseEvent AtomDistributionChangedRadial(oTopic)
    
            '   Save the Members tabulation to file
            With New clsFile
                
                '   Convert the Atoms object to a string
                strTabulation = Tabular.SerializeMembers(oTopic.Atoms)
                
                '   Save the string as the current iterated state of members
                .Save _
                        Buffer:=strTabulation, _
                        Filespec:=moRoot.DataPath & oTopic.Path & "\Members.txt"
                .CloseFileWrite
                
                '   Update UI Plot
                ui.PlotRadialData Tabular.SerializeRadials(oTopic.Atoms)
            
            End With

        End If
    Wend
    
    oTopic.Meta.Iters = lngStartingIters + ndx
    Data.IterationEnabled = False
    
    RaiseEvent CommandResponse("Clustering iterations completed: " & CStr(ndx))
    
    Screen.MousePointer = vbDefault

End Sub