alife.ctl

MATLAB,VB做成的神经网络计算程序

    'We establish the mindcore fiber of "you" ("other"):
    lclTime = 10
    lclFiber = 13
    lclActivation = 0
    lclPrevious = 37
    lclEnglishLexicon = 13
    lclSubsequent = 0
    lclNaturalLanguageProcessing = 5
    
    Instantiate

    'Return to the main BOOTSTRAP subroutine.
End Sub

'PSI-2 is the second mindcore "psi" bootstrap.
Sub PSI_2()
    'you (other)
    lclTime = 15
    lclFiber = 13
    lclActivation = 0
    lclPrevious = 0
    lclEnglishLexicon = 13
    lclSubsequent = 39
    lclNaturalLanguageProcessing = 5
    
    Instantiate

    'see
    lclTime = 19
    lclFiber = 39
    lclActivation = 0
    lclPrevious = 13
    lclEnglishLexicon = 39
    lclSubsequent = 10
    lclNaturalLanguageProcessing = 8
    
    Instantiate

    'me (self)
    lclTime = 22
    lclFiber = 10
    lclActivation = 0
    lclPrevious = 39
    lclEnglishLexicon = 10
    lclSubsequent = 0
    lclNaturalLanguageProcessing = 5
    
    Instantiate
    
    'Return to the main BOOTSTRAP subroutine.
End Sub

'Sensorium handles the input of sensory perception.
Sub Sensorium()
    Ear_Damp    'to clear auditory memory
    
    'a no-later-than demarcation so that fresh input can
    'have lower activation than old reactivations.
    lclNotLaterThan = lclTime
    
    For x = 0 To 80 'accept entry of at most 80 characters
        DoEvents
        
        Audition    'retrieve the incoming or reentering phonemes
        
        lclTime = lclTime + 1   'increment time by one unit
        
        If lclUnknown = 13 Then
            lclBeginning = 1
            lclEndOfText = 13
            lclBlankTime = lclTime
            lclUnknown = 32
            
            'Display_Message vbCrLf
            
            lclParse = 3
        End If
        
        'If lclUnknown = 27 Then
        '    Display_Message vbCrLf & " Sensorium: Halt.  You may enter .psi .en .ear "
        '    Display_Message vbCrLf & " to see the contents of psi, en, or ear."
        '
        '    lclUnknown = 0
        '
        '    End
        'End If
        
        If lclUnknown = 32 Then 'spacebar
            Retro   'to adjust ending of a recognized word
        End If
        
        lclBeginning = 1
        lclContinuation = 1
        lclOnset = lclBlankTime + 1
        
        If lclOnset = lclTime Then
            lclBeginning = 1
        Else
            lclBeginning = 0
        End If
        
        If lclUnknown > 32 Then
            lclLength = lclLength + 1
            
            Short_Term_Memory   'store character in Short Term Memory
        End If
        
        If lclEndOfText = 13 Then
            lclAttention = 0
            lclEndOfText = 0
        End If
        
        If lclAttention <> -1 Then
            lclPreviousGrammarCategory = 3
            
            Exit For
        End If
    Next
    
    'return to ALife or to the reentry process
End Sub

'Audition handles the input of ASCII in lieu of phonemes.
Public Sub Audition()
    If lclAttention = -1 Then
        lclUnknown = Get_Key
        
        Display_Message Chr(lclUnknown) 'display input of user
    End If
    
    'if attention is off, the reentry process supplies Unknown
        
    lclUnknown = Asc(UCase(Chr(lclUnknown)))

    'return to Sensorium
End Sub

'Retro goes back and tags a word that has just ended.
Sub Retro() 'called by Sensorium when incoming character = 32 (spacebar)
    lclBlankTime = lclTime
    lclTimeUltimate = lclTime - 1
    
    lclEar(lclTimeUltimate).Continuation = 0
    
    If lclSpy > 51 Then
        Display_Message vbCrLf & Chr(9) & Chr(9) & "Retro: move-tag = " & lclMoveTag
    End If
    
    If lclMoveTag > 0 Then
        lclRecallVector = lclOnset
        lclOnset = 0
        
        lclEar(lclTimeUltimate).UltimateTag = lclMoveTag    'store the move-tag
        
        OldConcept
        
        lclMoveTag = 0
        lclRecallVector = 0
    Else
        If lclLength > 0 Then
            lclRecallVector = lclOnset  'onset from sensorium
            
            NewConcept
            
            If lclSpy > 53 Then
                Display_Message Chr(9) & Chr(9) & "Retro: rv = " & lclRecallVector & vbCrLf
            End If
            
            lclEar(lclTimeUltimate).UltimateTag = lclEnglishLexiconConceptNumber    'store new concept ultimate-tag.
        End If
    End If
    
    Ear_Damp
    
    lclLength = 0
    lclRecallVector = 0
    
    'return to Sensorium
End Sub

'Short Term Memory of auditory engrams.
Sub Short_Term_Memory()
    If lclUnknown > 32 Then 'ASCII 32 (Spacebar)
        Comparator
    End If
    
    If lclEar(lclTime - 1).Unknown = 0 Then 'rrb 4/3/2000 - miscoded...  was .UltimateTag
        lclBeginning = 1
    End If
    
    lclEar(lclTime).Unknown = lclUnknown    'store the Unknown phoneme at Time
    lclEar(lclTime).Activation = 0  'store no Activation level
    lclEar(lclTime).Beginning = lclBeginning    'Beginning? 1 (Yes) or 0 (No)
    lclEar(lclTime).Continuation = lclContinuation  'Continuation? 1 (Yes) or 0 (No)
    lclEar(lclTime).UltimateTag = lclUltimateTag    'UltimateTag number to a concept.
    lclEar(lclTime).Source = lclSource  'Source: internal -, external +
        
    If lclUnknown = 32 Then
        lclBlankTime = lclTime
    End If
    
    'return to Sensorium
End Sub

'Comparator matches each phoneme agaisnt memory.
Sub Comparator()
    lclMoveTag = 0
    lclTimeDecrement = lclBlankTime
    lclTimeStringEffect = lclBlankTime
    
    For lclI = lclBlankTime To lclMidway Step -1
        DoEvents
        
        lclPhoneme = lclEar(lclI).Unknown
        
        If lclUnknown = lclPhoneme Then
            lclActivation = lclEar(lclI).Activation
            
            If lclEar(lclI).Beginning = 1 Then
                lclActivation = lclActivation + 8
            End If
            
            If lclActivation > 0 Then
                lclUltimateTag = lclEar(lclI).UltimateTag
            
                If lclUltimateTag > 0 Then
                    If lclEar(lclI).Continuation <> 1 Then
                        lclMoveTag = lclUltimateTag
                    End If
                    
                    lclEN(lclUltimateTag).Activation = 4    'increase Activation
                    lclUltimateTag = 0
                End If
                
                String_Effect
            End If
            
            lclActivation = 0
        End If
        
        lclTimeStringEffect = lclTimeStringEffect + 1
        lclTimeDecrement = lclTimeDecrement - 1
    Next
    
    'return to short term memory STM.
End Sub

'String-Effect helps recognize words and morphemes.
Sub String_Effect() 'increases Activation of next-in-line character
    lclTimeStringEffect = lclTimeDecrement + 1  'time (in) string-effect
    lclActivation = lclEar(lclTimeStringEffect).Activation + 8  'fetch Activation and increase by 8
    lclEar(lclTimeStringEffect).Activation = lclActivation  'store the higher Activation
    lclActivation = 0
    
    'return to Comparator
End Sub

'NewConcept deals with learning of new concepts.
Sub NewConcept()
    lclEnglishLexiconConceptNumber = lclEnglishLexiconConceptNumber + 1
    lclPreviousGrammarCategory = lclParse
    lclMoveTag = lclEnglishLexiconConceptNumber
    lclFiberIn = lclEnglishLexiconConceptNumber
    lclFiberOut = lclEnglishLexiconConceptNumber
    
    If lclParse = 3 Then
        lclGrammarCategory = 5
        lclActivation = 32
        lclNaturalLanguageProcessing = 5
        lclParse = 4
    End If
    
    If lclParse = 2 Then
        lclGrammarCategory = 8
        lclActivation = 32
        lclNaturalLanguageProcessing = 8
        lclParse = 3
    End If
    
    If lclParse = 1 Then
        lclGrammarCategory = 5
        lclActivation = 32
        lclNaturalLanguageProcessing = 5
        lclParse = 2
    End If
    
    Attach  'creates English node
    
    lclFiberIn = 0
    lclFiberOut = 0
    lclFiber = lclEnglishLexiconConceptNumber
    lclEnglishLexicon = lclEnglishLexiconConceptNumber
    
    Instantiate
    
    lclNaturalLanguageProcessing = 0    'reset
    
    For lclI = lclTime To lclMidway Step -1 'make EnglishLexiconConceptNumber Subsequent of its Previous concept.
        DoEvents
        
        If lclPSI(lclI).Fiber = lclPrevious Then
            lclPSI(lclI).Subsequent = lclEnglishLexiconConceptNumber
            
            Exit For
        End If
    Next
    
    lclPrevious = lclEnglishLexiconConceptNumber    'so that the next EnglishLexiconConceptNumber has a Previous
    
    If lclParse > 3 Then
        lclParse = 1
    End If
    
    lclActivation = 0
    
    'return to Retro
End Sub

'OldConcept deals with recognition of old concepts.
Sub OldConcept()
    If lclAttention = -1 Then
        lclActivation = 32
    Else
        lclActivation = 8
    End If
    
    If Val(lclParse) = 3 Then
        lclGrammarCategory = 5
        lclNaturalLanguageProcessing = 5
        lclParse = 4
    End If
    
    If lclParse = 2 Then
        lclGrammarCategory = 8
        lclNaturalLanguageProcessing = 8
        lclParse = 3
    End If
    
    If lclParse = 1 Then
        lclPrevious = 0
        lclGrammarCategory = 5
        lclNaturalLanguageProcessing = 5
        lclParse = 2
    End If
    
    For lclI = lclTime To lclMidway Step -1
        DoEvents
        
        If lclEN(lclI).MoveTag = lclMoveTag Then
            If lclEN(lclI).FiberIn > 0 Then
                lclFiberIn = lclEN(lclI).FiberIn
                
                Exit For
            End If
        End If
    Next
    
    Attach  'creates an English node
    
    If lclSpy > 50 Then
        Display_Message vbCrLf & Chr(9) & "OLDC: pre seq = " & lclPrevious & " " & lclSubsequent
    End If
    
    If lclAttention = -1 Then
        If lclSpy > 51 Then
            Display_Message Chr(9) & "mt from fin " & lclFiberIn
        End If
        
        lclMoveTag = lclFiberIn
    End If
    
    lclFiber = lclMoveTag
    lclEnglishLexicon = lclMoveTag
    
    Instantiate
    
    lclNaturalLanguageProcessing = 0
    lclUnknown = lclPrevious
    
    Activate
    
    lclPrevious = lclUnknown
    lclUnknown = 0
    
    'the next line stores Subsequent retroactively:
    For lclI = lclTime To lclMidway Step -1
        DoEvents
        
        If lclPSI(lclI).Fiber = lclPrevious Then
            lclPSI(lclI).Subsequent = lclMoveTag
            
            Exit For
        End If
    Next
    
    lclPrevious = lclMoveTag    'for next EnglishLexiconConceptNumber
    
    If lclParse > 3 Then
        lclPrevious = 0
        lclParse = 1
    End If
    
    lclActivation = 0
    
    'return to Retro
End Sub

'Attach creates a node on a lexicon array item.
Sub Attach()
    lclEN(lclTime).MoveTag = lclMoveTag 'concept number EnglishLexiconConceptNumber
    'lclEN(lclTime).Activation = 0  'do not store the Activation level; it is a transient.
    lclEN(lclTime).GrammarCategory = lclGrammarCategory 'store the grammar category.
    lclEN(lclTime).FiberIn = lclFiberIn 'store mindcore IN tag.
    lclEN(lclTime).FiberOut = lclFiberOut   'store mindcore EXIT tag.
    lclEN(lclTime).RecallVector = lclRecallVector   'store the recall vector
    
    If lclSpy > 51 Then
        Display_Message vbCrLf & Chr(9) & "Attach " & lclTime & " : "
        Display_Message lclEN(lclTime).MoveTag & " "
        Display_Message lclEN(lclTime).Activation & " "
        Display_Message lclEN(lclTime).GrammarCategory & " = rv to '"
        
        lclActivation = lclRecallVector
        
        For lclI = 1 To 40
            DoEvents
            
            Display_Message lclEar(lclActivation).Unknown
            
            If lclEar(lclActivation).Continuation = 0 Then
                Exit For
            End If
            
            lclActivation = lclActivation + 1
        Next
        
        lclActivation = 0
        
        Display_Message "'" & vbCrLf
        Display_Message Chr(9) & "Attach t: nen a g fin fex rv "
    End If
    
    'return to OldConcept or to NewConcept
End Sub

'Instantiate creates a concept node with tags.
Sub Instantiate()
    lclPSI(lclTime).Fiber = lclFiber    'concept Fiber
    lclPSI(lclTime).Activation = lclPSI(lclTime).Activation + lclActivation 'set Activation level.
    lclPSI(lclTime).Previous = lclPrevious  'store Previous associand
    lclPSI(lclTime).EnglishLexicon = lclEnglishLexicon  'store the EN-transfer tag.
    lclPSI(lclTime).Subsequent = lclSubsequent  'store the Subsequent tag.
    lclPSI(lclTime).NaturalLanguageProcessing = lclNaturalLanguageProcessing    'store functional NaturalLanguageProcessing code.
    
    If lclSpy > 50 Then
        Display_Message vbCrLf & Chr(9) & "Instantiate t : f a pre ukx seq nlp "
        Display_Message vbCrLf & Chr(9) & "Instantiate " & lclTime & " "