QAT Code: The Visual Cluster Method
Jump to navigation
Jump to search
quasiArtifactualIntelligence —a perception from the edge
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
'' ##### #### ###### ## ## ##### #### #### #### ##### ######
'' ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
'' ##### #### #### ## ## ## ## ## ## ## ## ## ## ## ####
'' ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
'' ## #### ###### #### ##### #### #### #### ##### ######
// Define subroutine iFnData_ClusterAtomsRadial with parameters oTopic (reference) and optional MaxKiloIters with default value "100"
SUBROUTINE iFnData_ClusterAtomsRadial(oTopic, MaxKiloIters = "100")
// Initialize variables for atom objects, angles, differences, etc.
DECLARE AtomA, AtomB AS clsAtom
DECLARE intGap, intDifference, intAngle1, intAngle2 AS INTEGER
DECLARE ndx AS LONG // For iteration, capable of exceeding four billion
DECLARE strPair, strMember, strTemp, strTabulation AS STRING
DECLARE lngMaxIters, lngStartingIters AS LONG
DECLARE col AS Collection // To store pair counter with hash
CONST cHeat = 0.67 // Heat constant to determine atoms' proximity adjustment
// Error handling setup
ON ERROR RESUME NEXT
// Initialize collection for storing atom pairs
SET col = NEW Collection
// Set mouse pointer to indicate processing
Screen.MousePointer = vbArrowHourglass
// Determine the maximum number of iterations
lngMaxIters = CONVERT_TO_LONG(MaxKiloIters) * 1000
lngStartingIters = oTopic.Meta.Iters
// Notify start of clustering
RAISE EVENT CommandResponse("Clustering in progress...")
// Enable iteration flag and randomize seed for random number generation
Data.IterationEnabled = TRUE
RANDOMIZE
// Main iteration loop
WHILE Data.IterationEnabled AND (ndx < lngMaxIters)
// Allow UI updates and interaction during iteration
DoEvents
// Randomly select two atoms from oTopic's atoms collection
WITH oTopic.Atoms
AtomA = SELECT RANDOM Atom FROM oTopic.Atoms
AtomB = SELECT RANDOM Atom FROM oTopic.Atoms
END WITH
// Construct a unique identifier for the atom pair
strPair = AtomA.Name & "**" & AtomB.Name
// Check if the pair exists in a predefined collection (pair checking logic not shown)
IF PairExists(strPair) THEN
// Determine angles for atom positions and adjust based on the heat constant
// Calculate new positions to move atoms closer or further apart
// Adjustments include normalizing angles to remain within 0-360 degrees
// Update AtomA and AtomB's degrees with new angles
END IF
// Increment iteration counter
ndx = ndx + 1
// Periodically update oTopic metadata and possibly the UI to reflect changes
IF (ndx MOD 10000) = 0 OR ndx >= lngMaxIters THEN
// Update iteration count in oTopic
// Serialize and save current state of atom positions
// Update UI with new atom distribution
END
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