QAT Code: The Visual Cluster Method
Jump to navigation
Jump to search
About ∞ White paper ∞ QuasiMatrix Code ∞ QAT Code ∞ Data Examples ∞ Scatter-Gather Explained ∞ The Plow Share ∞
The QAT Code : The Visual Randomized-Gather Method
The Warehouse if Pairs Expansion then Visual Scatter else Visual Cluster redim Bracketing Clusters while Event Chemistry wend SLIP class redim
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 Const cHeat = 0.67 Dim col As Collection 'pair counter with hash On Error Resume Next Set col = New Collection ' A VB6 data object of Variant data type by string key. 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 in another VB click-event thread, or command call. With oTopic.Atoms ' Randomly select two atoms Set AtomA = .Item(CInt(Rnd * (.Count - 1)) + 1) 'retrieve Atom A by random ordinal Set AtomB = .Item(CInt(Rnd * (.Count - 1)) + 1) 'retrieve Atom B by random ordinal, also 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 notification 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