Subject: | Patch to return reasmbs in order |
Hi John,
Thanks for this great, single-file Perl module implementation of Eliza. :)
I have a very nerdy fix: In Wizenbaum's paper, at least according to page 5 in this scan (http://www.cse.buffalo.edu/~rapaport/572/S02/weizenbaum.eliza.1966.pdf), the reassembly rules are to be processed in sequence, not randomly (which allows the script writer more control so the output can make more sense, e.g. "I've told you that apologies are not required.").
I've attached a patch that replaces the random selection with a sequential one.
Grant
Subject: | chatbot-eliza-patch.txt |
--- /Library/Perl/5.18/Chatbot/Eliza.pm 2015-10-29 17:58:05.000000000 -0500
+++ ./Chatbot-Eliza.pm 2017-03-11 21:37:14.000000000 -0600
@@ -765,23 +765,10 @@
# Get the list of possible reassembly rules for this key.
#
- if (defined $use_memory and $#{ $self->{reasmblist_for_memory}->{$reasmbkey} } >= 0) {
-
- # If this transform function was invoked with the memory flag,
- # and there are in fact reassembly rules which are appropriate
- # for pulling out of memory, then include them.
- @these_reasmbs = @{ $self->{reasmblist_for_memory}->{$reasmbkey} }
-
- } else {
-
- # Otherwise, just use the plain reassembly rules.
- # (This is what normally happens.)
- @these_reasmbs = @{ $self->{reasmblist}->{$reasmbkey} }
- }
-
- # Pick out a reassembly rule at random.
- $reasmb = $these_reasmbs[ int &{$self->{myrand}}( scalar @these_reasmbs ) ];
+ my $memory = (defined $use_memory and $#{ $self->{reasmblist_for_memory}->{$reasmbkey} } >= 0);
+ # Pick out next reassembly rule.
+ $reasmb = $self->_get_next_reasmb( $reasmbkey, $memory);
$self->debug_text($self->debug_text . sprintf "\t\t--> $reasmb\n");
# If the reassembly rule we picked contains the word "goto",
@@ -909,6 +896,25 @@
return $reasmb ;
}
+# _get_next_reasmb( $key, $memory_flag )
+#
+# Given a key to a reasmb list and a flag indicating whether the list should
+# be pulled from a memory list or standard script list, returns the
+# next reasmb in the list, wrapping back to the start if the last one
+# is reached.
+sub _get_next_reasmb {
+ my ( $self, $reasmbkey, $memory ) = @_;
+
+ my $for_memory = $memory ? '_for_memory' : '';
+ my @these_reasmbs = @{ $self->{"reasmblist$for_memory"}->{$reasmbkey} };
+ my $next_reasmb = $self->{"next_reasmblist$for_memory"}->{$reasmbkey}++;
+ if ( $next_reasmb > scalar( @these_reasmbs ) ) {
+ $next_reasmb = 1;
+ $self->{"next_reasmblist$for_memory"}->{$reasmbkey} = 0;
+ }
+
+ return $these_reasmbs[$next_reasmb - 1];
+}
####################################################################
# --- parse_script_data ---