Open Source Chat Robot program Qrobot (Quickrobot)

It was written before. Originally intended to write open source class library, but in the C # transplant when found a big problem, mainly when the robot answered the execution efficiency is too slow, and I do not have any good improvement methods, so I decided to this program code all open, complete code download please go to:

Vb. NET Edition: http://download.csdn.net/detail/qinyuanpei/5561585

C # Portable version (incomplete): http://download.csdn.net/detail/qinyuanpei/5561619

Imports System Imports System.Xml Imports Lucene.Net.Analysis Imports System.Text Imports System.Net Imports System.IO  Public Class Chat Public Xmlpath As String ' Corpus data path public username As String ' user name public robotname as String ' Robot name Dim myvoice As Object ' Create speech options Dim Systime As String Dim A As String Dim Q As String '    Public WithEvents RC as New Speechlib.spsharedrecocontext Dim lastq As String ' for recording the previous problem Dim Besta as String  ' Used to record learning answers Dim lasta As String ' to determine the answer to the previous question Dim cmdlist As New ArrayList ' load predefined command list public istalkwithsound As Boolean the variable public issoundrecognition as Boolean ' used to determine whether speech-reading is enabled is used to determine whether speech recognition is enabled for variable public ismsgwithsound as Boolea 
        N ' is used to determine whether to turn on message beep Dim point as ' Move for form ' dialog process Cmdtalk Private Sub cmdtalk_click () Handles Cmdtalk.click Q = txtq. Text systime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" & DateTime.Now.Second T Xtans.Text = Txtans. Text & vbNewLine & vbnewline & Systime & Space (2) & "" & Username & "" & "said:" & Vbne Wline & Q playmusic () a = Response (q) ' begins to match the core part of the answer Txtans. Text = Txtans. Text & vbNewLine & vbnewline & Systime & Space (2) & "" & Robotname & "" & "said:" & VbN Ewline & A Txtans. SelectionStart = Len (Txtans. Text & vbnewline & vbnewline) ' Select the insertion point to empty space for the following text Txtans. Scrolltocaret () ' Scroll bar scrolling start ' automatic learning start () LASTQ = Q ' record the contents of the previous question Lasta = A ' to record the answer to the previous question If xpatht oXML (LASTQ) = 0 and Lasta <> "Lily doesn't know how to answer" Then Addnewknowledge (LASTQ, Lasta) end If TXTQ. Text = "End Sub" page initializes the main function Private Sub Form1_Load (ByVal sender as Object, ByVal e as System.EventArgs) Hand Les me.load Randomize () loadcmd () ' Load command list istalkwithsound = False Issoundrecognition = Fal SE username = "I" Robotname = "Lily" Systime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" ; DateTime.Now.Second Txtans. Text = Txtans. Text & Systime & Space (2) & "" & Robotname & "" & "said:" & vbNewLine & "friend, Hello, I am based on Alice's intelligence Chat robot, my name is Lily "Txtans." Select (Len (Txtans). Text), 0) ' Talkwithsound (username &), Hello, I'm based on Alice's intelligent chat robot, my name is lily, what can I do for you?
        ") ' Soundrecognition () End Sub ' load preset command Private Sub loadcmd () Dim xmldoc as New XmlDocument XmlDoc. Load (Application.startuppath & "\aiml\cmd.xml") Dim nodelist As XmlNodeList Dim root As XmlElement = X Mldoc. DocumentElement nodelist = root. SelectNodes ("/cmdlist/cmd") Dim A As String = "" Dim node as XmlNode = Nothing for each node in no Delist Cmdlist.add (node. innertext) Next end Sub ' participle module, relatively simple, did not expect the effect of the Chinese Academy of Sciences so poor public Function splitwords (ByVal input as StRing) as String Dim SB as New StringBuilder () sb. Remove (0, sb.) Length) Dim T1 As String = "" Dim i as Integer = 0 Dim Analyzer = New Lucene.Net.Analysis.China.Ch Ineseanalyzer Dim sr As New StringReader (input) Dim stream As Tokenstream stream = Analyzer. Tokenstream ("", sr) Dim t as Token = stream. Next () while t's nothing = False T1 = t.tostring () t1 = t1. Replace ("(", "") sb. Append (I & ":" & "(" & T1) T = stream. Next () i + = 1 End While splitwords = sb. ToString () End Function ' Robot response function Response Public function Response (ByVal str As String) As String ' here refers to
        All the command function format is: "Function name: parameter One | parameter two | parameter three ..." Response = "" If InStr (str, ":") > 0 Then Dim cmdstr as String = str. Substring (0, str. IndexOf (":")) Dim optionstr as String = str. Substring (str. IndexOf (":") + 1, str. Length-str. IndexOf (":")-1) if Cmdlist.contains (cmdstr) Then ' handles special command characters first, then handles general sessions, before processing needs to determine if there is a command flag ":" S
                    Elect case cmdstr Case "weather" Response = Plugin_weather (OPTIONSTR)
                        Case "search" Response = Plugin_search (optionstr) case "translation" Response = plugin_translate (optionstr) case "map" Response = Plugin_ma
                        P () case "encyclopedia" Response = plugin_baike () case "mathematics" Response = Plugin_math (optionstr) End Select end If Else I F xpathtoxml (str) > 0 Then ' locally find data that satisfies the fuzzy criteria Response = Getlocaldata (Xpathtoxml (str)-1) El
    Se Response = getwebdata (str) End If End If-Response end Function '-----------------------------------------------------'-----------------------------------------------------'----------This is used to extend program functionality. Plugin--------------'-----------------------------------------------------'----------------------------------------
        -------------Function plugin_translate (ByVal Q As String) As String Dim Translate as New youdaotranslate return translate. Dotranslate (q) End Function function Plugin_weather (ByVal City As String) as String d function function Plugin_search (ByVal keywords As string) as String browser. Show () browser.
    WebBrowser1.Navigate ("http://www.baidu.com/s?wd=" + keywords) return "Lily has completed the" + "[" + keywords + "]" + "search" End Function function Plugin_math (ByVal expression as String) As String Dim Scriptclass as New Msscriptcontro
        L.scriptcontrol Scriptclass.language = "javascript" Dim obj as Object = scriptclass.eval (expression) Return EXpression + "=" + obj.
        ToString () End Function function Plugin_map () return "" End Function function Plugin_baike () Return "" The End Function '-----------------------------------------------------'-------------------------- ---------------------------' The code for the---------------plug-in section ends here----------------'---------------------------------------- -------------
    '-----------------------------------------------------




    '---------------------------------------- -------------'-----------------------------------------------------'---------here is a program for getting chat data from the network----------'-- ---------------------------------------------------'-----------------------------------------------------' obtained from the Internet Fetch data Function getwebdata (ByVal str As String) As String Dim WebBot As New Simsimi Dim cookie As String
        = Webbot.getcookie () If webbot.showmsg (str, cookie) = "{}" Then return "Lily is tired, rest for a while ..."
    Else        return webbot.showmsg (str, cookies) End If end Function '---------------------------------------- -------------'-----------------------------------------------------'-----------------------over------------------ --------
    '-----------------------------------------------------
    '------------------------------------------------ -----


    '-----------------------------------------------------
    '-------------------------------------------------- ---'-------------------Local data search Module------------------'-----------------------------------------------------'--- --------------------------------------------------' A fuzzy match based on XPath that returns the data that satisfies the requirement-Problem index public Function xpathtoxml (ByVal s TR as String) As Integer Dim indexlist As New ArrayList ' to save the index list that satisfies the matching criteria Dim pos As Integer Dim i As Integer = 0 Dim xmldoc1 as New XmlDocument Xmldoc1. Load (Application.startuppath & "\aiml\aiml.xml") Dim NodeList as XMlnodelist Dim root as XmlElement = Xmldoc1. DocumentElement nodelist = root.  SelectNodes ("/aiml/talk/question") Dim node as XmlNode = Nothing for each node in NodeList Dim Q as String = node.
                InnerText i = i + 1 if str = q Or InStr (Splitwords (str), q) > 0 Then ' Save the current index to indexlist if the condition is met
            Indexlist.add (i) End If Next if Indexlist.count = 0 Then ' If the list does not meet the required index pos = 0 Else pos = indexlist (Int (Rnd () * (indexlist.count)) ' Otherwise returns the random index value in the index list, plus 1 to avoid 1 errors, so Causes the answer index to be 0 if pos = 1 Then pos = pos + 1 ' to avoid situations where the answer index is 0 due to random numbers. End If return POS end Func tion ' Get data for local specified index-answer public Function getlocaldata (ByVal Index As Integer) as String Dim pos As Integer = 0 Dim Xmldoc1 as New XmlDocument Xmldoc1. Load (Application.startuppath & "\aiml\aiml.xml") Dim nodelist as XmlNodeList DiM root as XmlElement = Xmldoc1. DocumentElement nodelist = root. SelectNodes ("/aiml/talk/answer") Dim A As String = "" Dim node as XmlNode = Nothing for each node In NodeList A = node.
        InnerText pos = pos + 1 if pos > Index Then Exit for End If Next return A-end Function '-----------------------------------------------------'------------------ -----------------------------------'---------------The local Data search module ends------------------'------------------------------- ----------------------
    '-----------------------------------------------------

    '********************************** *******************

    '-----------------------------------------------------
    '------------------------------------- ----------------'---------------machine learning part of the function module------------------'-------------------------------------------------- ---
    '-----------------------------------------------------' Add new knowledge to XML Archive public Function Addnewknowledge (ByVal q As String, ByVal A As String) Dim XmlDoc as New XmlDocument xmldoc. Load (Application.startuppath & "\aiml\aiml.xml") Dim node as XmlNode = xmldoc. CreateNode (Xml.XmlNodeType.Element, "Talk", "") xmldoc. Documentelement.appendchild (node) Dim node1 as XmlNode = xmldoc. CreateNode (Xml.XmlNodeType.Element, "question", "") Node1. innertext = q node. AppendChild (Node1) Dim node2 as XmlNode = xmldoc. CreateNode (Xml.XmlNodeType.Element, "answer", "") Node2. InnerText = a node. AppendChild (Node2) xmldoc.  Save (Application.startuppath & "\aiml\aiml.xml") return the Nothing End Function ' automatically learn the main function Private Sub Autostudy (ByVal str As String, ByVal answer as String) end Sub ' processing function for Word segmentation results ' Here's a bug, no access to system function get Splitwords (ByVal splitstr As String, ByVal Orangestr as String) as String Dim splitwoRDS as New ArrayList ' for storing the processing of Word segmentation results Dim encodestart As Integer = 1 Dim encodeend As Integer = 1 Dim
            J As Integer = 0 do dim s1 As Integer = Encodestart Dim e1 As Integer = Encodeend Encodestart = InStr (S1 + 1, Splitstr, "((") Encodeend = INSTR (e1 + 1, SPLITSTR, ")") Dim Temp str as String = Mid (splitstr, Encodestart + 1, encodeend-encodestart) Splitwords.add (tempstr. Substring (1, Splitstr.indexof (",")-2 + 1)) J = j + 1 Loop while Encodeend < Len (SPLITSTR) and ENC Odestart < Len (SPLITSTR) ' Here has got all the word segmentation results and stored separately ' start the probability calculation of the word segmentation Dim total As Integer = 0 Dim T_le Nth (splitwords.count) As Integer Dim t_location (Splitwords.count) As Integer Dim E_rank (Splitwords.count) As Double ' gets the position and length of each word segmentation result, and calculates the total probability for i as the Integer = 0 to Splitwords.count t_lenth (i) = S Plitwords (i). Length T_locatIon (i) = Orangestr.indexof (Splitwords (i)) total = Total + t_lenth (i) * t_location (i) Next ' calculates every
        Probability of a word segmentation result for i = 0 to Splitwords.count e_rank (i) = T_lenth (i) * t_location (i)/Total Next ' Choose the maximum probability of Word segmentation results System.Array.Sort (E_rank) return to Nothing End Function '------------------------ -----------------------------'-----------------------------------------------------'---------------machine learning part of the function ends-- ----------------
    '-----------------------------------------------------
    '---------------------------------------- -------------




    '-----------------------------------------------------
    '----------------------------------------
    -------------'--------------The following is part of the optional module code-----------------'----------------------------------------------------- '-----------------------------------------------------Private Sub-Dictionary set Toolstripmenuitem_click (sender as System.obj ECT, E as System.EventArgsHandles Dictionary setting Toolstripmenuitem.click dictionary.show () End Sub Private Sub txtq_keypress (sender as Objec T, e as System.Windows.Forms.KeyPressEventArgs) Handles TXTQ.  KeyPress End Sub ' Play message beep Private Sub playmusic () If ismsgwithsound = True Then Dim player As New System.Media.SoundPlayer player. Soundlocation = Application.startuppath & "\wav\msg.wav" player. Load () player. 
    Play () End If end Sub ' speech recognition ' Private Sub soundrecognition () ' If issoundrecognition = True Then ' Dim RG as Speechlib.ispeechrecogrammar ' RG = RC. Creategrammar (0) ' RG. Dictationload () ' RG. Dictationsetstate (1) ' Else ' is ' Exit sub ' End If ' End Sub ' voice listener ' Private Sub hears command (Byva  L Streamnumber as Integer, ByVal streamposition as Object, ByVal Recognitiontype as Speechlib.speechrecognitiontype, ByVal Discourse as Speechlib.ispeechrecoresuLT) Handles RC. Recognition ' TXTQ. Text = discourse. Phraseinfo.gettext () ' End Sub ' voice aloud ' Private Sub talkwithsound (ByVal str) ' If istalkwithsound = True T  Hen ' Myvoice = New speechlib.spvoice ' myvoice.speak (str) ' End If ' End Sub Private
        Sub Speech Options Toolstripmenuitem_click (sender as System.Object, E as System.EventArgs) Handles voice options Toolstripmenuitem.click Sound.show () End Sub Private Sub about Qrobottoolstripmenuitem_click (sender as System.Object, E as System.eventarg s) Handles about Qrobottoolstripmenuitem.click.
 Show () End Sub End Class