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