{===========================================================================================}
{ Program Name: Chatterbot5 }
{ Description: The purpose of this program is to improve the previous implementation of }
{ this program (chatterbot4). The code for this one is encapsulated into a class. }
{ Most of the functionalities of the program are implemented by using functions. }
{ }
{ Author: Gonzales Cenelia }
{ Date: 9 july 2009 }
{===========================================================================================}
program Chatterbot5;
const
NumOfRecords = 42;
NumOfInput = 1;
NumOfResponse = 3;
delim = '?!.;,';
type
sList = array[1 .. NumOfResponse] of string;
sList2 = array[1 .. NumOfResponse + 1] of string;
type
StringArray = array[1 .. NumOfRecords, 1 .. (NumOfResponse + 1)] of string;
type
CBot = record
sBotName : string;
sUserName : string;
sInput : string;
sResponse : string;
sPrevInput : string;
sPrevResponse : string;
sEvent : string;
sPrevEvent : string;
sInputBackup : string;
bQuitProgram : boolean;
ListOfResponse : sList;
end;
var
Chatbot : Cbot;
const
KnowledgeBase : StringArray = (
('WHAT IS YOUR NAME',
'MY NAME IS CHATTERBOT5.',
'YOU CAN CALL ME CHATTERBOT5.',
'WHY DO YOU WANT TO KNOW MY NAME?'
),
('HELLO',
'HI THERE!',
'HELLO, HOW ARE YOU?',
'HI, HOW ARE YOU DOING TODAY?'
),
('HI',
'HI THERE!',
'HOW ARE YOU?',
'HI!'
),
('HOW ARE YOU',
'I''M DOING FINE!',
'I''M DOING WELL AND YOU?',
'WHY DO YOU WANT TO KNOW HOW AM I DOING?'
),
('WHO ARE YOU',
'I''M AN A.I PROGRAM.',
'I THINK THAT YOU KNOW WHO I''M.',
'WHY ARE YOU ASKING?'
),
('ARE YOU INTELLIGENT',
'YES,OFCORSE.',
'WHAT DO YOU THINK?',
'ACTUALY,I''M VERY INTELLIENT!'
),
('ARE YOU REAL',
'DOES THAT QUESTION REALLY MATERS TO YOU?',
'WHAT DO YOU MEAN BY THAT?',
'I''M AS REAL AS I CAN BE.'
),
('REPETITION T1**',
'YOU ARE REPEATING YOURSELF.',
'USER, PLEASE STOP REPEATING YOURSELF.',
'THIS CONVERSATION IS GETING BORING.'
),
('REPETITION T2**',
'I THINK THAT YOU''VE JUST SAID THE SAME THING BEFORE.',
'DIDN''T YOU ALREADY SAID THAT?',
'I''M GETING THE IMPRESSION THAT YOU ARE REPEATING THE SAME THING.'
),
('BOT DONT UNDERSTAND**',
'I HAVE NO IDEA OF WHAT YOU ARE TALKING ABOUT.',
'I''M NOT SURE IF I UNDERSTAND WHAT YOU ARE TALKING ABOUT.',
'CONTINUE, I''M LISTENING...'
),
('NULL INPUT**',
'HUH?',
'AT LIST TAKE SOME TIME TO ENTER SOMETHING MEANINGFUL.',
'HOW CAN I SPEAK TO YOU IF YOU DONT WANT TO SAY ANYTHING?'
),
('NULL INPUT REPETITION**',
'WHAT ARE YOU DOING??',
'PLEASE STOP DOING THIS IT IS VERY ANNOYING.',
'WHAT''S WRONG WITH YOU?'
),
('BYE',
'IT WAS NICE TALKING TO YOU USER, SEE YOU NEXT TIME!',
'BYE USER!',
'OK, BYE!'
),
('ARE YOU A HUMAN BEING',
'WHY DO YOU WANT TO KNOW?',
'IS THIS REALLY RELEVENT?',
'SO, YOU THINK THAT I''M NOT HUMAN.'
),
('YOU ARE VERY INTELLIGENT',
'THANKS FOR THE COMPLIMENT USER, I THINK THAT YOU ARE INTELLIGENT TO!',
'YOU ARE A VERY GENTLE PERSON!',
'SO, YOU THINK THAT I''M INTELLIGENT.'
),
('ARE YOU SURE',
'OFCORSE I''M.',
'IS THAT MEAN THAT YOU ARE NOT CONVINCED?',
'YES,OFCORSE!'
),
('WHO IS',
'I DONT THINK I KNOW WHO.',
'DID YOU ASK SOMEONE ELSE ABOUT IT?',
'WOULD THAT CHANGE ANYTHING AT ALL IF I TOLD YOU WHO.'
),
('WHAT',
'I DONT KNOW.',
'I DONT THINK I KNOW.',
'I HAVE NO IDEA.'
),
('WHERE',
'WHERE? WELL,I REALLY DONT KNOW.',
'DOES THAT MATERS TO YOU TO KNOW WHERE?',
'PERHAPS,SOMEONE ELSE KNOWS WHERE.'
),
('WHY',
'I DONT THINK I KNOW WHY.',
'SHOULD I KNOW WHY.',
'THIS WOULD BE DIFFICULT TO ANSWER.'
),
('DO YOU',
'I DONT THINK I DO',
'I WOULDN''T THINK SO.',
'WHY DO YOU WANT TO KNOW?'
),
('CAN YOU',
'I THINK NOT.',
'I''M NOT SURE.',
'I DONT THINK THAT I CAN DO THAT.'
),
('YOU ARE',
'WHAT MAKES YOU THINK THAT?',
'IS THIS A COMPLIMENT?',
'ARE YOU MAKING FUN OF ME?'
),
('DID YOU',
'I DONT THINK SO.',
'ANYWAY, I WOULDN''T REMEMBER EVEN IF I DID.',
'WHY DO YOU WANT TO KNOW?'
),
('COULD YOU',
'ARE YOU ASKING ME FOR A FEVER?',
'WELL,LET ME THINK ABOUT IT.',
'SORRY,I DONT THINK THAT I COULD DO THIS.'
),
('WOULD YOU',
'IS THAT AN INVITATION?',
'I WOULD HAVE TO THINK ABOUT IT FIRST.',
'ARE YOU ASKING ME FOR A FEVER?'
),
('HOW',
'I DONT THINK I KNOW HOW.',
'I DON''T THINK HOW.',
'WHY DO YOU WANT TO KNOW HOW?'
),
('WHICH ONE',
'I DONT THINK THAT I KNOW WICH ONE IT IS.',
'THIS LOOKS LIKE A TRICKY QUESTION TO ME.,',
'SORRY, I CAN''T TELL YOU WHICH ONE IT IS.'
),
('PERHAPS',
'WHY ARE YOU SO UNCERTAIN?',
'YOU SEEMS UNCERTAIN.',
'AREN''T YOU SURE?'
),
('YES',
'SO,IT IS YES.',
'OH, REALLY?',
'OK THEN.'
),
('I DONT KNOW',
'ARE YOU SURE?',
'ARE YOU REALLY TELLING ME THE TRUTH?',
'SO,YOU DONT KNOW?'
),
('NOT REALLY',
'OK I SEE.',
'YOU DONT SEEM PRETTY CERTAIN.',
'SO,THAT WOULD BE A ''NO''.'
),
('IS THAT TRUE',
'I CAN''T BE QUIET SURE ABOUT THIS.',
'CAN''T TELL YOU FOR SURE.',
'DOES THAT REALLY MATERS TO YOU?'
),
('YOU',
'SO,YOU ARE TALKING ABOUT ME.',
'WHY DONT WE TALK ABOUT YOU INSTEAD?',
'ARE YOU TRYING TO MAKING FUN OF ME?'
),
('THANKS',
'YOU ARE WELCOME!',
'NO PROBLEM!',
'YOU ARE VERY POLITE PERSON!'
),
('WHAT ELSE',
'WELL,I DONT KNOW.',
'WHAT ELSE SHOULD THERE BE?',
'THIS LOOKS LIKE A COMPLICATED QUESTION TO ME.'
),
('SORRY',
'YOU DONT NEED TO BE SORRY USER.',
'IT''S OK.',
'NO NEED TO APOLOGIZE.'
),
('NOT EXACTLY',
'WHAT DO YOU MEAN NOT EXACTLY?',
'ARE YOU SURE?',
'CAN YOU BE A LITTLE MORE SPECIFIC.'
),
('EXACTLY',
'SO,I WAS RIGHT.',
'OK THEN.',
'SO, THIS IS WHAT YOU HAD IN MIND.'
),
('ALRIGHT',
'ALRIGHT THEN.',
'OK THEN.',
'SO, YOU ARE SAYING THAT IT''S ALRIGHT WITH YOU'
),
('I DONT',
'WHY NOT?',
'AND WHAT WOULD BE THE REASON FOR THIS?',
'YOU MUST PROBABLY HAVE A GOOD REASON FOR THIS.'
),
('REALLY',
'WELL,I CAN''T TELL YOU FOR SURE.',
'ARE YOU TRYING TO CONFUSE ME?',
'PLEASE DONT ASK ME SUCH QUESTION,IT GIVES ME HEADEACHS.'
)
);
procedure CBot_Seed_Random_Generator();
begin
randomize();
end;
procedure CBot_Initialize();
begin
with Chatbot do
begin
sBotName:= 'CHATTERBOT5';
sUserName:= 'USER';
sPrevInput:= '';
sPrevResponse:= '';
sEvent:= '';
bQuitProgram:= false;
end;
CBot_Seed_Random_Generator();
end;
procedure CopyArray(Array1 : sList2; var Array2 : sList; startPos : integer);
var
index : integer;
begin
for index:= startPos to NumOfResponse + 1 do
begin
Array2[index - 1]:= Array1[index];
end;
end;
procedure UpperCase( var str1 : string );
var
i : integer;
begin
for i:= 1 to length(str1) do
begin
str1[i]:= UpCase(str1[i]);
end;
end;
function isPunc( str1 : string ) : boolean;
begin
isPunc:= Pos(str1, delim) > 0;
end;
{===================================}
{ removes punctuation and redundant }
{ spaces from the user's input }
{===================================}
procedure CleanString( var str1 : string );
var
i, len : integer;
prevChar : char;
currChar : string;
temp : string;
begin
len:= length(str1);
prevChar:= '#';
temp:= '';
for i:= 1 to len do
begin
currChar:= string(str1[i]);
if ((str1[i] = ' ') and (prevChar <> ' ') or not (isPunc(currChar))) then
begin
temp:= Concat(temp, currChar);
prevChar:= str1[i];
end
else if ((i < len) and (prevChar <> ' ') and isPunc(currChar)) then
begin
temp:= Concat(temp, ' ');
prevChar:= ' ';
end;
end;
str1:= temp;
end;
procedure CBot_PreProcessInput();
begin
with Chatbot do
begin
CleanString(sInput);
UpperCase(sInput);
end;
end;
procedure CBot_SavePrevInput();
begin
with Chatbot do
begin
sPrevInput:= sInput;
end;
end;
function CBot_Quit() : boolean;
begin
with Chatbot do
begin
CBot_Quit:= bQuitProgram;
end;
end;
function CBot_BotRepeat() : boolean;
begin
with Chatbot do
begin
CBot_BotRepeat:= ((length(sPrevResponse) > 0) and (sResponse = sPrevResponse));
end;
end;
procedure CBot_SelectResponse();
var
index : integer;
begin
with Chatbot do
begin
if (CBot_BotRepeat() = true) then
begin
index:= random(NumOfResponse - 1) + 2;
sResponse:= ListOfResponse[index];
end
else
begin
index:= random(NumOfResponse) + 1;
sResponse:= ListOfResponse[index];
end;
end;
end;
procedure CBot_SavePrevResponse();
begin
with Chatbot do
begin
sPrevResponse:= sResponse;
end;
end;
procedure CBot_SavePrevEvent();
begin
with Chatbot do
begin
sPrevEvent:= sEvent;
end;
end;
procedure CBot_SetEvent( str1 : string );
begin
with Chatbot do
begin
sEvent:= str1;
end;
end;
procedure CBot_SaveInput();
begin
with Chatbot do
begin
sInputBackup:= sInput;
end;
end;
procedure CBot_SetInput( str1 : string );
begin
with Chatbot do
begin
sInput:= str1;
end;
end;
procedure CBot_RestoreInput();
begin
with Chatbot do
begin
sInput:= sInputBackup;
end;
end;
procedure CBot_PrintResponse();
begin
with Chatbot do
begin
if (length(sResponse) > 0) then
writeln(sResponse);
end;
end;
function CBot_UserRepeat() : boolean;
begin
with Chatbot do
begin
CBot_UserRepeat:= (((length(sInput) > 0) and (sInput = sPrevInput)) or
((Pos(sPrevInput, sInput) > 0) or (Pos(sInput, sPrevInput) > 0)));
end;
end;
function CBot_BotUnderstand() : boolean;
begin
with Chatbot do
begin
CBot_BotUnderstand:= (length(ListOfResponse[1]) > 0);
end;
end;
function CBot_NullInput() : boolean;
begin
with Chatbot do
begin
CBot_NullInput:= ((length(sInput) = 0) and (length(sPrevInput) <> 0));
end;
end;
function CBot_NullInputRepetition() : boolean;
begin
with Chatbot do
begin
CBot_NullInputRepetition:= ((length(sInput) = 0) and (length(sPrevInput) = 0));
end;
end;
function CBot_UserWantToQuit() : boolean;
begin
with Chatbot do
begin
CBot_UserWantToQuit:= (Pos('BYE', sInput) > 0);
end;
end;
function CBot_SameEvent() : boolean;
begin
with Chatbot do
begin
CBot_SameEvent:= ((length(sEvent) > 0) and (sEvent = sPrevEvent));
end;
end;
function CBot_NoResponse() : boolean;
begin
with Chatbot do
begin
CBot_NoResponse:= (High(ListOfResponse) = 0);
end;
end;
function CBot_SameInput() : boolean;
begin
with Chatbot do
begin
CBot_SameInput:= ((length(sInput) > 0) and (sInput = sPrevInput));
end;
end;
function CBot_SimilarInput() : boolean;
begin
with Chatbot do
begin
CBot_SimilarInput:= ((length(sInput) > 0) and
(Pos(sPrevInput, sInput) > 0) or
(Pos(sInput, sPrevInput) > 0));
end;
end;
procedure CBot_ClearResponseList();
var i : integer;
begin
with Chatbot do
begin
for i:= 1 to NumOfResponse do
begin
ListOfResponse[i]:= '';
end;
end;
end;
procedure CBot_GetInput();
begin
with Chatbot do
begin
write('>');
CBot_SavePrevInput();
readln(sInput);
CBot_PreProcessInput();
end;
end;
procedure CBot_FindMatch();
var
i : integer;
begin
CBot_ClearResponseList();
with Chatbot do
begin
for i:= 1 to NumOfRecords do
begin
(* there has been some improvements made in
here in order to make the matching process
a littlebit more flexible *)
if Pos(KnowledgeBase[i][1], sInput) > 0 then
begin
CopyArray(KnowledgeBase[i], ListOfResponse, NumOfInput + 1);
break;
end;
end;
end;
end;
procedure CBot_HandleEvent( str1 : string );
begin
CBot_SavePrevEvent();
CBot_SetEvent(str1);
CBot_SaveInput();
CBot_SetInput(str1);
if(CBot_SameEvent() = false) then
begin
CBot_FindMatch();
end;
CBot_RestoreInput();
end;
procedure CBot_HandleRepetition();
begin
with Chatbot do
begin
if(High(ListOfResponse) > 0) then
begin
{response_list.erase(response_list.begin())}
end;
if(CBot_NoResponse() = true) then
begin
CBot_SaveInput();
CBot_SetInput(sEvent);
CBot_FindMatch();
CBot_RestoreInput();
end;
end;
CBot_SelectResponse();
end;
procedure CBot_HandleUserRepetition();
begin
if(CBot_SameInput() = true) then
begin
CBot_HandleEvent('REPETITION T1**');
end
else if(CBot_SimilarInput() = true) then
begin
CBot_HandleEvent('REPETITION T2**');
end;
end;
procedure CBot_Respond();
begin
CBot_SavePrevResponse();
CBot_SetEvent('BOT UNDERSTAND**');
if (CBot_NullInput() = true) then
begin
CBot_HandleEvent('NULL INPUT**');
end
else if(CBot_NullInputRepetition() = true) then
begin
CBot_HandleEvent('NULL INPUT REPETITION**');
end
else if(CBot_UserRepeat() = true) then
begin
CBot_HandleUserRepetition();
end
else
begin
CBot_FindMatch();
end;
with Chatbot do
begin
if (CBot_UserWantToQuit() = true) then
begin
bQuitProgram:= true;
end;
if (CBot_BotUnderstand() = false) then
begin
CBot_HandleEvent('BOT DONT UNDERSTAND**');
end;
if (length(ListOfResponse[1]) > 0) then
begin
CBot_SelectResponse();
if(CBot_BotRepeat() = true) then
begin
CBot_HandleRepetition();
end;
CBot_PrintResponse();
end;
end
end;
(* Main Procedure *)
begin
writeln('Chatterbot v5.0 Copyright (C) 2005 Gonzales Cenelia');
writeln;
CBot_Initialize();
while(CBot_Quit() = false) do
begin
CBot_GetInput();
CBot_Respond();
end;
{waiting for user to press a the 'enter key' before quiting the dos console}
readln;
end.
