and anothor chatbot (random generator chatbot)

Started by ron77_db, May 19, 2022, 03:25 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

ron77_db

May 19, 2022, 03:25 PM
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

ron77_db

#1
May 19, 2022, 03:49 PM
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"

ron77_db

#2
May 20, 2022, 11:00 AM
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"

ron77_db

#3
May 20, 2022, 12:17 PM Last Edit: May 20, 2022, 12:38 PM by ron77
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"

ron77

#4
May 23, 2023, 12:15 PM
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"

ron77

#5
May 23, 2023, 01:22 PM
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 :)

ron77

#6
May 24, 2023, 04:53 PM Last Edit: May 26, 2023, 10:35 PM by ron77
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)

You cannot view this attachment.
Print
Go Up Pages1
User actions