RetroCoders Community

FreeBasic Programming => FreeBasic => Topic started by: ron77_db on Apr 08, 2022, 02:44 PM

Title: chatbot aviv version 2
Post by: ron77_db on Apr 08, 2022, 02:44 PM
hello everyone...

I've been looking into a way of creating different algorithms for chatbots... what I used so far for many years is the ELIZA chatbot algorithm of fixed keys->replies with randomness... so now that I found a way to parse text input of strings I coded a very basic chatbot demo that stores the input from the user and the output are random words from the user own input...

here is the code so far...

redim shared as string sSentence(any)
redim shared as string sArrReplys(any)


'APPEND TO the STRING array the STRING item
SUB sAppend(arr() AS STRING , Item AS STRING)
'if the array is empty make it start as the lbound index not ubound (or 0 or 1, whatever...)
var iUbound = iif( ubound(arr)<lbound(arr) , lbound(arr) , ubound(arr) )
REDIM PRESERVE arr(LBOUND(arr) TO iUbound+1) AS STRING
arr(UBOUND(arr)) = Item
END SUB

sub generate(arr() as string, iCount as integer, sOutput() as string)
dim as string sReplys(any)
dim currentCaracter as STRING
Dim WordSize as Integer
for i as integer = 1 to len(arr(iCount))
currentCaracter = mid(arr(iCount), i, 1)
select case currentCaracter
Case " "
if not WordSize = 0 then
sappend(sOutput(), mid(arr(iCount), i - WordSize, WordSize))
endif
wordSize = 0
case else
WordSize += 1
End Select
if i = len(arr(iCount)) then
WordSize = WordSize - 1
sappend( sOutput(), mid(arr(iCount), i - WordSize, WordSize + 1))
EndIf
Next i
'return sReplys()
End sub


randomize()

'dim sReply as string
dim ICountReply as INTEGER = 1
dim ans as STRING
do
input "you: ", ans
sappend(sSentence(), ans)
generate(sSentence(), ICountReply, sArrReplys())

iCountReply += 1
print "ChatBot Aviv: " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & _
sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1))
'for i as integer = 1 to ubound(sArrReplys)
'print sArrReplys(i)
'Next
Loop until lcase(ans) = "quit"

'for i as integer = 1 to ubound(sSentence)
'print sSentence(i)
'Next

sleep

now I hope to do in the next step is to somehow make the bot reply by some sort of rules instead of just randomness like either the most common words in the user's input or to try to identify the words and rearrange them according to English grammar

I'll keep you updated :)

ron77
Title: Re: chatbot aviv version 2
Post by: ron77_db on Apr 08, 2022, 05:07 PM
okay... now I added and experimented with sorting the parsed word from the input array - I used a simple bubble sorting sub but I hope someone will help me with the binary query function that I added to it (but not used yet (didn't call it yet)

here is the updated code for the chatbot:

#Include "crt.bi"

redim shared as string sSentence(any)
redim shared as string sArrReplys(any)

Function BinaryQuery( Array() As String , sQuery As String ) As Integer
   Dim As Integer iFirst=0 , iLast=UBound(Array)
   Var sQueryL = LCase(sQuery)
   
   Dim As Integer iAttempts
   
   While iLast>=iFirst
     
      iAttempts += 1
     
      Dim As Integer iMid = (iFirst+iLast+1)\2 'cint((iFirst+iLast)/2)
      Dim As Integer iResult = strcmp( sQueryL , Array(iMid) )
      If iResult = 0 Then
         'AttemptPrint "Attempts: " & iAttempts,
         Return iMid
      EndIf
      If iResult > 0 Then iFirst = iMid+1 : Continue While
      iLast = iMid-1     
   Wend
   'AttemptPrint "Attempts: " & iAttempts,
   Return -1
End Function


'APPEND TO the STRING array the STRING item
SUB sAppend(arr() AS STRING , Item AS STRING)
'if the array is empty make it start as the lbound index not ubound (or 0 or 1, whatever...)
var iUbound = iif( ubound(arr)<lbound(arr) , lbound(arr) , ubound(arr) )
REDIM PRESERVE arr(LBOUND(arr) TO iUbound+1) AS STRING
arr(UBOUND(arr)) = Item
END SUB

sub generate(arr() as string, iCount as integer, sOutput() as string)
dim as string sReplys(any)
dim currentCaracter as STRING
Dim WordSize as Integer
for i as integer = 1 to len(arr(iCount))
currentCaracter = mid(arr(iCount), i, 1)
select case currentCaracter
Case " "
if not WordSize = 0 then
sappend(sOutput(), mid(arr(iCount), i - WordSize, WordSize))
endif
wordSize = 0
case else
WordSize += 1
End Select
if i = len(arr(iCount)) then
WordSize = WordSize - 1
sappend( sOutput(), mid(arr(iCount), i - WordSize, WordSize + 1))
EndIf
Next i
'return sReplys()
End sub

sub sorting(sArray() as string)
do

var bSorted = 0
for N as long = 0 to ubound(sArray) - 1

if sArray(N) > sArray(N+1) then swap sArray(N),sArray(N+1): bSorted = 1
Next N
if bSorted = 0 then exit do
Loop

End Sub

randomize()

'dim sReply as string
dim ICountReply as INTEGER = 1
dim ans as STRING
do
input "you: ", ans
sappend(sSentence(), ans)
generate(sSentence(), ICountReply, sArrReplys())

iCountReply += 1
sorting(sArrReplys())
print sArrReplys(1) & " " & sArrReplys(2) & " " & sArrReplys(3) & " " & sArrReplys(4) & " " & sArrReplys(5)
'print "ChatBot Aviv: " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & _
'sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1))
'for i as integer = 1 to ubound(sArrReplys)
'print sArrReplys(i)
'Next
Loop until lcase(ans) = "quit"

'for i as integer = 1 to ubound(sSentence)
'print sSentence(i)
'Next

sleep
Title: Re: chatbot aviv version 2
Post by: mysoft on Apr 13, 2022, 05:00 PM
ok i've improved the functions you used a bunch, and added the optional code to load a .txt file sorting the sentences for a better speed test, after our last changes , i added the missing "insertion sort" which is the "fastest :)" (it could be speed up to store stuff on trees or blocks if too much items were required)

19821 words added in 0.4455244967762155s
sort took 0.0007545143039351387s (usage only)
the project gutenberg ebook of moby bleep! or whale by herman melville this
a' a'lee a'low a'most--i a'ready a'shiver a'top a-begging a-calling a-going
the(14547)of(6704)and(6448)to(4663)in(4207)that(2966)his(2523)it(2406)
Title: Re: chatbot aviv version 2
Post by: mysoft on Apr 13, 2022, 06:41 PM
#define fbc -gen gcc -O 3 -Wc "-march=native -mtune=native"
'-exx

#define UseInsertionSort
#define AllowDuplicatedWords

#Include "crt.bi"
type ReplyStruct
  sWord as string 'word itself
  iUses as long   'how many times it was used?
  'adding cross indexes for usage here would speed it up
end type

type ReplyList
  redim tReplys(any) as ReplyStruct 'word list
  redim iUsageIndex(any) as long    'order of words by usage (rank)
  redim iAlphaIndex(any) as long    'alphabetical order or
  iStorage as integer               'theres space reserved for how many entries?
  iCount   as integer               'how many word are in total?
end type

redim shared as string sSentence(any)
static shared tReplys as ReplyList

sub SortListAlpha( byref tList as ReplyList )
dim as integer iIterations=0
  with tList
    do
      var bSorted = 0 : iIterations += 1
      for N as long = 0 to .iCount-2
        #define _s(_N) .tReplys(.iAlphaIndex(_N)).sWord
        if _s(N) > _s(N+1) then swap .iAlphaIndex(N),.iAlphaIndex(N+1): bSorted = 1
      next N
      if bSorted = 0 then exit do
    loop
    'print "Sorted (alphabetically) in " & iIterations & " iterations." & " words=" & .iCount
  end with 
end sub
sub SortListUsage( byref tList as ReplyList )
dim as integer iIterations=0
  with tList
    do
      var bSorted = 0 : iIterations += 1
      for N as long = 0 to .iCount-2
        #define _s(_N) .tReplys(.iUsageIndex(_N)).iUses
        if _s(N) < _s(N+1) then swap .iUsageIndex(N),.iUsageIndex(N+1): bSorted = 1
      next N
      if bSorted = 0 then exit do
    loop
    print "Sorted (by usage) in " & iIterations & " iterations." & " words=" & .iCount
  end with 
end sub

function QSortListAlpha cdecl ( pI1 as long ptr , pI2 as long ptr ) as long  
  with tReplys
    return strcmp( .tReplys(*pI1).sWord , .tReplys(*pI2).sWord ) 
  end with
end function
function QSortListUsage cdecl ( pI1 as long ptr , pI2 as long ptr ) as long  
  with tReplys           
    return .tReplys(*pI2).iUses - .tReplys(*pI1).iUses
  end with
end function

'**** locate query on list linearly ****
function LinearQueryList( byref tList as ReplyList , sQuery as string ) as integer
  with tList
    for N as integer = 0 to .iCount-1
      if strcmp( sQuery , .tReplys(N).sWord ) = 0 then
        return N
      end if
    next N
    return -1
  end with
end function
'**** !!! REQUIRES SORTED LIST !!! *****
function BinaryQueryList( byref tList as ReplyList , sQuery as string ) as integer
  with tList
    dim as integer iFirst=0 , iLast=.iCount-1
   
    #define sQueryL sQuery
    'Var sQueryL = lcase(sQuery)
   
    dim as integer iAttempts
   
    while iLast>=iFirst
      iAttempts += 1     
      var iMid = (iFirst+iLast+1)\2 'cint((iFirst+iLast)/2)
      var iResult = strcmp( sQueryL , .tReplys(.iAlphaIndex(iMid)).sWord )
      if iResult = 0 then
         'AttemptPrint "Attempts: " & iAttempts,
         return .iAlphaIndex(iMid)
      endif
      if iResult > 0 then iFirst = iMid+1 : continue while
      iLast = iMid-1     
    wend
    'AttemptPrint "Attempts: " & iAttempts
    return not ((iFirst+iLast+1)\2)
  end with
end function

'Add a word to a list
sub AddWord( byref tList as ReplyList , sWord as string )
  var sNewWord = lcase(sWord)
  with tList
   
    #if 0
      print "------------------------------------"
      for N as integer = 0 to .iCount-1
        print .tReplys(.iAlphaIndex(N)).sWord , .tReplys(.iAlphaIndex(N)).iUses
      next N
      sleep
    #endif
   
    #ifdef AllowDuplicatedWords     
      var iIndex = -1
    #else
      #ifdef UseInsertionSort
        var iIndex = BinaryQueryList( tList , sNewWord )
      #else
        var iIndex = LinearQueryList( tList , sNewWord )
      #endif   
    #endif
   
    if iIndex < 0 then 'new word
     
      #if 0 'buffered new word list output
        scope 'buffered new word list output
          static as string sBuffer
          sBuffer += sNewWord+"'"
          if len(sBuffer)>(80*25) then
            print sBuffer : sBuffer = ""         
          end if
        end scope
      #endif
     
      if .iCount >= .iStorage then
        'if theres no more reserved entries then enlarge the array
        .iStorage = .iStorage+(.iStorage\2)+15 '15,37,70,120,195...
        redim preserve .tReplys(.iStorage)
        redim preserve .iUsageIndex(.iStorage)
        redim preserve .iAlphaIndex(.iStorage)
      end if
      .tReplys(.iCount).sWord = sNewWord 'word
      .tReplys(.iCount).iUses = 1
      .iUsageIndex(.iCount) = .iCount    'set new positon on indexes
     
      #ifdef UseInsertionSort
        iIndex = not iIndex     
        memmove(@.iAlphaIndex(iIndex+1) , @.iAlphaIndex(iIndex) , (.iCount-iIndex)*sizeof(.iAlphaIndex(0)))
        .iAlphaIndex(iIndex) = .iCount
      #else     
        .iAlphaIndex(.iCount) = .iCount
      #endif
     
      .iCount += 1 'one string added :)
     
    else 'world already exist
      .tReplys(iIndex).iUses += 1
    end if
  end with
end sub
'APPEND TO the STRING array the STRING item
sub sAppend(arr() as string , Item as string)
'if the array is empty make it start as the lbound index not ubound (or 0 or 1, whatever...)
var iUbound = iif( ubound(arr)<lbound(arr) , lbound(arr) , ubound(arr) ) 
redim preserve arr(lbound(arr) to iUbound+1) as string
arr(ubound(arr)) = Item
end sub

sub ParseSentence( byref tList as ReplyList , sSentence as string )
dim currentCaracter as ubyte
dim WordSize as integer
for i as integer = 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)       
        AddWord( tList , sWord )
      endif
      wordSize=0     
end select
next i
end sub

randomize()

#if 0
  ' --------------------------- in this mode it loads the text file --------------------
  var f = freefile(), sLine = ""
  dim as double TMR = timer
  open "MobyDick.txt" for input as #f
  while not eof(f)
    line input #f, sLine
    if len(sLine) then       
      ParseSentence( tReplys , sLine )       
      if abs(timer-TMR) > 10 then exit while
    end if
  wend
  close #f
 
  print
  print tReplys.iCount & " words added in " & timer-TMR & "s"
 
  TMR = timer
  with tReplys
    #ifndef UseInsertionSort
      qSort(@.iAlphaIndex(0),.iCount,sizeof(.iAlphaIndex(0)),cast(any ptr,@QSortListAlpha))
      'SortListAlpha( tReplys )
    #endif
    qSort(@.iUsageIndex(0),.iCount,sizeof(.iUsageIndex(0)),cast(any ptr,@QSortListUsage)) 
    'SortListUsage( tReplys )
  end with
  print "sort took " & timer-TMR & "s"
 
  with tReplys
    var iWords = .iCount-1
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(N).sWord;" ";
      if Pos() > 70 then exit for
    next N
    print   
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(.iAlphaIndex(N)).sWord;" ";
      if Pos() > 70 then exit for
    next N
    print
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(.iUsageIndex(N)).sWord;"(" & .tReplys(.iUsageIndex(N)).iUses & ")";
      if Pos() > 70 then exit for
    next N
    print
  end with
 
#else

  'in this mode it read from keyboard input

  'dim sReply as string
  dim ICountReply as integer = 1
  dim ans as string
  do 
    line input "you: ", ans
    cls
    if len(ans)=0 then print "why the silence?": continue do
   
    sappend( sSentence() , ans )
    ParseSentence( tReplys , ans )
   
    iCountReply += 1
   
    #ifndef UseInsertionSort
      qSort(@tReplys.iAlphaIndex(0),tReplys.iCount,sizeof(tReplys.iAlphaIndex(0)),cast(any ptr,@QSortListAlpha))
      'SortListAlpha( tReplys ) 'bubble sort
    #endif
   
    qSort(@tReplys.iUsageIndex(0),tReplys.iCount,sizeof(tReplys.iUsageIndex(0)),cast(any ptr,@QSortListUsage)) 
    'SortListUsage( tReplys ) 'bubble sort

    with tReplys
      var iWords = .iCount-1
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(N).sWord;" ";
        if Pos() > 70 then exit for
      next N
      print   
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(.iAlphaIndex(N)).sWord;" ";
        if Pos() > 70 then exit for
      next N
      print   
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(.iUsageIndex(N)).sWord;"(" & .tReplys(.iUsageIndex(N)).iUses & ")";
        if Pos() > 70 then exit for
      next N   
      print
    end with
   
    'print sArrReplys(1) & " " & sArrReplys(2) & " " & sArrReplys(3) & " " & sArrReplys(4) & " " & sArrReplys(5)
    'print "ChatBot Aviv: " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & _
      'sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1))
    'for i as integer = 1 to ubound(sArrReplys)
      'print sArrReplys(i)
    'Next
  loop until lcase(ans) = "quit"
 
#endif

'for i as integer = 1 to ubound(sSentence)
'print sSentence(i)
'Next

sleep
Title: Re: chatbot aviv version 2
Post by: ron77_db on Apr 14, 2022, 10:56 AM
Aborting due to runtime error 6 (out of bounds array access) at line 56 of file::QSORTLISTALPHA()
Title: Re: chatbot aviv version 2
Post by: mysoft on Apr 14, 2022, 06:42 PM
what you did to achieve the error? because that function is not even called with the #define UseInsertionSort
Title: Re: chatbot aviv version 2
Post by: ron77_db on Apr 15, 2022, 09:47 AM
well I tried the mode to talk with the bot it crashed (runtime error 6) then I tried to read from a text file (kings James bible text file) it also crashed - so I found a fix to use instead the bubble sort on all modes and now it doesn't crash anymore not when talking to bot mode (user input) nor on reading from a text file (kings James bible) I compile it with -exx build command

'#define fbc -s console -gen gcc -Wc -Ofast -Wc -Wno-maybe-uninitialized -exx -w all
'-exx

#define UseInsertionSort
'#define AllowDuplicatedWords

#Include "crt.bi"
type ReplyStruct
  sWord as string 'word itself
  iUses as long  'how many times it was used?
  'adding cross indexes for usage here would speed it up
end type

type ReplyList
  redim tReplys(any) as ReplyStruct 'word list
  redim iUsageIndex(any) as long    'order of words by usage (rank)
  redim iAlphaIndex(any) as long    'alphabetical order or
  iStorage as integer              'theres space reserved for how many entries?
  iCount  as integer              'how many word are in total?
end type

redim shared as string sSentence(any)
static shared tReplys as ReplyList

sub SortListAlpha( byref tList as ReplyList )
    dim as integer iIterations=0
  with tList
    do       
      var bSorted = 0 : iIterations += 1
      for N as long = 0 to .iCount-2
        #define _s(_N) .tReplys(.iAlphaIndex(_N)).sWord
        if _s(N) > _s(N+1) then swap .iAlphaIndex(N),.iAlphaIndex(N+1): bSorted = 1
      next N
      if bSorted = 0 then exit do
    loop
    'print "Sorted (alphabetically) in " & iIterations & " iterations." & " words=" & .iCount
  end with
end sub
sub SortListUsage( byref tList as ReplyList )
    dim as integer iIterations=0
  with tList
    do       
      var bSorted = 0 : iIterations += 1
      for N as long = 0 to .iCount-2
        #define _s(_N) .tReplys(.iUsageIndex(_N)).iUses
        if _s(N) < _s(N+1) then swap .iUsageIndex(N),.iUsageIndex(N+1): bSorted = 1
      next N
      if bSorted = 0 then exit do
    loop
    print "Sorted (by usage) in " & iIterations & " iterations." & " words=" & .iCount
  end with
end sub

function QSortListAlpha cdecl ( pI1 as integer ptr , pI2 as integer ptr ) as long   
  with tReplys 
    return strcmp( .tReplys(*pI1).sWord , .tReplys(*pI2).sWord )
  end with
end function
function QSortListUsage cdecl ( pI1 as integer ptr , pI2 as integer ptr ) as long   
  with tReplys         
    return .tReplys(*pI2).iUses - .tReplys(*pI1).iUses
  end with
end function

'**** locate query on list linearly ****
function LinearQueryList( byref tList as ReplyList , sQuery as string ) as integer
  with tList
    for N as integer = 0 to .iCount-1
      if strcmp( sQuery , .tReplys(N).sWord ) = 0 then
        return N
      end if
    next N
    return -1
  end with
end function
'**** !!! REQUIRES SORTED LIST !!! *****
function BinaryQueryList( byref tList as ReplyList , sQuery as string ) as integer   
  with tList
    dim as integer iFirst=0 , iLast=.iCount-1
 
    #define sQueryL sQuery
    'Var sQueryL = lcase(sQuery)
 
    dim as integer iAttempts
 
    while iLast>=iFirst
      iAttempts += 1   
      var iMid = (iFirst+iLast+1)\2 'cint((iFirst+iLast)/2)
      var iResult = strcmp( sQueryL , .tReplys(.iAlphaIndex(iMid)).sWord )
      if iResult = 0 then
        'AttemptPrint "Attempts: " & iAttempts,
        return .iAlphaIndex(iMid)
      endif
      if iResult > 0 then iFirst = iMid+1 : continue while
      iLast = iMid-1   
    wend
    'AttemptPrint "Attempts: " & iAttempts
    return not ((iFirst+iLast+1)\2)
  end with
end function

'Add a word to a list
sub AddWord( byref tList as ReplyList , sWord as string )
  var sNewWord = lcase(sWord) 
  with tList
 
    #if 0
      print "------------------------------------"
      for N as integer = 0 to .iCount-1
        print .tReplys(.iAlphaIndex(N)).sWord , .tReplys(.iAlphaIndex(N)).iUses
      next N
      sleep
    #endif
 
    #ifdef AllowDuplicatedWords   
      var iIndex = -1
    #else
      #ifdef UseInsertionSort
        var iIndex = BinaryQueryList( tList , sNewWord )
      #else
        var iIndex = LinearQueryList( tList , sNewWord )
      #endif 
    #endif
 
    if iIndex < 0 then 'new word
   
      #if 0 'buffered new word list output
        scope 'buffered new word list output
          static as string sBuffer
          sBuffer += sNewWord+"'"
          if len(sBuffer)>(80*25) then
            print sBuffer : sBuffer = ""       
          end if
        end scope
      #endif
   
      if .iCount >= .iStorage then
        'if theres no more reserved entries then enlarge the array
        .iStorage = .iStorage+(.iStorage\2)+15 '15,37,70,120,195...
        redim preserve .tReplys(.iStorage)
        redim preserve .iUsageIndex(.iStorage)
        redim preserve .iAlphaIndex(.iStorage)
      end if
      .tReplys(.iCount).sWord = sNewWord 'word
      .tReplys(.iCount).iUses = 1
      .iUsageIndex(.iCount) = .iCount    'set new positon on indexes
   
      #ifdef UseInsertionSort
        iIndex = not iIndex   
        memmove(@.iAlphaIndex(iIndex+1) , @.iAlphaIndex(iIndex) , (.iCount-iIndex)*sizeof(.iAlphaIndex(0)))
        .iAlphaIndex(iIndex) = .iCount
      #else   
        .iAlphaIndex(.iCount) = .iCount
      #endif
   
      .iCount += 1 'one string added :)
   
    else 'world already exist
      .tReplys(iIndex).iUses += 1
    end if
  end with
end sub
'APPEND TO the STRING array the STRING item
sub sAppend(arr() as string , Item as string)
    'if the array is empty make it start as the lbound index not ubound (or 0 or 1, whatever...)
    var iUbound = iif( ubound(arr)<lbound(arr) , lbound(arr) , ubound(arr) )
    redim preserve arr(lbound(arr) to iUbound+1) as string
    arr(ubound(arr)) = Item
end sub

sub ParseSentence( byref tList as ReplyList , sSentence as string )   
    dim currentCaracter as ubyte
    dim WordSize as integer
    for i as integer = 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)     
        AddWord( tList , sWord )
      endif
      wordSize=0   
        end select       
    next i
end sub

randomize()

#if 0
  ' --------------------------- in this mode it loads the text file --------------------
  var f = freefile(), sLine = ""
  dim as double TMR = timer
  open "BibleKJV.txt" for input as #f
  while not eof(f)
    line input #f, sLine
    if len(sLine) then     
      ParseSentence( tReplys , sLine )     
      if abs(timer-TMR) > 1 then exit while
    end if
  wend
  close #f
 
  print
  print tReplys.iCount & " words added in " & timer-TMR & "s"
 
  TMR = timer
  with tReplys
    #ifndef UseInsertionSort
      'qSort(@.iAlphaIndex(0),.iCount,sizeof(.iAlphaIndex(0)),cast(any ptr,@QSortListAlpha)) ' runtime error
      SortListAlpha( tReplys )
    #endif
    'qSort(@.iUsageIndex(0),.iCount,sizeof(.iUsageIndex(0)),cast(any ptr,@QSortListUsage)) ' runtime error
    SortListUsage( tReplys )
  end with
  print "sort took " & timer-TMR & "s"
 
  with tReplys
    var iWords = .iCount-1
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(N).sWord;" ";
      if Pos() > 70 then exit for
    next N
    print 
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(.iAlphaIndex(N)).sWord;" ";
      if Pos() > 70 then exit for
    next N
    print
    for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
      print .tReplys(.iUsageIndex(N)).sWord;"(" & .tReplys(.iUsageIndex(N)).iUses & ")";
      if Pos() > 70 then exit for
    next N
    print
  end with
 
#else

  'in this mode it read from keyboard input

  'dim sReply as string
  dim ICountReply as integer = 1
  dim ans as string
  do
    line input "you: ", ans
    cls
    if len(ans)=0 then print "why the silence?": continue do
 
    sappend( sSentence() , ans )   
    ParseSentence( tReplys , ans )
 
    iCountReply += 1   
 
    #ifdef UseInsertionSort
      'qSort(@tReplys.iAlphaIndex(0),tReplys.iCount,sizeof(tReplys.iAlphaIndex(0)),cast(any ptr,@QSortListAlpha)) ' runtime error !
      SortListAlpha( tReplys ) 'bubble sort
    #endif
 
    'qSort(@tReplys.iUsageIndex(0),tReplys.iCount,sizeof(tReplys.iUsageIndex(0)),cast(any ptr,@QSortListUsage)) ' runtime error!
    SortListUsage( tReplys ) 'bubble sort

    with tReplys
      var iWords = .iCount-1
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(N).sWord;" ";
        if Pos() > 70 then exit for
      next N
      print 
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(.iAlphaIndex(N)).sWord;" ";
        if Pos() > 70 then exit for
      next N
      print 
      for N as integer = 0 to iWords 'iif(iWords>4,4,iWords)
        print .tReplys(.iUsageIndex(N)).sWord;"(" & .tReplys(.iUsageIndex(N)).iUses & ")";
        if Pos() > 70 then exit for
      next N 
      print
    end with
 
    'print sArrReplys(1) & " " & sArrReplys(2) & " " & sArrReplys(3) & " " & sArrReplys(4) & " " & sArrReplys(5)
    'print "ChatBot Aviv: " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & _
      'sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1)) & " " & sArrReplys(int(rnd*(ubound(sArrReplys))+1))
    'for i as integer = 1 to ubound(sArrReplys)
      'print sArrReplys(i)
    'Next
  loop until lcase(ans) = "quit"
 
#endif

'for i as integer = 1 to ubound(sSentence)
    'print sSentence(i)
'Next

sleep
Title: Re: chatbot aviv version 2
Post by: mysoft on Apr 15, 2022, 03:29 PM
ok i updated my post with the whole code reflecting the changes... indeed qsort must use "long ptr" instead of "integer ptr"