alife.ctl

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

        Display_Message lclPSI(lclTime).Fiber & " "
        Display_Message lclPSI(lclTime).Activation & " "
        Display_Message lclPSI(lclTime).Previous & " "
        Display_Message lclPSI(lclTime).EnglishLexicon & " "
        Display_Message lclPSI(lclTime).Subsequent & " "
        Display_Message lclPSI(lclTime).NaturalLanguageProcessing & vbCrLf
    End If
    
    lclFiber = 0
    lclEnglishLexicon = 0
    lclSubsequent = 0
    lclNaturalLanguageProcessing = 0    'reset for safety
    
    'return to OldConcept or to NewConcept
End Sub

'Activates recent nodes of a given concept
Sub Activate()
    If lclSpy > 50 Then
        Display_Message vbCrLf & Chr(9) & "Activate: pre seq = " & lclPrevious & " " & lclSubsequent & vbCrLf
        Display_Message vbCrLf & Chr(9) & "Activate: mt = " & lclMoveTag & " at t = " & lclTime
    End If
    
    'the use of NotLaterThan will now permit this module
    'to give higher activations to old concepts than to input.
    For lclI = lclNoLaterThan To lclMidway Step -1  'loop backwards to midway
        DoEvents
        
        If lclPSI(lclI).Fiber = lclMoveTag Then 'a node of the movetag?
            If lclAttention = -1 Then   'during Attention mode...
                lclPSI(lclI).Activation = 20    'increase the Activation
            Else
                lclPSI(lclI).Activation = 8
            End If
            
            lclPrevious = lclPSI(lclI).Previous
            lclSubsequent = lclPSI(lclI).Subsequent
            
            SpreadAct
            
            lclPrevious = 0
            lclSubsequent = 0
            lclActivation = 0
        End If
    Next
    
    lclActivation = 0
    
    If lclSpy > 50 Then
        Display_Message vbCrLf
    End If
    
    'return to OldConcept, Transformation.
End Sub

'SpreadAct spreads activation among concepts
'follows the Previous and Subsequent tags to find related concepts
Sub SpreadAct()
    For lclI = lclTime + 1 To lclMidway Step -1 'loop backwards to midway
        DoEvents
        
        If lclPrevious > 0 Then
            If lclPSI(lclI).Fiber = lclPrevious Then
                If lclAttention = -1 Then
                    lclPSI(lclI).Activation = lclPSI(lclI).Activation + 30
                Else
                    lclPSI(lclI).Activation = lclPSI(lclI).Activation + 24
                End If
            End If
        End If
        
        If lclSubsequent > 0 Then
            If lclPSI(lclI).Fiber = lclSubsequent Then
                If lclAttention = -1 Then
                    lclPSI(lclI).Activation = lclPSI(lclI).Activation + 10
                Else
                    lclPSI(lclI).Activation = lclPSI(lclI).Activation + 7
                End If
            End If
        End If
    Next
    
    'return to Activate
End Sub

'Echo displays the auditory memory channel.
Public Sub Display_Echo()
    Display_Message vbCrLf & "Echo"
    
    For lclI = lclTimeOfVoice To lclTime + 1
        DoEvents
        
        If lclEar(lclI).Unknown < 33 Then
            Display_Message vbCrLf
        Else
            Display_Message Chr(lclEar(lclI).Unknown)
        End If
    Next

    'return to HCI, Autonomy
End Sub

'Ear displays the auditory memory channel.
Public Sub Display_Ear()
    Display_Message vbCrLf & "Ear"
    Display_Message vbCrLf & "t" & Chr(9) & "ph" & Chr(9) & "a" & Chr(9) & "bg" & Chr(9) & "c" & Chr(9) & "u" & Chr(9) & "s" & vbCrLf
    
    'todo: following line 0 = lclTime -20
    For lclI = 0 To lclTime + 1  'show the last 20 phonemes
        DoEvents
        
        Display_Message vbCrLf & lclI & Chr(9)
        
        If lclEar(lclI).Unknown < 33 Then
            Display_Message " "
        Else
            Display_Message Chr(lclEar(lclI).Unknown) & Chr(9)
            Display_Message lclEar(lclI).Activation & Chr(9)
            Display_Message lclEar(lclI).Beginning & Chr(9)
            Display_Message lclEar(lclI).Continuation & Chr(9)
            Display_Message lclEar(lclI).UltimateTag & Chr(9)
            Display_Message Chr(lclEar(lclI).Source) & Chr(9)
        End If
    Next
    
    'called by user or programmer
End Sub

'EN displays the English lexicon array
Public Sub Display_EN()
    Display_Message vbCrLf & "EN"
    Display_Message vbCrLf & "t" & Chr(9) & "nen" & Chr(9) & "a" & Chr(9) & "g" & Chr(9) & "fin" & Chr(9) & "fex" & Chr(9) & "rv" & Chr(9) & "to" & vbCrLf

    'todo: following line 0 = Midway
    For lclI = 0 To lclTime + 1
        DoEvents
        
        lclUnknown = lclEN(lclI).MoveTag
        
        If lclUnknown > 0 Then  'display positive data
            Display_Message lclI & Chr(9) & lclUnknown & Chr(9)
            Display_Message lclEN(lclI).Activation & Chr(9)
            Display_Message lclEN(lclI).GrammarCategory & Chr(9)
            Display_Message lclEN(lclI).FiberIn & Chr(9)
            Display_Message lclEN(lclI).FiberOut & Chr(9)
            
            lclRecallVector = lclEN(lclI).RecallVector
            
            Display_Message lclRecallVector & Chr(9)
            
            While lclEar(lclRecallVector).Unknown <> 0
                DoEvents
                
                Display_Message Chr(lclEar(lclRecallVector).Unknown)
                
                lclRecallVector = lclRecallVector + 1
            Wend
            
            Display_Message vbCrLf
            
            lclRecallVector = 0
        End If
    Next
    
    lclUnknown = 0
    
    'called by user or programmer
End Sub

'PSI displays the contents of the deep mindcore PSI
Public Sub Display_PSI()
    Dim lclI_2 As Integer
    
    Display_Message vbCrLf & "Mindcore concepts and flags:" & vbCrLf
    Display_Message " t" & Chr(9) & "f" & Chr(9) & "a" & Chr(9) & "pre" & Chr(9) & "enx" & Chr(9) & "seq" & Chr(9) & "nlp" & Chr(9) & "to" & vbCrLf
    
    'todo following line 0 = Midway
    For lclI = 0 To lclTime + 1 'look as far back as Midway
        DoEvents
        
        If lclPSI(lclI).Fiber > 0 Then
            Display_Message vbCrLf & lclI & Chr(9)
            Display_Message lclPSI(lclI).Fiber & Chr(9)
            Display_Message lclPSI(lclI).Activation & Chr(9)
            Display_Message lclPSI(lclI).Previous & Chr(9)
            
            lclEnglishLexicon = lclPSI(lclI).EnglishLexicon
            
            Display_Message lclEnglishLexicon & Chr(9)
            Display_Message lclPSI(lclI).Subsequent & Chr(9)
            Display_Message lclPSI(lclI).NaturalLanguageProcessing & Chr(9)
            
            If lclEnglishLexicon > 0 Then
                lclUnknown = lclI
                lclRecallVector = 0
                
                For lclI_2 = lclUnknown To lclMidway Step -1
                    DoEvents
                    
                    If lclEN(lclI_2).MoveTag = lclEnglishLexicon Then
                        lclRecallVector = lclEN(lclI_2).RecallVector
                        
                        If lclRecallVector <> 0 Then
                            While lclEar(lclRecallVector).Unknown <> 0
                                DoEvents
                                
                                Display_Message Chr(lclEar(lclRecallVector).Unknown)
                                
                                lclRecallVector = lclRecallVector + 1
                            Wend
                            
                            lclRecallVector = 0
                                
                            Exit For    'one engrammed word is enough
                        End If
                    End If
                Next
            End If
        End If
    Next
    
    lclUnknown = 0
    
    'to be called by user or by diagnostics
End Sub

'Damping functions
Sub Obj_Damp()
    Dim lclI_2 As Integer
    
    For lclI = lclNotLaterThan To lclMidway Step -1
        DoEvents
        
        If lclPSI(lclI).Fiber = lclBestWord Then
            lclConcept = lclPSI(lclI).Subsequent
            
            For lclI_2 = lclNotLaterThan To lclMidway Step -1
                DoEvents
                
                If lclPSI(lclI_2).Fiber = lclConcept Then
                    If lclPSI(lclI_2).Activation > 32 Then
                        lclPSI(lclI_2).Activation = 32
                    End If
                End If
            Next
        End If
    Next
    
    'return to Predicate
End Sub

'Damping functions
Sub Subj_Damp()
    Dim lclI_2 As Integer
    
    For lclI = lclNotLaterThan To lclMidway Step -1
        DoEvents
        
        If lclPSI(lclI).Fiber = lclBestWord Then
            lclConcept = lclPSI(lclI).Previous
            
            For lclI_2 = lclNotLaterThan To lclMidway Step -1
                DoEvents
                
                If lclPSI(lclI_2).Fiber = lclConcept Then
                    If lclPSI(lclI_2).Activation > 30 Then
                        lclPSI(lclI_2).Activation = 30
                    End If
                End If
            Next
        End If
    Next
    
    'return to Predicate
End Sub

'Damping functions
Sub Ear_Damp()
    For lclI = lclTime To lclMidway Step -1
        DoEvents
        
        lclEar(lclI).Activation = 0
    Next
    
    'return to Sensorium
End Sub

'Damping functions
Sub EN_Damp()
    For lclI = lclTime To lclMidway Step -1
        DoEvents
        
        lclEN(lclI).Activation = 0
    Next
    
    If lclSpy > 50 Then
        Display_Message vbCrLf
    End If
    
    'return to Noun-Phrase, Predicate
End Sub

'Damping functions
Sub PSI_Damp()
    If lclSpy > 50 Then
        Display_Message vbCrLf & Chr(9) & "PSI-Damp: pre-damp a = " & lclActivation & " ; t = " & lclTime & " ; nlt = " & lclNotLaterThan & " and meme = " & lclConcept & vbCrLf
    End If
    
    For lclI = lclTime To lclMidway Step -1 'cycle backwards through time.
        DoEvents
        
        If lclPSI(lclI).Fiber = lclConcept Then     'look for Concept...
            lclPSI(lclI).Activation = 0  'dampen to zero
        End If
    Next
End Sub

Sub Tabularasa()
    For lclI = 0 To 1023
        DoEvents
        
        lclPSI(lclI).Fiber = 0
        lclPSI(lclI).Activation = 0
        lclPSI(lclI).Previous = 0
        lclPSI(lclI).EnglishLexicon = 0
        lclPSI(lclI).Subsequent = 0
        lclPSI(lclI).NaturalLanguageProcessing = 0
        
        lclEN(lclI).MoveTag = 0
        lclEN(lclI).Activation = 0
        lclEN(lclI).GrammarCategory = 0
        lclEN(lclI).FiberIn = 0
        lclEN(lclI).FiberOut = 0
        lclEN(lclI).RecallVector = 0
        
        lclEar(lclI).Unknown = 0
        lclEar(lclI).Activation = 0
        lclEar(lclI).Beginning = 0
        lclEar(lclI).Continuation = 0
        lclEar(lclI).UltimateTag = 0
        lclEar(lclI).Source = 0
    Next
    
    'return to ALife
End Sub

'Decay and other erasures to clear memory
Sub Decay()
    For lclI = lclNotLaterThan To lclMidway Step -1
        DoEvents
        
        If lclPSI(lclI).Activation > 21 Then    'if Activation is more than 21
            lclPSI(lclI).Activation = 16    'cap preterites at 16
        End If
    
        If lclPSI(lclI).Activation > 0 Then 'if Activation is more than zero
            lclPSI(lclI).Activation = lclPSI(lclI).Activation - 1   'let Activation decay by minus one
        End If
    Next
    
    If lclSpy = 50 Then
        Display_Message " D: nlt = " & lclNotLaterThan
    End If
    
    'return to ALife main program loop.
End Sub

'Set_Defaults sets initial defaults that Mind.Forth did in declaration
Sub Set_Defaults()
    lclAttention = 0
    lclBeginning = 1
    lclBig = 1024
    lclBlankTime = 0
    lclGrammarCategory = 1
    lclMoveTag = 0
    lclEnglishLexiconConceptNumber = 0
    lclNotLaterThan = 0
    lclParse = 1
    lclSpy = 48
    lclTime = 0
    lclUltimateTag = 0
    
    ReDim lclEar(lclBig)
    ReDim lclPSI(lclBig)
    ReDim lclEN(lclBig)
End Sub

Private Sub txtInput_KeyPress(KeyAscii As Integer)
    txtAscii = KeyAscii

    If KeyAscii = Asc(vbCrLf) Then
        txtInput.Tag = txtInput.Text
        
        txtInput.Text = ""
        
        If Not lclRunning Then
            HCI
        End If
    End If
End Sub

Public Sub Display_Message(sMessage As Variant)
    dspHCI.SelText = sMessage
    dspHCI.SelStart = Len(dspHCI.Text) + 1
End Sub

Function Get_Key() As Integer
    If Len(txtInput.Tag) > 0 Then
        Get_Key = Asc(Mid(txtInput.Tag, 1, 1))
        
        txtInput.Tag = Mid(txtInput.Tag, 2, Len(txtInput.Tag) - 1)
    Else
        Get_Key = Asc(vbCrLf)
    End If
End Function

Public Sub Display_About()
    Display_Message vbCrLf & vbCrLf & "Mind.VB ver 1.0" & vbCrLf & _
        vbCrLf & "Translated by:" & _
        vbCrLf & Chr(9) & "Rick Boardman" & _
        vbCrLf & Chr(9) & "http://www.NetBotics.com" & _
        vbCrLf & Chr(9) & "[e-mail]"
    
    Display_Message vbCrLf & vbCrLf & "About the translation:" & _
        vbCrLf & Chr(9) & "This program is a translation from Mind.Forth" & _
        vbCrLf & Chr(9) & "I have tried to keep the translation as pure" & _
        vbCrLf & Chr(9) & "as possible for the initial release of Mind.VB"
        
    Display_Message vbCrLf & vbCrLf & "Translated version:" & _
        vbCrLf & Chr(9) & "Translation from Forth code release 1feb2Ka.f" & _
        vbCrLf & Chr(9) & "http://www.geocities.com/Athens/Agora/7256/mind4th.html"
    
    Display_Message vbCrLf & vbCrLf & "Credits:" & _
        vbCrLf & Chr(9) & "Original concepts and Forth code are credited to" & _
        vbCrLf & Chr(9) & "Arthur T Murray with contributions from" & _
        vbCrLf & Chr(9) & "Jeff Fox" & _
        vbCrLf & vbCrLf & Chr(9) & "Special thanks goes out to all those who helped" & _
        vbCrLf & Chr(9) & "a Forth newbie at comp.lang.forth"
End Sub

Public Sub Display_Help()
    Display_Message vbCrLf & vbCrLf & "Help on interaction with Mind.VB" & _
        vbCrLf & Chr(9) & "To talk with the AI use the following syntax:" & _
        vbCrLf & Chr(9) & "<subject> <space> <transitive verb> <space> <object> <enter>"

    Display_Message vbCrLf & "Commands start with a dot <.>" & _
        vbCrLf & Chr(9) & ".About" & Chr(9) & "(show information about the Mind.VB program)" & _
        vbCrLf & Chr(9) & ".Help" & Chr(9) & "(show this text)" & _
        vbCrLf & Chr(9) & ".Life" & Chr(9) & "(start the AI)" & _
        vbCrLf & Chr(9) & ".Spy x" & Chr(9) & "(choose diagnostic level 1 thru 9)" & _
        vbCrLf & Chr(9) & ".Echo" & Chr(9) & "(show the latest AI response)" & _
        vbCrLf & Chr(9) & ".Ear" & Chr(9) & "(show sample of the Auditory memory)" & _
        vbCrLf & Chr(9) & ".EN" & Chr(9) & "(show sample of the Lexicon stream)" & _
        vbCrLf & Chr(9) & ".PSI" & Chr(9) & "(show sample of the Mindcore concept stream)" & _
        vbCrLf & Chr(9) & ".Kill" & Chr(9) & "(terminate the AI)"
End Sub