Multi-lingual Chatbot

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
angros47
Posts: 1437
Joined: Jun 21, 2005 19:04

Multi-lingual Chatbot

Postby angros47 » Apr 20, 2011 23:12

I found this:
http://www.blitzbasic.com/Community/posts.php?topic=51264

This chatbot will learn a language from you. At first, it will repeat whatever you say, then it will start to build new sentences.

Here is a FreeBasic port:

Code: Select all

Type Word
   Txt as string
   Link(256) as Word ptr
   LinkStrength(256) as integer
   Links as integer
   nex as word ptr
   prev as word ptr
End Type

dim shared word_first as word ptr=0

sub AddWord(word as string)
   dim t as word ptr=word_first

   dim ot as word ptr


   do until t=0
      ot=t
      If t->Txt = word Then Return 'word is already in memory
      t=t->nex
   loop

   dim WWord as word ptr= New Word
   wword->Txt = word
   wword->Links = 0
   if word_first=0 then word_first=wword else ot->nex=wword
End sub

Sub AddLink(word as string, linkword as string)
   'Get the objects for the words specified
   dim t as word ptr=word_first


   do until t=0
      If t->Txt = word Then exit do
      t=t->nex
   loop
   If t = 0 Then exit sub
   dim WWord as word ptr=t

   t=word_first
   do until t=0
      If t->Txt = linkword Then exit do
      t=t->nex
   loop
   If t = 0 Then exit sub
   dim link as word ptr=t


   'Does the link exist?
   dim as integer i, exists = 0
   For i = 1 To wword->Links
      If wword->Link(i) = link Then exists = -1: Exit for
   Next
   
   'If link exists, strengthen it
   If exists = -1 Then
      wword->LinkStrength(i) = wword->LinkStrength(i) + 1
   End If
   
   'If link does not exist, add it
   If exists = 0 Then
      wword->Links = wword->Links + 1
      wword->Link(wword->Links) = link
      wword->LinkStrength(wword->Links) = 1
   End If
   
End sub

'Weaken all word links for the specified word. Using "decay" for word links allows old unused
'words (such as mis-spelled words) to be forgotten.
sub Decay(word as Word ptr)
   For i as integer = 1 To word->Links
      word->LinkStrength(i) = word->LinkStrength(i) - 1
      
      If word->LinkStrength(i) = 0 Then
         word->LinkStrength(i) = word->LinkStrength(word->Links)
         word->Link(i) = word->Link(word->Links)
         word->Link(word->Links) = 0
         word->LinkStrength(word->Links) = 0
         word->Links = word->Links - 1
         i = i - 1
      End If
   Next
End sub

'Generate a rely for the given sentance
Function Reply(s as string) as string
   dim word(256) as string
   dim as integer words = 1, count
   dim as string m

   'Split to words
   For i as integer = 1 To Len(s)
      m = Mid(s, i, 1)
      If m = " " Then
         If word(words) <> "" Then words = words + 1
      Else
         If m <> "." And m <> "," And m <> "!" And m <> "?" Then word(words) = word(words) + m
      End If
   Next

   If words = 1 And word(1) = "" Then
      words = 0
   Else
      words = words + 1
      word(words) = "."
   End If
   
   'Remember the words and their relationships
   For i as integer = 1 To words
      AddWord(lcase(word(i)))
      If i > 1 Then AddLink(lcase(word(i-1)), lcase(word(i)))
   Next

   'If nothing is in memory, return blank
   dim t as word ptr=word_first


   If t = 0 Then Return ""
   
   'Pick a keyword for the reply

   If words = 0 Then
      'Pick a word at random
      count = 0
      do until t=0:t=t->nex: count = count + 1: loop
      dim as integer pick = int(Rnd(1)* count) +1
      t= word_first
      For i as integer = 2 To pick
         t = t->nex
      Next
   Else
      'Pick a word the user used that has the least links
      dim as integer maxlinks = 100000
      dim as word ptr maxword=0

      For i as integer = 1 To words
         dim as string lw = Lcase(word(i))
         t =word_first


         do until t=0
            If t->Txt = lw Then Exit do
            t=t->nex
         loop
         If t->Links > 0 And t->Links < maxlinks Then maxlinks = t->Links: maxword = t
      Next
      t = maxword
   End If
   
   'Generate a sentance
   dim as string outp = "": dim as integer done = 0
   While done = 0
      outp = outp + t->Txt + " "
      If t->Txt = "." Then
         done = -1
      Else
         dim as integer pick, pick2
         pick = int(Rnd(1)* t->Links)+1
         pick2 = int(Rnd(1)* t->Links)+1

         If t->LinkStrength(pick) > t->LinkStrength(pick2) Then t = t->Link(pick) Else t = t->Link(pick2)
      End If
   Wend
   
   'Decay
   If s = "" Then
      'For t.Word = Each Word
      '   Decay(t)
      'Next
   End If
   
   Return outp
   
End Function



do
   dim x as string
   input x
   print reply(x)
loop


Here is a sample:
? Hello
hello .
? Do you like freebasic?
do you like freebasic .
? I like programming in freebasic
i like programming in freebasic .
? Freebasic is a good language
is a good language .
? Do you think so?
do you like freebasic .
? Yes, I do
yes .
? Do you like programming?
do you like programming .
? What about programming?
what about programming .
? Are you just repeating what I am saying?
are you like programming .
? No, I am not.
no .
? What about you?
what about you like programming .
? I like
i like .
? Do you like what?
do you like programming .
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Apr 22, 2011 13:30

Ooh. This is cool. This may be an interesting and fun way to get words into my sentence generator. Thanks!
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Postby kiyotewolf » May 27, 2011 6:24

O.O YOU JUST MADE A SIMPLISTIC NN!



:M

Oly uck I just realized what I was looking at!
pestery
Posts: 493
Joined: Jun 16, 2007 2:00
Location: Australia

Postby pestery » May 29, 2011 14:19

Cool
Landeel
Posts: 676
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Postby Landeel » May 29, 2011 19:10

Very interesting!
E.K.Virtanen
Posts: 785
Joined: May 28, 2005 9:19
Location: Finland

Postby E.K.Virtanen » May 31, 2011 8:21

Nice one angros47 :)
TJF
Posts: 3438
Joined: Dec 06, 2009 22:27
Location: N47°, E15°

Postby TJF » Jun 03, 2011 8:08

It seems that chengliu used this code to make a spambot.
[And the Moderator trashed them. Thanks]
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Postby kiyotewolf » Jun 03, 2011 19:17

It seems that chengliu used this code to make a spambot.


You make it sound as if we have absolute control over the users in this forum, and how they behave outside FB_Forum space.



:M

Block/Ban chengliu then?
Richard
Posts: 2898
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Jun 03, 2011 20:46

Spam cleanup is a continuous process. chengliu's spam posts lasted only about 15 minutes. chengliu was not the only spammer.

Spam is like graffiti or broken windows, like begets like. Most spam cleanup by moderators is invisible to most members. All spammers get banned.

If moderators fail to remove some spam within about 6 hours, do not reply to the spam post as your post hides the spammer in the thread, it will give the spam credibility with your name on the end of the thread. Instead start another thread in the same forum with a post title of [spam] and containing a link to the spam or the name of the spammer. Your warning post will be removed immediately the spam is deleted.
angros47
Posts: 1437
Joined: Jun 21, 2005 19:04

Postby angros47 » Sep 02, 2011 23:17

One chatbot can do a lot, but two of them....

Have a look at this:

http://gizmodo.com/5835312/two-chatbots-face-off-to-discuss-god-unicorns-and-experience-sexual-tension

I'm wondering if Cleverbot works in the same way of this one... it seems to be able to learn from sentences, in a similar way.
TESLACOIL
Posts: 1769
Joined: Jun 20, 2010 16:04
Location: UK
Contact:

Postby TESLACOIL » Sep 11, 2011 17:03

if a chat box similar to this was fed a sufficiently large number of examples it would start to take on a verbal life of its own

very large feed + a few loose filters would do the trick

you can fit a lot of sentences and phrases on a terabyte hard drive !
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Sep 12, 2011 12:00

Isn't this how babies learn? Monkey see. Monkey do. Then innovate.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest