alife.ctl

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

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.UserControl ALife 
   BackStyle       =   0  'Transparent
   ClientHeight    =   4500
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7500
   ScaleHeight     =   300
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   500
   Begin VB.TextBox txtInput 
      BackColor       =   &H00FFFFFF&
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Top             =   4080
      Width           =   7215
   End
   Begin RichTextLib.RichTextBox dspHCI 
      Height          =   3855
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   6800
      _Version        =   393217
      BackColor       =   14737632
      ReadOnly        =   -1  'True
      ScrollBars      =   3
      RightMargin     =   12000
      TextRTF         =   $"ALife.ctx":0000
   End
End
Attribute VB_Name = "ALife"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'Mind.VB
'
'Translated by:
'   Rick Boardman
'   http://www.NetBotics.com
'   [e-mail]
'
'About the translation:
'   This program is a translation from Mind.Forth
'   I have tried to keep the translation as pure
'   as possible for the initial release of Mind.VB
'
'Translated version:
'   Translation from Forth code release 1feb2Ka.f
'   http://www.geocities.com/Athens/Agora/7256/mind4th.html
'
'Credits:
'   Original concepts and Forth code are credited to
'   Arthur T Murray with contributions from
'   Jeff Fox
'
'   Special thanks goes out to all those who helped
'   a Forth newbie at comp.lang.forth
'

'Declare public variables
Dim lclActivation As Integer
Dim lclAttention As Integer
Dim lclBeginning As Integer
Dim lclBig As Integer
Dim lclBlankTime As Integer
Dim lclContinuation As Integer
Dim lclEnglishLexicon As Integer
Dim lclEndOfText As Integer
Dim lclFiber As Integer
Dim lclFiberOut As Integer
Dim lclFiberIn As Integer
Dim lclGrammarCategory As Integer
Dim lclHits As Integer
Dim lclIndex As Integer
Dim lclLength As Integer
Dim lclConcept As Integer
Dim lclMidway As Integer
Dim lclBestWord As Integer
Dim lclMoveTag As Integer
Dim lclEnglishLexiconConceptNumber As Integer
Dim lclNaturalLanguageProcessing As Integer
Dim lclNotLaterThan As Integer
Dim lclOnset As Integer
Dim lclOption As Integer
Dim lclParse As Integer
Dim lclPhoneme As Integer
Dim lclPartOfSpeech As Integer
Dim lclPrevious As Integer
Dim lclPreviousGrammarCategory As Integer
Dim lclQuota As Integer
Dim lclRecallVector As Integer
Dim lclSource As Integer
Dim lclSubsequent As Integer
Dim lclSpy As Integer
Dim lclTime As Integer
Dim lclTimeDecrement As Integer
Dim lclTimeStringEffect As Integer
Dim lclTimeUltimate As Integer
Dim lclTimveOfVoice As Integer
Dim lclUnknown As Integer
Dim lclUltimateTag As Integer
Dim lclRunning As Boolean   'flag to show if AI is running or not.

Type tEar   'Auditory memory channel array
    Unknown As Integer
    Activation As Integer
    Beginning As Integer
    Continuation As Integer
    UltimateTag As Integer
    Source As Integer
End Type

Type tPSI   'Primitive concept array
    Fiber As Integer
    Activation As Integer
    Previous As Integer
    EnglishLexicon As Integer
    Subsequent As Integer
    NaturalLanguageProcessing As Integer
End Type

Type tEN    'English lexicon
    MoveTag As Integer
    Activation As Integer
    GrammarCategory As Integer
    FiberIn As Integer
    FiberOut As Integer
    RecallVector As Integer
End Type

Dim lclEar() As tEar
Dim lclPSI() As tPSI
Dim lclEN() As tEN

Private Sub UserControl_Initialize()
    lclRunning = False
    
    Display_Message "Welcome to Mind.VB!" & vbCrLf
    Display_Message vbCrLf & "There is no warranty for what this software does."
    Display_Message vbCrLf & vbCrLf & "If this is your first time, enter .help"
End Sub

'ALife is the main program loop of Mind.VB AI.
Public Sub ALife()
    lclRunning = True
    
    Set_Defaults    'sets initial defaults that Mind.Forth did in declaration
    
    lclBlankTime = lclTime
    lclSpy = 49
    
    Display_Message vbCrLf & "(Clearing Memory...)"
        
    Tabularasa  'to erase all memory arrays
    Bootstrap   'to load some initial concepts
    
    Do
        DoEvents
        
        If lclTime > 200 Then
            lclMidway = lclTime - 200   'for a range limit on searches
        Else
            lclMidway = 0
        End If
        
        Decay
        Transformation  'to choose a Chomskyan syntactic structure
        Decay
        Autonomy    'for independent operation, if no input
        
        If lclAttention = -1 Then   'while in attention mode, do the following
            lclBlankTime = lclTime  'keep track of moment before input
            
            Display_Message vbCrLf
            
            lclSource = 43  'ascii 43 = "+" to designate "source" as external.
            
            Display_Message vbCrLf & "User:" & Chr(9)   'a prompt for the user to type in a sentence
                        
            lclParse = 1    'expect a noun or pronoun
            
            Sensorium   'for sensory input from the environment
            
        End If
        
        If lclRunning = False Then
            Display_Message vbCrLf & "Killed on command "
            
            Exit Do
        End If
        
        If lclTime > 999 Then
            Display_Message vbCrLf & "Program timed out at 999 "
                        
            Exit Do
        End If
    Loop
End Sub

'Autonomy is the auto-pilot mode of stand-alone AI.
Sub Autonomy()
    'Display_Message vbCrLf & vbCrLf & " Press TAB for user input, or ESC to quit:"
    
    For lclI = 1 To 75
        DoEvents
        
        'Display_Message "." 'display a series of dots....
        
        'lclUnknown = Get_Key
        
        'lclAttention = -1
        
        'If lclUnknown = 27 Then
        '    Display_Message vbCrLf & " Halt. "
        '
        '    End
        'End If
        
        'If lclUnknown = 9 Then
            'Display_Message vbCrLf & vbCrLf & " Autonomy: Interruption by user."
        If txtInput.Text <> "" Or txtInput.Tag <> "" Then
            HCI
            
            Exit For
        End If
    Next
    
    'Display_Message vbCrLf
    
    lclUnknown = 0
    
    'return to the main program loop ALife
End Sub

'HCI is the human-computer interface of VB.Forth AI.
Sub HCI()
    'lclUnknown = 0  'remove whatever value rode in here
    
    'If lclSpy > 49 Then
    '    Display_Echo    'after diagnostic blur, show I/O
    'End If
    
    'Display_Message vbCrLf & vbCrLf & " HCI: Please enter a diagnostic level from 1 to 9."
    'Display_Message vbCrLf & "  For instance, 1 (no diagnostics) or 2 (troubleshooting)."
    'Display_Message vbCrLf & "  Enter subject + transitive verb + object (no punctuation)."

    'lclUnknown = Get_Key
    
    'If lclUnknown = 27 Then
    '    Display_Message vbCrLf & " Halt."
    '
    '    End
    'End If
    
    While txtInput.Text <> ""
        DoEvents
    Wend
    
    If Mid(txtInput.Tag, 1, 1) = "." Then
        Select Case UCase(Mid(txtInput.Tag, 2, 2))
            Case "AB"
                Display_About
            Case "HE"
                Display_Help
            Case "LI"
                txtInput.Tag = ""
                
                ALife
            Case "SP"
                txtInput.Tag = Replace(UCase(txtInput.Tag), "SPY", "")
                
                lclSpy = Asc(Trim(txtInput.Tag))
            Case "EC"
                Display_Echo
            Case "EA"
                Display_Ear
            Case "EN"
                Display_EN
            Case "PS"
                Display_PSI
            Case "KI"
                lclAttention = 0
                lclRunning = False
        End Select
        
        txtInput.Tag = ""
    Else
        lclAttention = -1
    End If
    
    'lclSpy = lclUnknown

    'return to the Autonomy subroutine
End Sub

'Transformation calls a Chomskyan syntax structure.
Sub Transformation()
    Discriminate    'to pick and choose among active concepts
    
    'if no verb, push into Activate + SpreadAct to force a verb:
    
    lclMoveTag = lclConcept
    
    If lclNaturalLanguageProcessing <> 8 Then
        If lclSpy = 50 Then
            Display_Message "Xf. 1st call to Activate "
        End If
        
        lclAttention = -1
        
        SpreadAct
            
        lclMoveTag = 0
        lclAttention = 0
            
        Discriminate    'to search again
    End If
        
    lclMoveTag = lclConcept
    
    If lclNaturalLanguageProcessing <> 8 Then
        If lclSpy = 50 Then
            Display_Message "Xf. 2nd call to Activate "
        End If
        
        lclAttention = -1
        
        SpreadAct
        
        lclMoveTag = 0
        lclAttention = 0
        
        Discriminate    'to search again
    End If
    
    lclMoveTag = lclConcept
    
    'if the meme (concept) is an 8 (verb), run it through Activate + SpreadAct
    'in order to accentuate the activation of the subject:
    
    If lclNaturalLanguageProcessing = 8 Then    'if no verb on the 3rd try, never mind
        If lclSpy = 50 Then
            Display_Message "Xf. verb ! Call Activate "
        End If
        
        lclAttention = -1
        
        SpreadAct
        
        lclMoveTag = 0
        lclAttention = 0
    End If
    
    lclActivation = 0
    
    English 'that is, the syntactic structure of English
    
    'return to the main ALife loop
End Sub

'Discriminate "squeezes out" subjects, verbs, etc.
Sub Discriminate()
    If lclSpy = 50 Then
        Display_Message vbCrLf & "Discriminate: Active concept = "
    End If
    
    lclActivation = 0
    lclUnknown = 1
    
    For lclI = lclTime + 1 To lclMidway Step -1
        DoEvents
        
        If lclPSI(lclI).Activation > lclUnknown Then    'if psi Activation is larger...
            lclActivation = lclPSI(lclI).Activation '...hold the Activation level
            lclConcept = lclPSI(lclI).Fiber '...hold the meme (Concept)
            lclPrevious = lclPSI(lclI).Previous '...hold its Previous?
            lclSubsequent = lclPSI(lclI).Subsequent '...hold its Subsequent"
            lclNaturalLanguageProcessing = lclPSI(lclI).NaturalLanguageProcessing   '...hold its part-of-speech
        End If
        
        lclUnknown = lclActivation  'next use Activation as the higher standard
    Next    'with each loop, possibly find a higher Activation
    
    If lclSpy = 50 Then
        Display_Message lclConcept
    End If
    
    'return to Transformation
End Sub

'English is the syntax of an English sentence.
Sub English()
    If lclSpy = 50 Then
        Display_PSI
        
        'Display_Message " Press RETURN "
        '
        'Key
    End If
    
    lclAttention = 0    'turns off "attention" during reentry mode
    lclTimeOfVoice = lclTime    'store current "time" as time-of-voice for Display_Echo
    
    'the AI fills in the next line by generating a thought:
    Display_Message vbCrLf & "Robot:" & Chr(9)
    
    Subject 'finds "le mot jeste" (BestWord) to be the subject
    
    Predicate   'finds "le mot jeste" for verb and for object
    
    lclMoveTag = lclBestWord    'so that Retro will invoke OldConcept
    lclUnknown = 13 'ASCII 13 (CR) to trip a call of Retro
    
    Sensorium
    
    'return to the Transformation module.
End Sub

'Predicate assembles a phrase of verb plus object.
Sub Predicate()
    lclOptions = 8
    lclUnknown = 0
    lclMoveTag = 0
    lclBestWord = 0
    lclParse = 2
    
    FlushVector 'to move deep concepts up to English "EN()"
    
    If lclSpy > 50 Then
        Display_Message vbCrLf & Chr(9) & "Predicate: "
    End If
    
    For lclI = lclTime To lclMidway Step -1
        DoEvents
        
        If lclEN(lclI).Activation > 0 Then  'if EN Activation is positive
            lclActivation = lclEN(lclI).Activation  'then store the Activation level
            
            If lclEN(lclI).GrammarCategory = 8 Then 'a verb?
                If lclActivation > lclUnknown Then
                    lclMoveTag = lclEN(lclI).MoveTag    'move-tag of item
                    lclRecallVector = lclEN(lclI).RecallVector  'auditory recall-vector
                    lclUnknown = lclActivation  'to test for an even higher Activation
                    lclBestWord = lclMoveTag
                    
                    If lclSpy > 50 Then
                        Display_Message vbCrLf & Chr(9) & "Predicate: most active a " & lclActivation & " is for mt " & lclMoveTag & " with rv " & lclRecallVector
                    End If
                End If
            End If
        End If
    Next