|
|
| Line 1: |
Line 1: |
| {{headerQuasiAI|subcat=QAT.code}} | | {{headerQuasiAI|subcat=Wiki}} |
| {{headerQATcode|: The Visual Randomized-Gather Method}} | | {{headerQATcode| <b><big>[</big></b> Categorical Abstraction —Event Chemistry <b><big>]</big></b>}} |
|
| |
|
|
| |
|
| <pre style="background:#222; color:lime; overflow:both; border:7px outset black; margin:1em 2em; padding:0 1em; width:888px; font-family:monospace;">
| | == Plausality expansion == |
| | *A combinatoric expansion of two sets of categories, A, and B, as a permutation as "ab" |
| | *Combinations and assembly method in review | 12:37, 13 July 2023 (UTC) |
|
| |
|
| Private Sub iFnData_ClusterAtomsRadial(ByRef oTopic As iTopic, Optional ByVal MaxKiloIters As String = "100")
| |
|
| |
|
| Dim AtomA As clsAtom
| | == Causality Patterns == |
| Dim AtomB As clsAtom
| | *A randomized-gather of a determinant applied in tiny changes of category-icons (points) on a [[randomized scatter]]. |
| Dim intGap As Integer
| | :: Details in review --> [[QAT Code Pair Expansion]] to outline the algorithm's similarity within established comp sci technique. |
| Dim intDifference As Integer
| | :: I think the expanded set is NOT a Cartesian product, which in itself has no category [[occurrence frequency]] information <-- [[user:XenoEngineer|XenoEngineer]] |
| Dim ndx As Long 'max value past four billion
| | :: Suspense is high |
| 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
| | == The gather-loop of category abstraction == |
|
| |
| 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
| |
| | |
| </pre>
| |