开源聊天机器人程序QRobot（QuickRobot）
来源：互联网 发布：万网域名证书下载地址 编辑：程序博客网 时间：2024/06/06 17:19
之前写的，本来打算写成开源类库的，可是用C#移植的时候发现了很大的问题，主要是当机器人回答时执行效率太慢，而我又没有什么好的改进方法，所以我决定将此程序代码全部公开，完整代码下载请前往：
VB.NET版：http://download.csdn.net/detail/qinyuanpei/5561585
C#移植版（未完成）：http://download.csdn.net/detail/qinyuanpei/5561619
Imports SystemImports System.XmlImports Lucene.Net.AnalysisImports System.TextImports System.NetImports System.IOPublic Class chat Public XmlPath As String '语料数据路径 Public username As String '使用者名字 Public robotname As String '机器人名字 Dim myvoice As Object '创建语音选项 Dim systime As String Dim a As String Dim q As String ' Public WithEvents RC As New SpeechLib.SpSharedRecoContext Dim lastq As String '用于记录上一个问题 Dim besta As String '用于记录学习后的答案 Dim lasta As String '用于判断上一个问题的答案 Dim CmdList As New ArrayList '加载预定义命令列表 Public IsTalkWithSound As Boolean '用于判断是否启用语音朗读的变量 Public IsSoundRecognition As Boolean '用于判断是否启用语音识别的变量 Public IsMsgWithSound As Boolean '用于判断是否开启消息提示音 Dim Point As Point '用于窗体的移动 '对话过程Cmdtalk Private Sub Cmdtalk_Click() Handles Cmdtalk.Click q = txtq.Text systime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" & DateTime.Now.Second txtans.Text = txtans.Text & vbNewLine & vbNewLine & systime & Space(2) & "【" & username & "】" & "说:" & vbNewLine & q PlayMusic() a = Response(q) '开始匹配答案 核心部分 txtans.Text = txtans.Text & vbNewLine & vbNewLine & systime & Space(2) & "【" & robotname & "】" & "说:" & vbNewLine & a txtans.SelectionStart = Len(txtans.Text & vbNewLine & vbNewLine) '选择文本插入点，给下面的文字空出空间 txtans.ScrollToCaret() '滚动条滚动开始 '自动学习开始() lastq = q '记录前一个问题的内容 lasta = a '记录前一个问题的答案 If XpathToXml(lastq) = 0 And lasta <> "莉莉不知道怎样回答" Then AddNewKnowledge(lastq, lasta) End If txtq.Text = "" End Sub '页面初始化主函数 Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load Randomize() LoadCmd() '加载命令列表 IsTalkWithSound = False IsSoundRecognition = False username = "我" robotname = "莉莉" systime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" & DateTime.Now.Second txtans.Text = txtans.Text & systime & Space(2) & "【" & robotname & "】" & "说:" & vbNewLine & "朋友，你好，我是基于Alice的智能聊天机器人，我叫莉莉" txtans.Select(Len(txtans.Text), 0) 'TalkWithSound(username & "，你好，我是基于Alice的智能聊天机器人，我叫莉莉,我可以为您做些什么呢？") 'SoundRecognition() End Sub '加载预置命令 Private Sub LoadCmd() Dim xmldoc As New XmlDocument xmldoc.Load(Application.StartupPath & "\aiml\cmd.xml") Dim nodeList As XmlNodeList Dim root As XmlElement = xmldoc.DocumentElement nodeList = root.SelectNodes("/cmdlist/cmd") Dim a As String = "" Dim node As XmlNode = Nothing For Each node In nodeList CmdList.Add(node.InnerText) Next End Sub '分词模块，比较简单，没想到中科院的效果那么差 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.ChineseAnalyzer Dim sr As New StringReader(input) Dim stream As TokenStream stream = analyzer.TokenStream("", sr) Dim t As Token = stream.Next() While t Is Nothing = False t1 = t.ToString() t1 = t1.Replace("(", "") sb.Append(i & ":" & "(" & t1) t = stream.Next() i += 1 End While SplitWords = sb.ToString() End Function '机器人反应函数Response Public Function Response(ByVal str As String) As String '这里指定所有的命令函数格式为：“函数名：参数一|参数二|参数三.....” 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 '先处理特殊的命令字符, 然后处理一般的会话，处理前需要判断是否存在命令标志"：" Select Case CmdStr Case "天气" Response = Plugin_Weather(OptionStr) Case "搜索" Response = Plugin_Search(OptionStr) Case "翻译" Response = Plugin_Translate(OptionStr) Case "地图" Response = PlugIn_Map() Case "百科" Response = Plugin_Baike() Case "数学" Response = Plugin_Math(OptionStr) End Select End If Else If XpathToXml(str) > 0 Then '在本地查找满足模糊条件的数据 Response = GetLocalData(XpathToXml(str) - 1) Else Response = getWebData(str) End If End If Return Response End Function '----------------------------------------------------- '----------------------------------------------------- '---------- 这里是用于扩展程序功能的插件-------------- '----------------------------------------------------- '----------------------------------------------------- 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 Return Nothing End Function Function Plugin_Search(ByVal keywords As String) As String browser.Show() browser.WebBrowser1.Navigate("http://www.baidu.com/s?wd=" + keywords) Return "莉莉已经完成对" + "[" + keywords + "]" + "的搜索" End Function Function Plugin_Math(ByVal expression As String) As String Dim ScriptClass As New MSScriptControl.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 "" End Function '----------------------------------------------------- '----------------------------------------------------- '---------------插件部分的代码到此结束---------------- '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '---------这里是用于从网络获取聊天数据的程序---------- '----------------------------------------------------- '----------------------------------------------------- '从网络上获取数据 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 "莉莉累了，休息一会儿....." Else Return webbot.showmsg(str, cookie) End If End Function '----------------------------------------------------- '----------------------------------------------------- '-----------------------结束-------------------------- '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '-------------------本地数据搜索模块------------------ '----------------------------------------------------- '----------------------------------------------------- '基于Xpath的模糊匹配,返回满足要求的数据-问题索引 Public Function XpathToXml(ByVal str As String) As Integer Dim IndexList As New ArrayList '用于保存满足匹配条件的索引列表 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 '如果满足条件就保存当前索引到IndexList IndexList.Add(i) End If Next If IndexList.Count = 0 Then '假如列表中没有符合要求的索引 pos = 0 Else pos = IndexList(Int(Rnd() * (IndexList.Count))) '否则返回索引列表中的随机索引值，加1是为了了避免出现1的错误，这样会导致回答索引为0 If pos = 1 Then pos = pos + 1 '避免因为随机数而导致的出现答案索引为0的情形 End If Return pos End Function '获取本地指定索引的数据-答案 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 '----------------------------------------------------- '----------------------------------------------------- '---------------本地数据搜索模块结束------------------ '----------------------------------------------------- '----------------------------------------------------- '***************************************************** '----------------------------------------------------- '----------------------------------------------------- '---------------机器学习部分函数模块------------------ '----------------------------------------------------- '----------------------------------------------------- '添加新知识到xml存档 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 Nothing End Function '自动学习主函数 Private Sub AutoStudy(ByVal str As String, ByVal answer As String) End Sub '对分词结果的处理函数 '这里还有Bug，不能进入系统 Function GetSplitWords(ByVal SplitStr As String, ByVal OrangeStr As String) As String Dim SplitWords As New ArrayList '用于存储分词结果的处理 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 tempstr 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 EncodeStart < Len(SplitStr) '到此处已经获取了所有分词结果并单独存储 '开始对分词结果进行概率计算 Dim Total As Integer = 0 Dim T_lenth(SplitWords.Count) As Integer Dim T_location(SplitWords.Count) As Integer Dim E_rank(SplitWords.Count) As Double '分别获取每个分词结果的位置和长度，并循环累加算出总概率 For i As Integer = 0 To SplitWords.Count T_lenth(i) = SplitWords(i).Length T_location(i) = OrangeStr.IndexOf(SplitWords(i)) Total = Total + T_lenth(i) * T_location(i) Next '计算每一个分词结果的概率 For i = 0 To SplitWords.Count E_rank(i) = T_lenth(i) * T_location(i) / Total Next '选出概率最大的分词结果 System.Array.Sort(E_rank) Return Nothing End Function '----------------------------------------------------- '----------------------------------------------------- '---------------机器学习部分函数结束------------------ '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '----------------------------------------------------- '--------------以下为可选模块部分代码----------------- '----------------------------------------------------- '----------------------------------------------------- Private Sub 词典设置ToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 词典设置ToolStripMenuItem.Click Dictionary.Show() End Sub Private Sub txtq_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtq.KeyPress End Sub '播放消息提示音 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 '语音识别 'Private Sub SoundRecognition() ' If IsSoundRecognition = True Then ' Dim RG As SpeechLib.ISpeechRecoGrammar ' RG = RC.CreateGrammar(0) ' RG.DictationLoad() ' RG.DictationSetState(1) ' Else ' Exit Sub ' End If 'End Sub '语音监听 'Private Sub 听到命令(ByVal StreamNumber As Integer, ByVal StreamPosition As Object, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal 话语 As SpeechLib.ISpeechRecoResult) Handles RC.Recognition ' txtq.Text = 话语.PhraseInfo.GetText() 'End Sub '语音朗读 'Private Sub TalkWithSound(ByVal str) ' If IsTalkWithSound = True Then ' myvoice = New SpeechLib.SpVoice ' myvoice.speak(str) ' End If 'End Sub Private Sub 语音选项ToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 语音选项ToolStripMenuItem.Click Sound.Show() End Sub Private Sub 关于QRobotToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 关于QRobotToolStripMenuItem.Click about.Show() End SubEnd Class
- 开源聊天机器人程序QRobot（QuickRobot）
- C#简易聊天机器人（控制台程序）
- 一个聊天机器人的程序
- 聊天机器人文档（AIML）
- google开源他的聊天机器人代码
- nlp文本处理开源工具，及聊天机器人实现
- TensorFlow 聊天机器人开源项目评测第一期：DeepQA
- 聊天机器人
- 聊天机器人
- 聊天机器人
- 聊天机器人
- 聊天机器人
- 聊天机器人
- 聊天机器人（Chatterbot）的诞生
- 手把手搭建一个聊天机器人（一）
- 手把手搭建一个聊天机器人（二）
- 微信小程序开发—项目实战之聊天机器人
- 微信小程序开发—项目实战之聊天机器人
- 我的架构经验小结（三）－－ 深入三层架构
- Android机型适配之密度独立
- Java SE 自学笔记4 之面向对象的类
- 引用:初探Sql Server 执行计划及Sql查询优化
- 设置MySQL字符集
- 开源聊天机器人程序QRobot（QuickRobot）
- 我的架构经验小结（四）－－ 实战中演化的三层架构
- asp.net后台添加控件并同时为其添加后台事件
- 黑马程序员-java基础_网络基本
- 小米图标缓存
- 结构体/共用体/类中分号分析
- php快速排序算法
- android源码2.3编译—致命错误： bits/predefs.h
- Minimum Path Sum
