Rew, the smallest chatbot engine in perl

  • 4 Replies
  • 2425 Views
*

0JL

  • Trusty Member
  • *
  • Roomba
  • *
  • 21
    • thinkbots are free
Rew, the smallest chatbot engine in perl
« on: August 09, 2014, 09:18:08 am »
Hi,

I've just made the smallest chatbot engine I could think of. Probably not very fast, but here it is:

Code: [Select]

use Android;
use warnings;

my $droid = Android->new();

my %rule;



my $homedir = '/sdcard/sl4a/scripts';

open BF, "<$homedir/begin.rew";

{ local $/; eval <BF>; }

close BF;



sub think {

  for (keys %rule) {
 
    if ($_[0] =~ qr/$_/) {
   
      eval $rule{$_};
    }
  }
}



while (1) {

  print "\n> ";
 
  chomp(my $message = <STDIN>);
 
  think $message;

}


And it works! With an initial ruleset in file "begin.rew" like this:

Code: [Select]

$rule{'quit'}= ' exit(0); ';

$rule{'(.+) test (.+)'}= ' print "$1 ok $2"; ';

$rule{'hi'}= ' print "hey user"; ';


This baby works just fine :)

*

ivan.moony

  • Trusty Member
  • *********
  • Terminator
  • *
  • 757
  • look, a star is falling
Re: Rew, the smallest chatbot engine in perl
« Reply #1 on: August 09, 2014, 12:10:46 pm »
hehe, cool  ;D
Wherever you see a nice spot, plant another knowledge tree :favicon:

*

0JL

  • Trusty Member
  • *
  • Roomba
  • *
  • 21
    • thinkbots are free
Re: Rew, the smallest chatbot engine in perl
« Reply #2 on: August 11, 2014, 09:49:37 am »
 :) You can try it on SL4A. Here is version 2...


rew.pl
Code: [Select]

use Android;

my $droid = Android->new();



my $homedir = '/sdcard/sl4a/scripts';



sub say { print"\nBot> $_[0]\n"; }



sub new {

  $rule{$_[0]} = $_[1];
  $newrule{$_[0]} = $_[1];
}



sub del {

  delete $rule{$_[0]};
  delete $newrule{$_[0]};
}



sub load {

  my $fp = "$homedir/$_[0].rew";
 
  if (-e $fp) {
 
    open F, "<$fp";
    local $/; eval <F>;
    close F;
  }
}



sub keep {

  open F, ">>$homedir/current.rew";
 
  for (keys %newrule) {
 
    print F '$rule{q('
          . "$_" . ')} = q('
          . "$newrule{$_});\n\n";
  }
 
  close F;
}



sub save {

  keep;

  open CF, "<$homedir/current.rew";
  open F, ">>$homedir/$_[0].rew";
 
  print F <CF>;
 
  close F; close CF;
 
  unlink "$homedir/current.rew";

  say 'done';

}



sub think {

  for (keys %rule) {
 
    if ($_[0] =~ qr/$_/) {
   
      eval $rule{$_};
     
    }
  }
}



load 'initial';



while (1) {

  print "\nYou> ";
  chomp(my $message = <STDIN>);
 
  think $message;

}



... and its initial ruleset:


initial.rew
Code: [Select]

$rule{'^q$'}= ' keep; exit(0); ';

$rule{'^x (.+)'}= ' eval $1; ';

$rule{'^say (.+)'}= ' think "x say $1"; ';

load 'global';

load 'current';



Perl is definitely a cool language!





edit:

Here is a mini tutorial.



"Rew" is somewhere between a chatbot engine and a Perl command line interpreter.



If you enter "x something", then "something" will be executed by the Perl interpreter.

Example
Code: [Select]

You> x say 'hi'

Bot> hi




Rew is made of rules.

Any produced "thought" is matched against the entire ruleset.

Anything you enter is thought. Or you can use "think" to produce a thought.

Example
Code: [Select]

You> x think "I had a dream"




The trigger of a rule is a Perl string pattern (in a string).

The effect of firing a rule is some Perl code (in a string).

Use "new" to add new rules, with the trigger as 1st arg, and the fire-code as 2nd arg.

Example
Code: [Select]

You> x new '^hi$', 'say "hey user";'

You> hi

Bot> hey user




Use "keep" to save recently added rules in a file named "current.rew", or simply quit by typing 'q' which calls "keep" before exiting.

Example
Code: [Select]

You> x keep




Use "save" if you want to save rules from "current.new" in another file.

Example
Code: [Select]

You> x save 'myfile'




At startup, "initial.rew" is loaded, then "global.rew" and "current.rew". Use "load" to load other files.

Example
Code: [Select]

You> x load 'myfile'




That's it.

« Last Edit: August 11, 2014, 03:00:57 pm by 0JL »

*

0JL

  • Trusty Member
  • *
  • Roomba
  • *
  • 21
    • thinkbots are free
Re: Rew, the smallest chatbot engine in perl
« Reply #3 on: August 13, 2014, 03:20:04 pm »

Version 3

rew.pl
Code: [Select]

use Android;

my $droid = Android->new();

my $homedir = '/sdcard/sl4a/scripts';



sub hist {

  return $chatlog[$logcount-$_[0]-1];
}



sub say {
 
  push @chatlog, $_[0]; $logcount++;

  print"\nO  $_[0]\n";
}



sub new { $rule{$_[0]} = $_[1]; }

sub del { delete $rule{$_[0]}; }



sub load {

  my $fp = "$homedir/$_[0].rew";
 
  if (-e $fp) {
 
    open F, "<$fp";
    local $/; eval <F>;
    close F;
  }
}




sub save {

  unlink "$homedir/$_[0].rew";

  open F, ">>$homedir/$_[0].rew";
 
  for (keys %rule) {
 
    print F '$rule{q('
          . "$_" . ')} = q('
          . "$rule{$_});\n\n";
  }
 
  close F;
 
  say 'done';
 
}



sub thk {

  for (keys %rule) {
   
    if ($_[0] =~ qr/$_/) {
   
      eval $rule{$_};
   
    }
  }
}



load 'current';

$rule{'^s$'}=
  q( save 'current' );

$rule{'^t (.+) x (.+)$'}=
  q( new $1, $2 );

$rule{'^x (.+)'}=
  q( eval $1 );



while (1) {

  print "\nI  ";
  chomp(my $message = <STDIN>);
 
  push @chatlog, $message; $logcount++;
 
  thk $message;

}


*

0JL

  • Trusty Member
  • *
  • Roomba
  • *
  • 21
    • thinkbots are free
Re: Rew, the smallest chatbot engine in perl
« Reply #4 on: August 14, 2014, 03:29:01 pm »
Here comes version 4.0 [edit: 4.1]

Now we have associative rules with "ambient" thoughts, sequentially ordered thoughts, and a chatlog.

Here is the source code. As usually, you can run it with SL4A on your cellphone.



rew.pl
Code: [Select]

use Android;

my $droid = Android->new();

my $homedir = '/sdcard/sl4a/scripts';

my $rewversion = 'v4.1';



sub hist {

  return $chatlog[$logcount-$_[0]-1];
}



sub new { $rule{$_[0]} = $_[1]; }

sub del { delete $rule{$_[0]}; }



sub load {

  my $fp = "$homedir/$_[0].rew";
 
  if (-e $fp) {
 
    open F, "<$fp";
    local $/; eval <F>;
    close F;
  }
}



sub decamb {

  for (keys %ambient) {
 
    if ($ambient{$_}-- eq 0) {
   
      delete $ambient{$_};
     
    }
  }
}



sub associate {

  for (keys %ambient) {
 
    my $asso = "< $_[0] & $_ >";

    for (keys %rule) {
   
      if ($asso =~ qr/$_/) {
   
        eval $rule{$_};
     
      }
    }
  }
}



sub thk {

 associate $_[0];
 
 for (keys %rule) {
   
    if ($_[0] =~ qr/$_/) {
   
      eval $rule{$_};
     
    }
  }
}



sub say {
 
  push @chatlog, $_[0]; $logcount++;

  print"O  $_[0]\n";
}



sub save {

  unlink "$homedir/$_[0].rew";

  open F, ">>$homedir/$_[0].rew";
 
  for (keys %rule) {
 
    print F '$rule{q('
          . "$_" . ')} = q('
          . "$rule{$_});\n\n";
  }
 
  close F;
 
  say 'done';
 
}



sub aft { push @thoughtlist, $_[0]; }



sub amb { $ambient{$_[0]}= 5; }



sub unamb { delete $ambient{$_[0]}; }



load 'current';

$rule{'^user said s$'}=
  q(save 'current';);

$rule{'^user said t (.+) x (.+)'}=
  q(new $1, $2;);

$rule{'^user said x (.+)'}=
  q(eval $1;);



print "\n   Rew $rewversion   [ Perl "
    . $^V . " / SL4A ]\n\n\n   "
    . scalar(keys %rule) . " rules\n";



amb 'startup';



while (1) {

  print "\nI  ";
  chomp(my $message = <STDIN>);
 
  push @chatlog, $message; $logcount++;
 
  @thoughtlist=();
 
  aft "user said $message";
 
  for $tht (@thoughtlist) { thk $tht; }

  decamb;
 
}




So. You start with 3 rules, which are hard coded. One for saving your work, one for adding new rules, and one for evaluating Perl commands. You need to know Perl programming basics if you gonna use Rew.

Let's create a new rule to see our current ruleset:

Code: [Select]

   Rew v4.0   [ Perl v5.11.0 / SL4A ]
 
 
   3 rules
 
I  t ^show rules$ x for (keys %rule) { say "$_ => $rule{$_}"; }
 
I  show rules
O  ^t (.+) x (.+) => new $1, $2;
O  ^show rules$ => for (keys %rule) { say "$_ => $rule{$_}"; }
O  ^s$ => save 'current';
O  ^x (.+) => eval $1;
 
I




In Rew, rules are merely Perl pattern associated with Perl code.

Here we associate the pattern

^show rules$

with the code

for (keys %rule) { say "$_ => $rule{$_}"; }

It's all Perl, nothing more.

Now you can see our 4 rules.

First rule is "t something x something", which means that when the first "something" is thought, then the second "something" is executed.

Second rule is, YOU DO NOT TALK ABOUT no wait...



The t / x syntax is just sugar for the sub named "new". At some point, you'll want to create rules that create rules. When you get there, don't use the t / x syntax twice in the same statement: the interpreter wouldn't get it correctly. Instead, use t / x and then new, like this:

Code: [Select]

I  t ^nf x new '^foo (.+)', 'say "bar $1";'

I  foo test

I  nf

I  foo test
O  bar test




The sub named "say" obviously makes the bot speak.

The sub named "thk" makes it think something immediately. Any thought is matched against every rule in the current ruleset.

The sub named "aft" makes it think something, but only after the current thought has been matched against every rule, like this:

Code: [Select]

I  t bar x say 'ok';

I  t test x aft 'bar'; say 'foo';

I  test
O  foo
O  ok




Finally, the sub named "amb" will create a temporary "ambient" thought. Ambient thoughts are automatically associated with every produced thought, during 5 rounds. Associated thoughts are surrounded by '< ' and ' >', and separated by ' & '. See this example:

Code: [Select]

I  t (.+) x say "thinking [ $1 ]";

I  ju
O  thinking [ ju ]

I  x amb 'test'
0  thinking [ x amb 'test' ]

I  uy
O  thinking [ < uy & test > ]
O  thinking [ uy ]




And there's also the "hist" sub, to access things previously said.

Code: [Select]

I  foo

I  bar

I  x say hist 2
O  foo




That's it. Have fun!



edit:

This is version 4.1, with a new function "unamb" that deletes an ambient thought, and an ambient thought "startup" automatically launched at startup. Also, every user input is automatically prefixed with "user said ". My first 10 rules:

current.rew
Code: [Select]

$rule{q(^user said t (.+) x (.+))} = q(new $1, $2;);

$rule{q(^user said show rule (.+))} = q(my $trig= qr/$1/; for (keys %rule) { if ($_ =~ $trig) { say "$_ => $rule{$_}"; } });

$rule{q(^user said x (.+))} = q(eval $1;);

$rule{q(< user said (hi|hi there|hello) & startup >)} = q(say 'hello user';);

$rule{q(^user said show thoughts$)} = q(amb 'log';);

$rule{q(^user said show ruleset$)} = q(for (keys %rule) { say "$_ => $rule{$_}"; });

$rule{q(^user said s$)} = q(save 'current';);

$rule{q(< (.+) & log >)} = q(say "[ $1 ]";);

$rule{q(^user said show ambient$)} = q(for (keys %ambient) { say "$_"; });

$rule{q(^user said count rules$)} = q(say scalar(keys %rule) . ' rules';);

« Last Edit: August 16, 2014, 07:52:50 am by 0JL »

 


Raspberry Pi 3 Software Environment
by keghn (AI Programming)
October 20, 2017, 11:24:56 pm
The Banach–Tarski Paradox
by Maviarab (General Chat)
October 20, 2017, 05:35:12 pm
2D or not 2D...
by Maviarab (Graphics)
October 20, 2017, 05:16:30 pm
FFmpeg - individual frames to video
by keghn (Graphics and Video Software)
October 20, 2017, 04:45:11 pm
Help creating a name for a fake PDA from the 80's
by Art (General Project Discussion)
October 20, 2017, 02:33:54 pm
Can you Handle a Mandel (brot)?
by ranch vermin (Graphics)
October 20, 2017, 02:12:16 pm
XKCD Comic : Cast Iron Pan
by Tyler (XKCD Comic)
October 20, 2017, 12:02:13 pm
home robots
by Freddy (New Users Please Post Here)
October 20, 2017, 03:10:00 am

Users Online

38 Guests, 0 Users

Most Online Today: 55. Most Online Ever: 208 (August 27, 2008, 09:36:30 am)

Articles