/* A small (gnu) prolog example on emotional modeling */ /* Timo Honkela, UIAH Media Lab, Nov 11, 1999 */ /* Based on the scheme presented at http://www.brunel.ac.uk/~hsstbbp/emotlec6.htm */ /* Added: - setting linguistic approximations of fuzzy values */ /* - giving a summary of the situation, pred. 'what' */ /* - setting the parameters in natural language */ /* Main program */ start :- initialise, discuss. /* Set initial param values */ initialise :- write('\nSay, for example: activation is very low\n\n'), remove_old_values, asserta(activation(100)), asserta(pleasantness(100)). remove_old_values :- retractall(pleasantness(_)), retractall(activation(_)). /* Continuous loop for reading in user instructions */ discuss :- write('> '), /* prompt */ read_list(Input), /* read user input */ interpret(Input), !, /* change the setting */ check_both, /* check if both params given */ what, /* report current state */ discuss. /* recursive call for iteration */ discuss :- write('\nThank you!\n\n'). /* Examples of processing nl input: */ interpret([activation,is,very,high]) :- set_a_fuzzy(very_high). interpret([activation,is,Middle,high]) :- word_for_intermediate(Middle), set_a_fuzzy(quite_high). interpret([activation,is,a,little,high]) :- set_a_fuzzy(a_little_high). interpret([Agent,is,very,active]) :- word_for_agency(Agent), set_a_fuzzy(very_high). interpret([Agent,is,Middle,active]) :- word_for_agency(Agent), word_for_intermediate(Middle), set_a_fuzzy(quite_high). interpret([activation,is,very,low]) :- set_a_fuzzy(very_low). interpret([activation,is,Middle,low]) :- word_for_intermediate(Middle), set_a_fuzzy(quite_low). interpret([activation,is,a,little,low]) :- set_a_fuzzy(a_little_low). interpret([Agent,is,very,passive]) :- word_for_agency(Agent), set_a_fuzzy(very_low). interpret([Agent,is,Middle,passive]) :- word_for_agency(Agent), word_for_intermediate(Middle), set_a_fuzzy(quite_low). interpret([pleasantness,is,very,high]) :- set_p_fuzzy(very_high). interpret([pleasantness,is,Middle,high]) :- word_for_intermediate(Middle), set_p_fuzzy(quite_high). interpret([pleasantness,is,a,little,high]) :- set_p_fuzzy(a_little_high). interpret([pleasantness,is,very,low]) :- set_p_fuzzy(very_low). interpret([pleasantness,is,Middle,low]) :- word_for_intermediate(Middle), set_p_fuzzy(quite_low). interpret([pleasantness,is,a,little,low]) :- set_p_fuzzy(a_little_low). interpret(List) :- quitword(Word), member(Word, List), !, fail. interpret(_) :- write('\nPlease, try to reformulate or explicitly quit.\n\n'). word_for_agency(agent). word_for_agency(person). word_for_intermediate(rather). word_for_intermediate(quite). word_for_intermediate(moderately). check_both :- check_pleasantness, check_activation. check_pleasantness :- pleasantness(X), X > 10, !, /* preset value is found */ write('\nWhat is the level of pleasantness?\n\n> '), read_list(Input), interpret_level(Input, Level), set_p_fuzzy(Level). check_pleasantness. check_activation :- activation(X), X > 10, !, /* preset value is found */ write('\nWhat is the level of activation?\n\n> '), read_list(Input), interpret_level(Input, Level), set_a_fuzzy(Level). check_activation. interpret_level([very,low], very_low). interpret_level([quite,low], quite_low). interpret_level([low], quite_low). interpret_level([a,little,low], a_little_low). interpret_level([very,high], very_high). interpret_level([quite,high], quite_high). interpret_level([high], quite_high). interpret_level([a,little,high], a_little_high). /* Setting parameter values through linguistic approximations */ /* pleasantness */ set_p_fuzzy(Phrase) :- linguistic_approximation(Phrase, Value), set_p(Value). /* activation */ set_a_fuzzy(Phrase) :- linguistic_approximation(Phrase, Value), !, set_a(Value). /* Ask about the situation and give the result as a list */ what(List) :- findall(valuepair(X, Y), state(X, Y), List). /* Print the results of 'what' nicely */ what :- what(List), write('\nThe person is: \n'), print_what(List), write('\n'). print_what([]). print_what([valuepair(X, Y)|Rest]) :- print_one(X, Y), print_what(Rest). print_one(State, Value) :- linguistic_approximation(InternalPhrase, Value), translate_fuzzy_phrase(InternalPhrase, ExternalPhrase), write('- '), write(ExternalPhrase), write(' '), write(State), write('\n'). /* Phrases to be printed */ translate_fuzzy_phrase(very_high, 'very'). translate_fuzzy_phrase(quite_high, 'quite'). translate_fuzzy_phrase(a_little_high, 'a little'). translate_fuzzy_phrase(very_low, 'very low in'). translate_fuzzy_phrase(quite_low, 'quite low in'). translate_fuzzy_phrase(a_little_low, 'a little low in'). /* Linguistic approximations of fuzzy values */ linguistic_approximation(very_high, 1.0) :- !. linguistic_approximation(very_high, X) :- X > 0.85, !. linguistic_approximation(quite_high, 0.7) :- !. linguistic_approximation(quite_high, X) :- X > 0.5, !. linguistic_approximation(a_little_high, 0.3) :- !. linguistic_approximation(a_little_high, X) :- X > 0.15, !. linguistic_approximation(very_low, -1.0) :- !. linguistic_approximation(very_low, X) :- X < -0.85, !. linguistic_approximation(quite_low, -0.7) :- !. linguistic_approximation(quite_low, X) :- X < -0.5, !. linguistic_approximation(a_little_low, -0.3) :- !. linguistic_approximation(a_little_low, X) :- X < -0.15, !. /* The user sets the level of pleasantness of the agent */ set_p(Value) :- Value > 1.0, write('Please give values between -1 and 1\n'), !, fail. set_p(Value) :- Value < -1.0, write('Please give values between -1 and 1\n'), !, fail. set_p(Value) :- retract(pleasantness(_)), !, /* if old value exists, retracted */ asserta(pleasantness(Value)). /* new value is set */ set_p(Value) :- asserta(pleasantness(Value)). /* The user sets the level of activation of the agent */ set_a(Value) :- Value > 1.0, write('Please give values between -1 and 1\n'), !, fail. set_a(Value) :- Value < -1.0, write('Please give values between -1 and 1\n'), !, fail. set_a(Value) :- retract(activation(_)), !, asserta(activation(Value)). set_a(Value) :- asserta(activation(Value)). /* State is computed. */ /* The calculations are approximate, i.e., not following in detail the "emotion circle" */ state(stimulated, Z) :- pleasantness(P), activation(A), absolutevalue(P, AbsP), A > (AbsP / 2), Z is A - (AbsP / 2). state(euphoric, Z) :- pleasantness(P), activation(A), A > 0, P > 0, Z is (A + P) / 2.0. state(happy, Z) :- pleasantness(P), activation(A), absolutevalue(A, AbsA), P > (AbsA / 2), Z is P - (AbsA / 2). state(serene, Z) :- pleasantness(P), activation(A), A < 0, P > 0, Z is (P - A) / 2.0. state(passive, Z) :- pleasantness(P), activation(A), absolutevalue(P, AbsP), A < -1 * (AbsP / 2), Z is (-1 * A) - (AbsP / 2). state(bored, Z) :- pleasantness(P), activation(A), A < 0, P < 0, Z is ((-1 * P) - A) / 2.0. state(sad, Z) :- pleasantness(P), activation(A), absolutevalue(A, AbsA), P < -1 * (AbsA / 2), Z is (-1 * P) - (AbsA / 2). state(anxious, Z) :- pleasantness(P), activation(A), A > 0, P < 0, Z is (A - P) / 2.0. /* calculate the absolute value */ /* e.g. if X = -2.3 then AbsX becomes 2.3 */ absolutevalue(X, AbsX) :- X < 0, AbsX is -1 * X, !. absolutevalue(X, X). /* Help predicates for natural language processing */ quitword(quit). quitword(exit). quitword(logout). print_text([First|Rest]) :- print(First), print(' '), print_text(Rest). print_text([Last]) :- print(Last), print('.\n'). print_text([]). lowercase([],[]). lowercase([W|Word],[L|Lower]) :- lower_upper(L,W), lowercase(Word,Lower). normalise_word(var(Value), Word) :- !, atom_chars(Value, List), lowercase(List, Chars), atom_chars(Word, Chars). normalise_word(punct(Value), Value) :- !. normalise_word(Value, Word) :- atom_chars(Value, List), lowercase(List, Chars), atom_chars(Word, Chars). /* input of string and conversion into list */ read_list(List) :- reading(List). reading([]) :- peek_char(C), C == '\n', !, get_char(_). reading([Word2|Rest]) :- readword(Word), normalise_word(Word, Word2), reading(Rest). readword('') :- peek_char(C), neglect_char(C) , !, get_char(_). readword('') :- peek_char(C), C == '\n', !. readword(Result) :- get_char(C), readword(Further), atom_concat(C, Further, Result). neglect_char(' '). neglect_char('!'). neglect_char('?'). neglect_char('.'). neglect_char(','). neglect_char(':'). neglect_char(';').