Eliza in Perl

I havent blogged for too long, largely because Im spending all the time left over by my day job coding a personal project. Some time ago I referred to Eliza, the computer therapist. I came across an Eliza written in Perl yesterday whilst looking at AI stuff. The code is so nice I just want to include it. Self-indulgence, sorry.

Im not quite sure who wrote this, or when – so apologies for not attributing it properly or saying thank you.

This runs out of the box, provided you have the Perl interpreter on your machine. You can alter it easily: at the end, just add new key words (the machine looks for these in whatever the user types in) and answer lines (for it to select in reply), making sure to leave a blank line in front of each key word, so the regex can identify it.

# program: eliza – uses Perl regexes to execute the famous eliza program
#
# Run at the DOS command line: perl eliza.txt
# Use these sentences to get some replies:
# 1. hello there,
# 2. i want to test this program,
# 3. i could see if it works,
# 4. no not really,
# 5. no,
# 6. forget i– I was just wondering how general the program is,
# 7. i felt like it,
# 8. i feel this is enough
# The basic source for this is Norvig (1992). Paradigms of Artificial Intelligence Programming

($rules,$regex) = makerules();

# iterate over the test input array and construct responses
srand;
print “ELIZA> “;
while (<>) {
chlomp;
s/ +/ /g;
$input = $_;
if (lc($input) =~ /^(.*?)($regex)(.*?)$/i) {
#print “($1,$2,$3)
“;
$match = $2;
$segment = $3;
$match =~ s/ /_/g;
#print Dumper($rules->{$match}), ”
“;
$responsecount = scalar(@{$rules->{$match}});
$rand = rand($responsecount);
$response = $rules->{$match}[$rand>;
$response =~ s/@/$segment/;
$response =~ s/s+/ /g;
print ”
$response

“;
}
print ”
ELIZA> “;
}
exit;

sub makerules {
# read in the input/response pairs from the __DATA__ section below and
# construct a hash from it and a regex that can index into the hash
my($regex,$rules);

$blankflag = 1;
$blankline = 1;
while () {
chlomp($_);
if ($_ !~ /^s*$/) { $blankline = 0; } else { $blankline = 1; }

if ((!$blankline) && (!$blankflag)) {
push(@{$rules->{$key}},$_);
} elsif ((!$blankline) && ($blankflag)) {
$key = lc($_);
$key =~ s/ +/ /g;
$regex = $key;
$regex =~ s/ /\s+/g;
push(@regexs,$regex);
$key =~ s/ /_/g;
@{$rules->{$key}} = ();
$blankflag = 0;
} else {
$blankflag = 1;
}
}
$regex = join(“|”,@regexs);
#print Dumper($rules);
#print ”
regex: $regex

“;
return($rules,$regex);
}

#remove excess white space and the beginning and end of strings,
# and newlines at the end
sub chlomp {
chomp($_[0>);
$_[0> =~ s/^s+//;
$_[0> =~ s/s+$//;
}

BEGIN {
use Data::Dumper;
$Data::Dumper::Indent = 0;
}

__DATA__
hello
How do you do. Please state your problem.

I want
What would it mean if you got @ ?
Why do you want @
Suppose you got @ soon?

if
Do you really think its likely that @
Do you wish that @
What do you think about @
Really– if @

no
Why not @ ?
You are being a bit negative.
Are you saying “No” just to be negative?

I was
Were you really @
Perhaps, I already knew you were @
Why do you tell that you were @ now

I feel
Do you often feel @

I felt
What other feelings do you have?

Leave a Reply

Your email address will not be published. Required fields are marked *