开源聊天机器人程序QRobot（QuickRobot）

之前写的，本来打算写成开源类库的，可是用C#移植的时候发现了很大的问题，主要是当机器人回答时执行效率太慢，而我又没有什么好的改进方法，所以我决定将此程序代码全部公开，完整代码下载请前往：

VB.NET版：http://download.csdn.net/detail/qinyuanpei/5561585

C#移植版（未完成）：http://download.csdn.net/detail/qinyuanpei/5561619


Imports System
Imports System.Xml
Imports Lucene.Net.Analysis
Imports System.Text
Imports System.Net
Imports System.IOPublic Class chatPublic XmlPath As String    '语料数据路径Public username As String '使用者名字Public robotname As String '机器人名字Dim myvoice As Object  '创建语音选项Dim systime As StringDim a As StringDim q As String' Public WithEvents RC As New SpeechLib.SpSharedRecoContextDim 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 '用于窗体的移动'对话过程CmdtalkPrivate Sub Cmdtalk_Click() Handles Cmdtalk.Clickq = txtq.Textsystime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" & DateTime.Now.Secondtxtans.Text = txtans.Text & vbNewLine & vbNewLine & systime & Space(2) & "【" & username & "】" & "说:" & vbNewLine & qPlayMusic()a = Response(q)'开始匹配答案 核心部分txtans.Text = txtans.Text & vbNewLine & vbNewLine & systime & Space(2) & "【" & robotname & "】" & "说:" & vbNewLine & atxtans.SelectionStart = Len(txtans.Text & vbNewLine & vbNewLine) '选择文本插入点，给下面的文字空出空间txtans.ScrollToCaret() '滚动条滚动开始'自动学习开始()lastq = q  '记录前一个问题的内容lasta = a  '记录前一个问题的答案If XpathToXml(lastq) = 0 And lasta <> "莉莉不知道怎样回答" ThenAddNewKnowledge(lastq, lasta)End Iftxtq.Text = ""End Sub'页面初始化主函数Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LoadRandomize()LoadCmd() '加载命令列表IsTalkWithSound = FalseIsSoundRecognition = Falseusername = "我"robotname = "莉莉"systime = DateTime.Now.Hour & ":" & DateTime.Now.Minute & ":" & DateTime.Now.Secondtxtans.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 XmlDocumentxmldoc.Load(Application.StartupPath & "\aiml\cmd.xml")Dim nodeList As XmlNodeListDim root As XmlElement = xmldoc.DocumentElementnodeList = root.SelectNodes("/cmdlist/cmd")Dim a As String = ""Dim node As XmlNode = NothingFor Each node In nodeListCmdList.Add(node.InnerText)NextEnd Sub'分词模块，比较简单，没想到中科院的效果那么差Public Function SplitWords(ByVal input As String) As StringDim sb As New StringBuilder()sb.Remove(0, sb.Length)Dim t1 As String = ""Dim i As Integer = 0Dim analyzer = New Lucene.Net.Analysis.China.ChineseAnalyzerDim sr As New StringReader(input)Dim stream As TokenStreamstream = analyzer.TokenStream("", sr)Dim t As Token = stream.Next()While t Is Nothing = Falset1 = t.ToString()t1 = t1.Replace("(", "")sb.Append(i & ":" & "(" & t1)t = stream.Next()i += 1End WhileSplitWords = sb.ToString()End Function'机器人反应函数ResponsePublic Function Response(ByVal str As String) As String'这里指定所有的命令函数格式为：“函数名：参数一|参数二|参数三.....”Response = ""If InStr(str, "：") > 0 ThenDim 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 CmdStrCase "天气"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 SelectEnd IfElseIf XpathToXml(str) > 0 Then  '在本地查找满足模糊条件的数据Response = GetLocalData(XpathToXml(str) - 1)ElseResponse = getWebData(str)End IfEnd IfReturn ResponseEnd Function'-----------------------------------------------------'-----------------------------------------------------'---------- 这里是用于扩展程序功能的插件--------------'-----------------------------------------------------'-----------------------------------------------------Function Plugin_Translate(ByVal q As String) As StringDim translate As New youdaoTranslateReturn translate.DoTranslate(q)End FunctionFunction Plugin_Weather(ByVal city As String) As StringReturn NothingEnd FunctionFunction Plugin_Search(ByVal keywords As String) As Stringbrowser.Show()browser.WebBrowser1.Navigate("http://www.baidu.com/s?wd=" + keywords)Return "莉莉已经完成对" + "[" + keywords + "]" + "的搜索"End FunctionFunction Plugin_Math(ByVal expression As String) As StringDim ScriptClass As New MSScriptControl.ScriptControlScriptClass.Language = "javascript"Dim obj As Object = ScriptClass.Eval(expression)Return expression + "=" + obj.ToString()End FunctionFunction PlugIn_Map()Return ""End FunctionFunction Plugin_Baike()Return ""End Function'-----------------------------------------------------'-----------------------------------------------------'---------------插件部分的代码到此结束----------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'---------这里是用于从网络获取聊天数据的程序----------'-----------------------------------------------------'-----------------------------------------------------'从网络上获取数据Function getWebData(ByVal str As String) As StringDim webbot As New SimsimiDim cookie As String = webbot.getcookie()If webbot.showmsg(str, cookie) = "{}" ThenReturn "莉莉累了，休息一会儿....."ElseReturn webbot.showmsg(str, cookie)End IfEnd Function'-----------------------------------------------------'-----------------------------------------------------'-----------------------结束--------------------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'-------------------本地数据搜索模块------------------'-----------------------------------------------------'-----------------------------------------------------'基于Xpath的模糊匹配,返回满足要求的数据-问题索引Public Function XpathToXml(ByVal str As String) As IntegerDim IndexList As New ArrayList '用于保存满足匹配条件的索引列表Dim pos As IntegerDim i As Integer = 0Dim xmldoc1 As New XmlDocumentxmldoc1.Load(Application.StartupPath & "\aiml\aiml.xml")Dim nodeList As XmlNodeListDim root As XmlElement = xmldoc1.DocumentElementnodeList = root.SelectNodes("/aiml/talk/question")Dim node As XmlNode = NothingFor Each node In nodeListDim q As String = node.InnerTexti = i + 1If str = q Or InStr(SplitWords(str), q) > 0 Then  '如果满足条件就保存当前索引到IndexListIndexList.Add(i)End IfNextIf IndexList.Count = 0 Then '假如列表中没有符合要求的索引pos = 0Elsepos = IndexList(Int(Rnd() * (IndexList.Count))) '否则返回索引列表中的随机索引值，加1是为了了避免出现1的错误，这样会导致回答索引为0If pos = 1 Then pos = pos + 1 '避免因为随机数而导致的出现答案索引为0的情形End IfReturn posEnd Function'获取本地指定索引的数据-答案Public Function GetLocalData(ByVal index As Integer) As StringDim pos As Integer = 0Dim xmldoc1 As New XmlDocumentxmldoc1.Load(Application.StartupPath & "\aiml\aiml.xml")Dim nodeList As XmlNodeListDim root As XmlElement = xmldoc1.DocumentElementnodeList = root.SelectNodes("/aiml/talk/answer")Dim a As String = ""Dim node As XmlNode = NothingFor Each node In nodeLista = node.InnerTextpos = pos + 1If pos > index ThenExit ForEnd IfNextReturn aEnd Function'-----------------------------------------------------'-----------------------------------------------------'---------------本地数据搜索模块结束------------------'-----------------------------------------------------'-----------------------------------------------------'*****************************************************'-----------------------------------------------------'-----------------------------------------------------'---------------机器学习部分函数模块------------------'-----------------------------------------------------'-----------------------------------------------------'添加新知识到xml存档Public Function AddNewKnowledge(ByVal q As String, ByVal a As String)Dim xmldoc As New XmlDocumentxmldoc.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 = qnode.AppendChild(node1)Dim node2 As XmlNode = xmldoc.CreateNode(Xml.XmlNodeType.Element, "answer", "")node2.InnerText = anode.AppendChild(node2)xmldoc.Save(Application.StartupPath & "\aiml\aiml.xml")Return NothingEnd 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 StringDim SplitWords As New ArrayList  '用于存储分词结果的处理Dim EncodeStart As Integer = 1Dim EncodeEnd As Integer = 1Dim j As Integer = 0DoDim s1 As Integer = EncodeStartDim e1 As Integer = EncodeEndEncodeStart = 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 + 1Loop While EncodeEnd < Len(SplitStr) And EncodeStart < Len(SplitStr)  '到此处已经获取了所有分词结果并单独存储'开始对分词结果进行概率计算Dim Total As Integer = 0Dim T_lenth(SplitWords.Count) As IntegerDim T_location(SplitWords.Count) As IntegerDim E_rank(SplitWords.Count) As Double'分别获取每个分词结果的位置和长度，并循环累加算出总概率For i As Integer = 0 To SplitWords.CountT_lenth(i) = SplitWords(i).LengthT_location(i) = OrangeStr.IndexOf(SplitWords(i))Total = Total + T_lenth(i) * T_location(i)Next'计算每一个分词结果的概率For i = 0 To SplitWords.CountE_rank(i) = T_lenth(i) * T_location(i) / TotalNext'选出概率最大的分词结果System.Array.Sort(E_rank)Return NothingEnd Function'-----------------------------------------------------'-----------------------------------------------------'---------------机器学习部分函数结束------------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'-----------------------------------------------------'--------------以下为可选模块部分代码-----------------'-----------------------------------------------------'-----------------------------------------------------Private Sub 词典设置ToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 词典设置ToolStripMenuItem.ClickDictionary.Show()End SubPrivate Sub txtq_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtq.KeyPressEnd Sub'播放消息提示音Private Sub PlayMusic()If IsMsgWithSound = True ThenDim player As New System.Media.SoundPlayerplayer.SoundLocation = Application.StartupPath & "\wav\msg.wav"player.Load()player.Play()End IfEnd 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 SubPrivate Sub 语音选项ToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 语音选项ToolStripMenuItem.ClickSound.Show()End SubPrivate Sub 关于QRobotToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles 关于QRobotToolStripMenuItem.Clickabout.Show()End Sub
End Class

开源聊天机器人程序QRobot（QuickRobot）相关推荐

两种开源聊天机器人的性能测试（一）——ChatterBot
因为最近在学习自然语言处理的相关知识,QQ小冰这个东西最近又很热,所以就试着玩了下两个开源聊天机器人,在这里分享一点小经验,希望对有共同兴趣的人能起到那么一点作用. 我主要测试了两个聊天机器人,一个是 ...
python开源聊天机器人ChatterBot——聊天机器人搭建、流程分析、源码分析
开源聊天机器人ChatterBot 3.1 ChatterBot简介 ChatterBot是一个Python库,可以轻松生成对用户输入的自动响应.ChatterBot使用一系列机器学习算法来产生不同 ...
php给微信公众号接入聊天机器人程序+采坑记录
php给微信公众号接入聊天机器人程序今天逛了下我的公众号,突然心血来潮,想添加个自动聊天功能,于是-动手-!! 主要用到的api: 图灵机器人api 青云客智能聊天机器人API 茉莉机器人API 至 ...
OpenAI研发的人工智能聊天机器人程序
ChatGPT,是人工智能研究公司OpenAI研发的人工智能聊天机器人程序,一个自然语言生成式模型,使用基于GPT-3.5架构的大型语言模型并通过基于人类反馈的强化学习进行训练.ChatGPT使用自然 ...
Facebook 开源聊天机器人Blender，经94 亿个参数强化训练，更具“人情味”
来源:AI前线作者 | Kyle Wiggers 编译 | Sambodhi 策划 & 编辑 | 刘燕不久前,Facebook 开源了号称是全球最强大的聊天机器人 Blender,它标志着 ...
击败谷歌AI拿下“最强”称号？Facebook AI开源聊天机器人Blender
如今,我们对虚拟语音助手已经十分熟悉.无论是苹果 Siri.亚马逊 Alexa,还是百度小度,阿里巴巴天猫精灵,在提供帮助之余,还经常扮演着被无聊人类调戏的对象. 就在你来我往的博弈之间,语音助手们练 ...
java 开源聊天机器人_用Java实现基于Web端的AI机器人聊天
本文详细介绍了如何用Java实现Web聊天机器人.通过创建一个新项目来学习一下! 一.创建一个新项目添加所需的依赖项打开pom.xml文件在IDE中将下列内容添加到区域 JCenterhttps ...
5个开源聊天应用程序
注:本文转载自iteye 1. Cryptocat – An Open Source Encrypted & Private Chat Application Cryptocat 是一个开源基 ...
pyqt4+chatterbot实现简单聊天机器人程序
环境window10+python3 代码:github.com/xie233/text_mining 转载于:https://www.cnblogs.com/who-a/p/5641738.html

开源聊天机器人程序QRobot（QuickRobot）

开源聊天机器人程序QRobot（QuickRobot）相关推荐

最新文章

热门文章