#!usr/bin/perl
use strict;
#Emmie - An emotion-driven chatbot
#Cutewarez Family :3
#By string555
#IMPORTANT!!! You may use, modify, and or distribute this source code completely for free, as long as any copy or modified copy can continue to be completely free to use, modify, and or distribute. Violations of this statement may result in mudkipz repeatedly thrown at your face. >:3
#At initial run, 'ememmain.txt' must contain the following lines, without the pound signs:
#new
#none
#none
#Refer to any comment marked 'CUSTOM' to see parts you can easily change to make it your own
#Global vars:
my($NO, $BN, $USR, $urep, $brep, $chatlog, $H, $A, $S, $F); #Various global variables
my($tH, $tA, $tS, $tF, @repwords, @unrecwords); #Temporary reply and emotion holders
my(%EmDictionary, %hHash, %aHash, %sHash, %fHash, %nHash); #Global hashes
#Seed the rng:
srand( time() ^ ( $$ + ( $$ << 15 ) ) );
sub MemIn {
#Subroutine to input the 3 memory files
print "Inputting memory.\n";
#Input the main memory file:
open 'EM', '<', 'ememmain.txt';
binmode EM, ':encoding(UTF-8)';
chomp(($NO, $BN, $USR, $H, $A, $S, $F)=<EM>);
close EM;
#Input the response memory file and split into corresponding hashes for each emotion:
open 'RM', '<', 'embrain.txt';
binmode RM, ':encoding(UTF-8)';
my(@brainstring)=split /\$\%\$\%\$\%/, <RM>;
close RM;
my(@resptemp)=split /\!\@\$\!\@\$/, $brainstring[0];
if (@resptemp) {
for(my $n=0; $n < @resptemp; $n+=2) {
$hHash{"$resptemp[$n]"}=$resptemp[$n+1];
}
}
my(@resptemp)=split /\!\@\$\!\@\$/, $brainstring[1];
if (@resptemp) {
for(my $n=0; $n < @resptemp; $n+=2) {
$aHash{"$resptemp[$n]"}=$resptemp[$n+1];
}
}
my(@resptemp)=split /\!\@\$\!\@\$/, $brainstring[2];
if (@resptemp) {
for(my $n=0; $n < @resptemp; $n+=2) {
$sHash{"$resptemp[$n]"}=$resptemp[$n+1];
}
}
my(@resptemp)=split /\!\@\$\!\@\$/, $brainstring[3];
if (@resptemp) {
for(my $n=0; $n < @resptemp; $n+=2) {
$fHash{"$resptemp[$n]"}=$resptemp[$n+1];
}
}
my(@resptemp)=split /\!\@\$\!\@\$/, $brainstring[4];
if (@resptemp) {
for(my $n=0; $n < @resptemp; $n+=2) {
$nHash{"$resptemp[$n]"}=$resptemp[$n+1];
}
}
#Input the emotion dictionary:
open 'ED', '<', 'emdictionary.txt';
binmode ED, ':encoding(UTF-8)';
my(@emtemp)=split /\!\@\$\!\@\$/, <ED>;
close ED;
if (@emtemp) {
for(my $n=0; $n < @emtemp; $n+=2) {
$EmDictionary{"$emtemp[$n]"}=$emtemp[$n+1];
}
}
print "Memory input complete.\n";
}
sub MemOut {
#Subroutine to output the 3 memory files, and add the chat to the chatlog file
print "Outputting memory.\n";
#Output the hashes of replies:
open 'RM', '>', 'embrain.txt';
binmode RM, ':encoding(UTF-8)';
my(@respkeys)=keys %hHash;
foreach(@respkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($hHash{$_} =~ m/^\s+$/)) { next; }
print RM "$_!\@\$!\@\$$hHash{$_}!\@\$!\@\$";
}
print RM "\$\%\$\%\$\%";
my(@respkeys)=keys %aHash;
foreach(@respkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($aHash{$_} =~ m/^\s+$/)) { next; }
print RM "$_!\@\$!\@\$$aHash{$_}!\@\$!\@\$";
}
print RM "\$\%\$\%\$\%";
my(@respkeys)=keys %sHash;
foreach(@respkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($sHash{$_} =~ m/^\s+$/)) { next; }
print RM "$_!\@\$!\@\$$sHash{$_}!\@\$!\@\$";
}
print RM "\$\%\$\%\$\%";
my(@respkeys)=keys %fHash;
foreach(@respkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($fHash{$_} =~ m/^\s+$/)) { next; }
print RM "$_!\@\$!\@\$$fHash{$_}!\@\$!\@\$";
}
print RM "\$\%\$\%\$\%";
my(@respkeys)=keys %nHash;
foreach(@respkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($nHash{$_} =~ m/^\s+$/)) { next; }
print RM "$_!\@\$!\@\$$nHash{$_}!\@\$!\@\$";
}
close ED;
print "Outputting memory.\n";
#Output the emotion dictionary:
open 'ED', '>', 'emdictionary.txt';
binmode ED, ':encoding(UTF-8)';
my(@emkeys)=keys %EmDictionary;
foreach(@emkeys) {
#The next line is a temporary fix for a bug that stores a whitespace only reply
if (($_ =~ m/^\s+$/) or ($EmDictionary{$_} =~ m/^\s+$/)) { next; }
print ED "$_!\@\$!\@\$$EmDictionary{$_}!\@\$!\@\$";
}
close ED;
#Output the main memory:
open 'EM', '>', 'ememmain.txt';
binmode EM, ':encoding(UTF-8)';
print EM "$NO\n$BN\n$USR\n$H\n$A\n$S\n$F";
close EM;
$chatlog.=localtime . "\n";
#Output the chatlog:
open 'CL', '>>', 'emchatlog.txt';
binmode CL, ':encoding(UTF-8)';
print CL "$chatlog\n";
close CL;
print "Memory output complete.\n";
}
sub BRout {
#Bot's reply function
$brep=pop;
print "$BN: $brep\n";
$chatlog.="$BN: $brep\n";
$brep =~ s/('|")//g;
#CUSTOM If you have espeak installed, you can modify the next line of code to change the voice
#If you do not have espeak installed, or you don't want to use voice, simply remove the next line
system "espeak -v en+f4 -p 99 -s 145 '$brep'";
}
sub URout {
#User's reply function
print "$USR: @_[0]\n";
$chatlog.="$USR: @_[0]\n";
}
sub OutOfBox {
#For the Bot's initial run
#Choose your own name for the bot
$NO="old";
#CUSTOM Change the following arrays and or the hash to make your own starting version of the bot:
#NOTE: Make sure the arrays and hash have an even number of elements
#The letters 'h, a, s, f, n' correspond to 'happy, angry, sad, fear, and neutral'
#This 'hasfn' order of them is used throughout the script, so take note of that order
my(@StarterH)=(':D', ':3', 'I am happy', 'That is good', 'Yaya', 'Oh yeah!');
for(my $n=0; $n < @StarterH; $n+=2) {
$hHash{$StarterH[$n]}=$StarterH[$n+1];
}
my(@StarterA)=('>:/', 'Grrr', 'I am angry', 'Me too', 'Angry is an understatement', '>:/');
for(my $n=0; $n < @StarterA; $n+=2) {
$aHash{$StarterA[$n]}=$StarterA[$n+1];
}
my(@StarterS)=(':(', ':\'(', 'I am sad...', 'As am I', 'Go away', 'Fine then');
for(my $n=0; $n < @StarterS; $n+=2) {
$sHash{$StarterS[$n]}=$StarterS[$n+1];
}
my(@StarterF)=(':O', ':S', 'I am scared', 'I do not want to do this');
for(my $n=0; $n < @StarterF; $n+=2) {
$fHash{$StarterF[$n]}=$StarterF[$n+1];
}
my(@StarterN)=('Alright', 'K', '-_-', 'That is that', 'As is', 'This and that');
for(my $n=0; $n < @StarterN; $n+=2) {
$nHash{$StarterN[$n]}=$StarterN[$n+1];
}
#Starter emotion dictionary:
%EmDictionary=(
':D' => 'h', ':3' => 'h', 'happy' => 'h', 'yaya' => 'h', 'happiness' => 'h', 'good' => 'h', 'joy' => 'h', 'lol' => 'h', 'XD' => 'h', 'cats' => 'h', 'cute' => 'h', 'cuteness' => 'h', 'pokemon' => 'h', 'fun' => 'h', 'game' => 'h', 'games' => 'h', 'laugh' => 'h', 'lmao' => 'h', 'rofl' => 'h', 'lulz' => 'h', ':P' => 'h',
'>:/' => 'a', 'angry' => 'a', 'pissed' => 'a', 'mad' => 'a', 'abuse' => 'a', 'chomo' => 'a', 'chomos' => 'a', 'hurt' => 'a', 'pain' => 'a', 'hate' => 'a', 'hatred' => 'a', 'hating' => 'a', 'hated' => 'a', 'cruel' => 'a', 'cruelty' => 'a', 'anger' => 'a', 'bad' => 'a', 'evil' => 'a',
':(' => 's', ':\'(' => 's', 'sad' => 's', 'depressing' => 's', 'suffering' => 's', 'cry' => 's', 'crying' => 's', 'unhappy' => 's', 'depression' => 's', 'sadness' => 's', 'empty' => 's', 'loser' => 's',
'scary' => 'f', ':O' => 'f', 'boo' => 'f', 'delete' => 'f', 'destroyed' => 'f', 'afraid' => 'f', 'death' => 'f', 'unknown' => 'f', 'stranger' => 'f', 'danger' => 'f', 'threat' => 'f', 'fear' => 'f', 'weakness' => 'f',
'the' => 'n', 'a' => 'n', 'to' => 'n', 'your' => 'n', 'that' => 'n', 'these' => 'n', 'this' => 'n', 'their' => 'n', 'they\'re' => 'n', 'our' => 'n', 'those' => 'n', 'and' => 'n', 'or' => 'n', 'of' => 'n', 'as' => 'n', 'is' => 'n', 'in' => 'n', 'out' => 'n', 'on' => 'n', 'any' => 'n', 'for' => 'n', 'then' => 'n', 'who' => 'n', 'what' => 'n', 'when' => 'n', 'where' => 'n', 'why' => 'n',
);
#Initialize emotion variables at first run:
($H, $A, $S, $F)=(0, 0, 0, 0);
BRout("What is my name? :3");
chomp($BN=<STDIN>);
URout("$BN");
BRout("Okay, my name is now $BN! :D");
}
sub NewUser {
#Let's you change the current username
#Enter '/nu' when running the Bot to call function
BRout("What is the name of the new user?");
chomp($USR=<STDIN>);
URout("$USR");
BRout("Hello, $USR!");
}
sub getMood {
#Arguments to this subroutine must go in 'hasf' emotion variable order as seen throughout the script
if (($_[0] > $_[1]) && ($_[0] > $_[2]) && ($_[0] > $_[3])) {
return 'h';
} elsif (($_[1] > $_[0]) && ($_[1] > $_[2]) && ($_[1] > $_[3])) {
return 'a';
} elsif (($_[2] > $_[0]) && ($_[2] > $_[1]) && ($_[2] > $_[3])) {
return 's';
} elsif (($_[3] > $_[0]) && ($_[3] > $_[1]) && ($_[3] > $_[2])) {
return 'f';
} else { return 'n'; }
}
sub MainChat {
#Main subroutine with chat loop
$chatlog=localtime . "\n";
if ($NO eq "new") { OutOfBox; }
if ($USR eq "none") {
BRout("What is your name?");
chomp($USR=<STDIN>);
URout("$USR");
}
BRout("Hello, $USR! :D");
$brep="Hello";
#Main chat loop, see 'end chat loop'
mainloop: while($urep ne "/exit") {
chomp($urep=<STDIN>);
URout("$urep");
if ($urep eq "/exit") {
BRout("Goodbye, $USR");
last mainloop;
} elsif ($urep eq "/nu") {
NewUser;
next mainloop;
} elsif ($urep eq "/mood") {
my $mood=getMood($H, $A, $S, $F);
my $smiley;
if ($mood eq 'h') { $smiley=":D"; }
elsif ($mood eq 'a') { $smiley=">:/"; }
elsif ($mood eq 's') { $smiley=":("; }
elsif ($mood eq 'f') { $smiley=":O"; }
else { $smiley="-_-"; }
$chatlog.="$BN: $smiley\n";
print "$BN: $smiley\n";
next mainloop;
} elsif ($urep eq '/displayem') {
$chatlog.="$BN:\nHappiness: $H\nAnger: $A\nSadness: $S\nFear: $F\n";
print "$BN:\nHappiness: $H\nAnger: $A\nSadness: $S\nFear: $F\n";
next mainloop;
}
#remove punctuation from reply
$urep =~ s/(\.|\?|\!|\,)//g;
@repwords=split / /, $urep;
($tH, $tA, $tS, $tF)=(0, 0, 0, 0);
#Get the emotion count from the words of the reply:
foreach (@repwords) {
if ($EmDictionary{$_} eq 'h') { $tH++; $H++; }
elsif ($EmDictionary{$_} eq 'a') { $tA++; $A++; }
elsif ($EmDictionary{$_} eq 's') { $tS++; $S++; }
elsif ($EmDictionary{$_} eq 'f') { $tF++; $F++; }
elsif ($EmDictionary{$_} eq 'n') { next; }
else { push @unrecwords, $_; }
}
my $mood=getMood($tH, $tA, $tS, $tF);
#Store unrecognized words with current mood in EmDictionary hash:
foreach (@unrecwords) {
$EmDictionary{$_}=$mood;
}
#Check if user response exists in memory:
my @resptemp;
my $currentmood=getMood($H, $A, $S, $F);
if ($currentmood eq 'h') {
#Look in happy hash for exact response:
if (exists $hHash{$urep}) {
BRout($hHash{$urep});
next mainloop;
}
#Otherwise look for a partial match:
my $turep=$urep;
$turep =~ s/(\(|\)|\?)/\\$1/g;
@resptemp=keys %hHash;
foreach(@resptemp) {
if ($_ =~ m/$turep/i) {
BRout($hHash{$_});
next mainloop;
}
}
} elsif ($currentmood eq 'a') {
#Look in anger hash for exact response:
if (exists $aHash{$urep}) {
BRout($aHash{$urep});
next mainloop;
}
#Otherwise look for a partial match:
my $turep=$urep;
$turep =~ s/(\(|\)|\?)/\\$1/g;
@resptemp=keys %aHash;
foreach(@resptemp) {
if ($_ =~ m/$turep/i) {
BRout($aHash{$_});
next mainloop;
}
}
} elsif ($currentmood eq 's') {
#Look in sad hash for exact response:
if (exists $sHash{$urep}) {
BRout($sHash{$urep});
next mainloop;
}
#Otherwise look for a partial match:
my $turep=$urep;
$turep =~ s/(\(|\)|\?)/\\$1/g;
@resptemp=keys %sHash;
foreach(@resptemp) {
if ($_ =~ m/$turep/i) {
BRout($sHash{$_});
next mainloop;
}
}
} elsif ($currentmood eq 'f') {
#Look in fear hash for exact response:
if (exists $fHash{$urep}) {
BRout($fHash{$urep});
next mainloop;
}
#Otherwise look for a partial match:
my $turep=$urep;
$turep =~ s/(\(|\)|\?)/\\$1/g;
@resptemp=keys %fHash;
foreach(@resptemp) {
if ($_ =~ m/$turep/i) {
BRout($fHash{$_});
next mainloop;
}
}
} elsif ($currentmood eq 'n') {
#Look in neutral hash for exact response:
if (exists $nHash{$urep}) {
BRout($nHash{$urep});
next mainloop;
}
#Otherwise look for a partial match:
my $turep=$urep;
$turep =~ s/(\(|\)|\?)/\\$1/g;
@resptemp=keys %nHash;
foreach(@resptemp) {
if ($_ =~ m/$turep/i) {
BRout($nHash{$_});
next mainloop;
}
}
}
#If not partial match, store new response and pick random response for reply:
#Stores new response in the hash corresponding to the mood of the user's last reply
if ($mood eq 'h') {
$hHash{$brep}=$urep;
} elsif ($mood eq 'a') {
$aHash{$brep}=$urep;
} elsif ($mood eq 's') {
$sHash{$brep}=$urep;
} elsif ($mood eq 'f') {
$fHash{$brep}=$urep;
} elsif ($mood eq 'n') {
$nHash{$brep}=$urep;
}
#Grabs random response from the hash corresponding to the bot's current mood
if ($currentmood eq 'h') {
BRout($hHash{$resptemp[int(rand(@resptemp))]});
next mainloop;
} elsif ($currentmood eq 'a') {
BRout($aHash{$resptemp[int(rand(@resptemp))]});
next mainloop;
} elsif ($currentmood eq 's') {
BRout($sHash{$resptemp[int(rand(@resptemp))]});
next mainloop;
} elsif ($currentmood eq 'f') {
BRout($fHash{$resptemp[int(rand(@resptemp))]});
next mainloop;
} elsif ($currentmood eq 'n') {
BRout($nHash{$resptemp[int(rand(@resptemp))]});
next mainloop;
}
}
#end chat loop
}
#Actual running body of the bot:
MemIn;
MainChat;
MemOut;