[0JL]

Hi,

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

Code

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

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

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

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

This baby works just fine

[ivan.moony]

hehe, cool 

[0JL]

  You can try it on SL4A. Here is version 2...


rew.pl

Code

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

$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

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

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

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

You> x keep

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

Example

Code

You> x save 'myfile'

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

Example

Code

You> x load 'myfile'

That's it.

[0JL]

Version 3

rew.pl

Code

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]

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

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

   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

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

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

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

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

$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';);