hello, yes, yet another chatbot - one that reads from a dataset of conversations and parses it to sentences, then to words, and when given input, it searches if the input matches 75 % of words in every line, and if so, it replies that line...
here is the code: "fb_main.bas"
'#include "crt.bi"
redim as string data1(any)
'redim as string compare(any)
'redim as string Tarray(any)
'randomize()
sub sAppend(arr() as string , temp as string)
redim preserve arr((lbound(arr)) to (ubound(arr) + 1))
arr(ubound(arr)) = temp
End Sub
sub ParseSentence( arr() as string , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as long
if len(sSentence) <= 0 then exit sub
for i as long = 0 to len(sSentence) 'reaches the \0 at the end
'less slower with ascii :)
currentCaracter = sSentence[i] 'mid(arr(iCount), i, 1)
select case as const currentCaracter
case asc("A") to asc("Z"),asc("a") to asc("z") 'characteres anywhere on the word
WordSize += 1
case asc("0") to asc("9"),asc("-"),asc("_"),asc("'") 'cant start with those
if WordSize then WordSize += 1
case else 'case asc(" "),0
if WordSize > 1 then
var sWord = mid(sSentence, (i-WordSize)+1, WordSize)
sAppend( arr() , sWord )
endif
wordSize=0
end select
next i
end sub
function is75accurate(arr1() as string, sen as string) as STRING
'arr1 = array with sentences
'arr2 = question parsed
'arr3 =
dim ques as STRING
dim index as long
redim arr2() as string
ParseSentence(arr2(), sen)
for index = lbound(arr1) to ubound(arr1)
ques = arr1(index)
redim arr3() as string
ParseSentence(arr3(), ques)
dim fitCount as long
for i as long = 0 to ubound(arr2)
for k as long = 0 to ubound(arr3)
if arr2(i) = arr3(k) then fitCount +=1
next k
next i
dim as long scop = ((ubound(arr3)+1) * 0.75)
'print scop, fitCount, index
if scop>0 andalso fitCount >= scop then return ques
next
return "no reply found! please try again!"
End Function
dim fline as string
dim f as long = freefile()
open "dataset_clean.txt" for input as #f
while not eof(f)
line input #f, fline
sAppend(data1(), fline)
Wend
close #f
'print ubound(data1)
dim ans as STRING
do
input "", ans
print is75accurate(data1(), ans)
'print data1(int(rnd*(ubound(data1))+1))
'ParseSentence(data1(), ans)
'for i as integer = 0 to ubound(data1)
'print data1(i); " "
'Next
Loop until ans = "quit"
and here is attached a dataset of conversations for you to start using it - just remember you can use any dataset you wish of questions and answers or conversations:
https://www.dropbox.com/s/kvobyw2pupyqevz/dataset_clean.7z?dl=0 (https://www.dropbox.com/s/kvobyw2pupyqevz/dataset_clean.7z?dl=0)
hello, did some modifications - now the reply will be the next line of the line that matches 75 % of the input... :) random chatbot with no brain however thanks to the dataset text file his replies are hilarious...
file: "fb_main.bas"
'#include "crt.bi"
redim as string data1(any)
'redim as string compare(any)
'redim as string Tarray(any)
'randomize()
sub sAppend(arr() as string , temp as string)
redim preserve arr((lbound(arr)) to (ubound(arr) + 1))
arr(ubound(arr)) = temp
End Sub
sub ParseSentence( arr() as string , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as long
if len(sSentence) <= 0 then exit sub
for i as long = 0 to len(sSentence) 'reaches the \0 at the end
'less slower with ascii :)
currentCaracter = sSentence[i] 'mid(arr(iCount), i, 1)
select case as const currentCaracter
case asc("A") to asc("Z"),asc("a") to asc("z") 'characteres anywhere on the word
WordSize += 1
case asc("0") to asc("9"),asc("-"),asc("_"),asc("'") 'cant start with those
if WordSize then WordSize += 1
case else 'case asc(" "),0
if WordSize > 1 then
var sWord = mid(sSentence, (i-WordSize)+1, WordSize)
sAppend( arr() , sWord )
endif
wordSize=0
end select
next i
end sub
function is75accurate(arr1() as string, sen as string) as STRING
'arr1 = array with sentences
'arr2 = question parsed
'arr3 =
dim ques as STRING
dim index as long
redim arr2() as string
ParseSentence(arr2(), sen)
for index = lbound(arr1) to ubound(arr1)
ques = arr1(index)
redim arr3() as string
ParseSentence(arr3(), ques)
dim fitCount as long
for i as long = 0 to ubound(arr2)
for k as long = 0 to ubound(arr3)
if arr2(i) = arr3(k) then fitCount +=1
next k
next i
dim as long scop = ((ubound(arr3)+1) * 0.75)
'print scop, fitCount, index
if scop>0 andalso fitCount >= scop then return arr1(index +1) 'ques
next
return "no reply found! please try again!"
End Function
dim fline as string
dim f as long = freefile()
open "dataset_clean.txt" for input as #f
while not eof(f)
line input #f, fline
sAppend(data1(), fline)
Wend
close #f
'print ubound(data1)
dim ans as STRING
do
input "you: ", ans
print "bot: " & is75accurate(data1(), ans)
'print data1(int(rnd*(ubound(data1))+1))
'ParseSentence(data1(), ans)
'for i as integer = 0 to ubound(data1)
'print data1(i); " "
'Next
Loop until ans = "quit"
okay 3rd version: this time the chatbot will reply all lines which are 75 % matched to input
file "fb_main.bas":
redim as string data1(any)
sub sAppend(arr() as string , temp as string)
redim preserve arr((lbound(arr)) to (ubound(arr) + 1))
arr(ubound(arr)) = temp
End Sub
sub ParseSentence( arr() as string , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as long
if len(sSentence) <= 0 then exit sub
for i as long = 0 to len(sSentence) 'reaches the \0 at the end
'less slower with ascii :)
currentCaracter = sSentence[i] 'mid(arr(iCount), i, 1)
select case as const currentCaracter
case asc("A") to asc("Z"),asc("a") to asc("z") 'characteres anywhere on the word
WordSize += 1
case asc("0") to asc("9"),asc("-"),asc("_"),asc("'") 'cant start with those
if WordSize then WordSize += 1
case else 'case asc(" "),0
if WordSize > 1 then
var sWord = mid(sSentence, (i-WordSize)+1, WordSize)
sAppend( arr() , sWord )
endif
wordSize=0
end select
next i
end sub
function is75accurate(arr1() as string, sen as string) as STRING
'arr1 = array with sentences
'arr2 = question parsed
'arr3 =
dim result as string
dim ques as STRING
dim index as long
redim arr2() as string
ParseSentence(arr2(), sen)
for index = lbound(arr1) to ubound(arr1)
ques = arr1(index)
redim arr3() as string
ParseSentence(arr3(), ques)
dim fitCount as long
for i as long = 0 to ubound(arr2)
for k as long = 0 to ubound(arr3)
if arr2(i) = arr3(k) then fitCount +=1
next k
next i
dim as long scop = ((ubound(arr3)+1) * 0.75)
'print scop, fitCount, index
if scop>0 andalso fitCount >= scop then result += arr1(index+1) + " " 'return arr1(index +1) 'ques
next
if result ="" then
return "no reply found! please try again!"
else
return result
end if
End Function
dim fline as string
dim f as long = freefile()
open "dataset_clean.txt" for input as #f
while not eof(f)
line input #f, fline
sAppend(data1(), fline)
Wend
close #f
'print ubound(data1)
dim ans as STRING
do
input "you: ", ans
print "bot: " & is75accurate(data1(), ans)
Loop until ans = "quit"
okay, 4th version and a much better version of the chatbot... since the multi-line replies are long sometimes, I made it store all 75 % matched lines into an array and then randomly choose one from it. That way you get a different reply for the same input:
file "fb_main.bas":
redim as string data1(any)
randomize()
sub sAppend(arr() as string , temp as string)
redim preserve arr((lbound(arr)) to (ubound(arr) + 1))
arr(ubound(arr)) = temp
End Sub
sub ParseSentence( arr() as string , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as long
if len(sSentence) <= 0 then exit sub
for i as long = 0 to len(sSentence) 'reaches the \0 at the end
'less slower with ascii :)
currentCaracter = sSentence[i] 'mid(arr(iCount), i, 1)
select case as const currentCaracter
case asc("A") to asc("Z"),asc("a") to asc("z") 'characteres anywhere on the word
WordSize += 1
case asc("0") to asc("9"),asc("-"),asc("_"),asc("'") 'cant start with those
if WordSize then WordSize += 1
case else 'case asc(" "),0
if WordSize > 1 then
var sWord = mid(sSentence, (i-WordSize)+1, WordSize)
sAppend( arr() , sWord )
endif
wordSize=0
end select
next i
end sub
function is75accurate(arr1() as string, sen as string) as STRING
'arr1 = array with sentences
'arr2 = question parsed
'arr3 =
'dim result as string
dim ques as STRING
dim index as long
redim result(any) as STRING
redim arr2() as string
ParseSentence(arr2(), sen)
for index = lbound(arr1) to ubound(arr1)
ques = arr1(index)
redim arr3() as string
ParseSentence(arr3(), ques)
dim fitCount as long
for i as long = 0 to ubound(arr2)
for k as long = 0 to ubound(arr3)
if arr2(i) = arr3(k) then fitCount +=1
next k
next i
dim as long scop = ((ubound(arr3)+1) * 0.75)
'print scop, fitCount, index
if scop>0 andalso fitCount >= scop then sAppend(result(), arr1(index+1)) 'return arr1(index +1) 'ques
next
if result(0) ="" then
return "no reply found! please try again!"
else
return result(int(rnd*(ubound(result)+1)))
end if
End Function
dim fline as string
dim f as long = freefile()
open "dataset_clean.txt" for input as #f
while not eof(f)
line input #f, fline
sAppend(data1(), fline)
Wend
close #f
'print ubound(data1)
dim ans as STRING
do
input "you: ", ans
print "bot: " & is75accurate(data1(), ans)
Loop until ans = "quit"
okay, 5th version - in this version, the chatbots use the input from the user as the database for conversations and chat :)
const file = "database_input.txt"
randomize()
dim h as long = freefile
open file for append as #h
close #h
redim shared as string data1(any)
sub writefile2(text2 as String)
dim f as long = freefile()
open file for append as #f
print #f , text2
close #f
End Sub
sub sAppend(arr() as string , temp as string)
redim preserve arr((lbound(arr)) to (ubound(arr) + 1))
arr(ubound(arr)) = temp
End Sub
sub ParseSentence( arr() as string , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as long
if len(sSentence) <= 0 then exit sub
for i as long = 0 to len(sSentence) 'reaches the \0 at the end
'less slower with ascii :)
currentCaracter = sSentence[i] 'mid(arr(iCount), i, 1)
select case as const currentCaracter
case asc("A") to asc("Z"),asc("a") to asc("z") 'characteres anywhere on the word
WordSize += 1
case asc("0") to asc("9"),asc("-"),asc("_"),asc("'") 'cant start with those
if WordSize then WordSize += 1
case else 'case asc(" "),0
if WordSize > 1 then
var sWord = mid(sSentence, (i-WordSize)+1, WordSize)
sAppend( arr() , sWord )
endif
wordSize=0
end select
next i
end sub
function is75accurate(arr1() as string, sen as string) as STRING
'arr1 = array with sentences
'arr2 = question parsed
'arr3 =
'dim result as string
dim ques as STRING
dim index as long
redim result(any) as STRING
redim arr2() as string
ParseSentence(arr2(), sen)
for index = lbound(arr1) to ubound(arr1)
ques = arr1(index)
redim arr3() as string
ParseSentence(arr3(), ques)
dim fitCount as long
for i as long = 0 to ubound(arr2)
for k as long = 0 to ubound(arr3)
if arr2(i) = arr3(k) then fitCount +=1
next k
next i
dim as long scop = ((ubound(arr3)+1) * 0.75)
'print scop, fitCount, index
if scop>0 andalso fitCount >= scop then sAppend(result(), arr1(index)) 'arr1(index) quess 'sAppend(result(), arr1(index))
next
if ubound(result) < 0 then
return "no reply found please try again!"
else
return result(int(rnd*(ubound(result)+1)))
end if
End Function
dim ff as long = freefile : dim fline as string
open file for input as #ff
while not eof(ff)
line input #ff, fline
sAppend(data1(), fline)
Wend
close #ff
dim ans as string : dim txt as string
do
input "You: ", ans
if ans = "q" then continue do
txt = is75accurate(data1(), ans)
sAppend(data1(), ans)
writefile2(ans)
print "Bot:" & txt
if txt = "no reply found please try again!" then continue do
' sAppend(data1(), txt)
' writefile2(txt)
loop until ans = "q"
hi aurel :)
Yes! Just keep talking to it, and soon it will find matches of input to the database to output the more you talk to it, the larger the database grows, and the more likely there will be good matches to output...
It's alright. The longer you talk to it, the smarter it gets and the more complex the output is :)
Tell us how it works :)
Hi everyone :)
Here in the attached zip file is the chatbot code with window9 GUI and tts plus a small database to get you started...
ron77
EDIT:
Found a small bug that caused the chatbot not to get or learn the input (confusion between the user input and the bot reply... :D :o fixed it now the bot should lean from input and work properly)
fb_input_learner_chatbot.zip