:- set_prolog_flag(enforce_directives, off). :- initialization(set_prolog_flag(unknown, fail)). :- initialization(set_prolog_flag(enforce_directives, off)). :- initialization(op(300, fy, ~)). /* **************************************************************************** * * This program implements a simple inclusion hierarchy database with a natural * language front end. * * The program repeatedly reads sentences from the user or a file, translates * them, and then either adds information to the database (if the sentence was * an assertion) or queries the database and reports the result (if it was a * question.) If we are reading input from a file, then each sentence will be * echoed as it is read. Optionally, the translation of each sentence can also * be printed. * * The program consists of the following modules: * * 1) Main - The top level loop plus auxiliary routines for loading/saving * a database on disk. * * 2) Read - This module reads a sentence typed in conventional English format * and returns it to the caller as a list of words (all lower-case.) For * example, if the user types "Snoopy is a dog.", this module will return * it as [snoopy, is, a, dog, '.']. * * 3) Translate - This module is the natural language portion of the program. * It translates a sentence (list of words) into a structured representation * of its meaning. For example, [snoopy, is, a, dog, '.'] would be * translated into assertion(isa(individual(snoopy), class(dog))). * * In true prolog fashion, the grammar rules in this module can also be run * backwards to translate a structured representation of meaning into an * equivalent English sentence. This facility is used by the module * Respond. Thus, for example, assertion(isa(individual(snoopy), class(dog))) * could be translated back into [snoopy, is, a, dog]. * * 4) Respond - This module responds to translated sentences, both by giving * a response to the user and by modifying the database if appropriate. * For example, it would respond to assertion isa(individual(snoopy), * class(dog))) by adding a new isa fact to the database and printing "OK, * I now know that snoopy is a dog" to acknowledge having done so. * * Questions that can be responded to based on information in the database * create responses that are based on the form that would have been used * to assert this information into the database. This is accomplished by * accessing the relevant fact (or constructing a relevant inference) and * then running the grammar rules in Module Translate backwards. * * 5) Database - This module is the actual database in which information is * stored * * 6) Engine - the inference engine * * 7) Print - This module prints a sentence represented as a list of words * in standard English format. * *************************************************************************** */ /* **************************************************************************** * * Module (1): Main * * Entry point: main * * *************************************************************************** */ /* * main/0 - top level loop * */ main :- offer_to_load_file, repeat, main_loop_body(TranslatedSentence), TranslatedSentence = quit, offer_to_save_file. /* * main_loop_body/1 - This is the body of the main loop. It is put into a * separate predicate with one cut to deal with backtracking * issues raised by the repeat loop. */ main_loop_body(TranslatedSentence) :- nl, write('> '), read_sentence(Sentence), !, echo_sentence_if_reading_file(Sentence), translate_sentence(Sentence, TranslatedSentence), !, print_translation_if_desired(TranslatedSentence), respond_to(TranslatedSentence, Response), print_sentence(Response, '.'), !. /* * echo_sentence_if_reading_file/1 - Echo the sentence just typed by the user * if input is coming from a file. */ echo_sentence_if_reading_file(_) :- seeing(user), !. echo_sentence_if_reading_file(S) :- print_sentence(S, ''). /* * print_translation_if_desired/1 - Print the translation of the sentence if * the predicate print_translation is asserted. */ print_translation_if_desired(T) :- print_translation, !, write(T), nl. print_translation_if_desired(_). /* * offer_to_load_file/0 - offer the user an opportunity to load a previously * saved knowledge-base. */ offer_to_load_file :- seeing(Input), telling(Output), see(user), tell(user), write('Would you like to load a previously-entered knowledge base: '), read_yesno(A), (A = fail ; (write('Enter file name: '), get0(C), readword(C, FileName, _), !, reconsult(FileName) ) ), see(Input), tell(Output). /* * offer_to_save_file/0 - offer the user an opportunity to save the current * knowledge-base for later use. */ offer_to_save_file :- seeing(Input), telling(Output), see(user), tell(user), !, write('Would you like to save this knowledge base for later use: '), read_yesno(A), ((A = fail) ; (write('Enter file name: '), get0(C), readword(C, FileName, _), !, (atom_concat(_, '.pro', FileName) -> File = FileName ; atom_concat(FileName, '.pro', File) ), open(File, write, Stream), set_output(Stream), save_all_predicates, close(Stream) ) ; (write('Error creating or writing file - sorry'), nl) ), see(Input), tell(Output). save_all_predicates :- savable_predicate(Name), listing(Name), fail. save_all_predicates. /* * read_yesno/1 - read a yes or no response from the user, then succeed or fail. */ read_yesno(Answer) :- get0(C), readword(C, W, _), (((W = yes; W = ye; W = y), Answer = true); ((W = no; W = n), Answer = fail); (write('Please answer yes or no: '), read_yesno(Answer)) ). /* **************************************************************************** * * Module (2): Read * * Entry points: read_sentence/1, readword/3 * * This module is adapted from routines in Clocksin and Mellish * *************************************************************************** */ /* * read_sentence/1 - read an English sentence and convert to list of words. * */ read_sentence([W|Ws]) :- get0(C), readWordOrNumber(C,W,C1), restsent(W,C1,Ws). restsent(W,_,[]) :- lastword(W), !. restsent(W,C,[W1|Ws]) :- readWordOrNumber(C,W1,C1), restsent(W1,C1,Ws). /* * readWordOrNumber/3 - read an English word or a number * */ readWordOrNumber(C, W, C1) :- readword(C, W1, C1), !, (allDigits(W1) -> (name(W1, L), number_codes(W, L)) ; W = W1). allDigits(W1) :- name(W1, L), allDigitsList(L). allDigitsList([]). allDigitsList([H | T]) :- 48 =< H, H =< 57, allDigitsList(T). /* * readword/3 - read a single English word. * */ readword(C,W,C1) :- single_character([C]), !, name(W,[C]), get0(C1). readword(C,W,C2) :- in_word(C,NewC), !, get0(C1), restword(C1,Cs,C2), name(W,[NewC|Cs]). readword(C,W,C2) :- get0(C1), readword(C1,W,C2). restword(C,[NewC|Cs],C2) :- in_word(C,NewC), !, get0(C1), restword(C1,Cs,C2). restword(C,[],C). /* Facts about the alphabet and punctuation marks */ single_character("."). single_character(","). single_character("?"). in_word(C,C) :- C >= 97 /* a */, C =< 122 /* z */. in_word(C,L) :- C >= 65 /* A */, C =< 90 /* Z */, L is C + 32 /* a - A */. in_word(C, C) :- C >= 48 /* 0 */, C =< 57 /* 9 */. /* Allow ',-,_ embedded within a word */ in_word(39, 39). in_word(45, 45). in_word(95, 95). lastword('.'). lastword('?'). /* **************************************************************************** * * Module (3): Translate * * Entry points: translate_sentence/3 * restate/2 * *************************************************************************** */ /* * We will use ~ to record a negated fact. Define it as an operator for convenience. * */ :- op(300, fy, ~). /* * translate_sentence/2 - Translate a single sentence into internal structure * using grammar rules * */ translate_sentence([quit, '.'], quit) :- !. translate_sentence(Sentence, TranslatedSentence) :- phrase(sentence(TranslatedSentence), Sentence), !. translate_sentence(_, unrecognized). /* * restate/2 - Turn a translation back into appropriate English by * running the grammar rules backwards */ restate(Translation, Restatement) :- phrase(Translation, Restatement), !. restate(Translation, Restatement) :- /* Special case for double negative */ Translation =.. [ Type, ~ ~ Form, Number ], !, SimplifiedTranslation =.. [ Type, Form, Number ], restate(SimplifiedTranslation, Restatement). restate(Translation, Restatement) :- /* Special case where preferred */ Translation =.. [ Type, Form, _ ], /* number cannot be used. */ AlternateTranslation =.. [ Type, Form, _ ], phrase(AlternateTranslation, Restatement). restate(Translation, [ unable, to, restate, Translation] ). /* * Grammar rules for sentence and constituents. * A sentence is either an assertion or a question * * Each specific rule is preceeded by examples of English phrases/sentences * it handles. * */ sentence(assertion(Fact, Number)) --> assertion(Fact, Number), ['.']. sentence(question(Query, Number)) --> question(Query, Number), ['?']. /* * Assertions * */ /* Snoopy is a beagle; a beagle is a dog; dogs are carnivores. */ assertion(isa(X, class(C)), Number) --> entity_name(X, Number), tobe(Number), class_name(class(C), Number). /* Snoopy is not a cat; a beagle is not a shepherd; dogs are not amphibians. */ assertion(~isa(X, class(C)), Number) --> entity_name(X, Number), not_tobe(Number), class_name(class(C), Number). /* Snoopy likes woodstock; Snoopy fears cats; an ai_student reads Nilsson; a dog chases cats; cats love Garfield; cats chase birds */ assertion(relationship(X, Y, R), Number) --> entity_name(X, Number), verb(R, Number), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* Garfield does not like Nermal; Garfield does not chase rodents; a jedi does not like Vader; a dog does not chase rodents; cats do not like Butch; dogs do not like fleas */ assertion(~relationship(X, Y, R), Number) --> entity_name(X, Number), not_todo(Number), verb(R, stem), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* * Questions * A question is either a yes-no question, a gapped question, a why * question, or a tell me more question * */ question(yesno(Query), Number) --> yesno_question(Query, Number). question(gapped(Query), Number) --> gapped_question(Query, Number). question(why(Query), Number) --> interrogative(why), yesno_question(Query, Number). question(why, _) --> interrogative(why). question(tell_more, _) --> interrogative(what), else. question(tell_more, _) --> interrogative(who), else. /* Yes no question */ /* Is Snoopy a beagle? Is a beagle a dog? Are dogs carnivores? -- expected answer is yes */ /* Is Snoopy a cat? Is a beagle a shepherd? Are dogs amphibians? -- expected answer is no */ /* Is Snoopy a pilot? Is a cow an ungulate? Are fleas insects? -- expected answer is "I don't know" */ yesno_question(isa(X, class(C)), Number) --> tobe(Number), entity_name(X, Number), class_name(class(C), Number). /* Does Snoopy like Woodstock? Does Snoopy fear cats? Does an ai_student read Nilsson? Does a dog chase cats? Do cats love Garfield? Do cats chase birds? -- expected answer is yes */ /* Does Garfield like Nermal? Does Garfield chase rodents? Does a jedi like Vader? Does a dog chase rodents? Do cats like Butch? Do dogs like fleas? -- expected answer is no */ /* Does Dilbert like Catbert? Does Dilbert love managers? Does a mathematician read Hilbert? Does an artist draw pictures? Do republicans like Bush? Do cs_majors write comments? -- expected answer is "I don't know */ yesno_question(relationship(X, Y, R), Number) --> todo(Number), entity_name(X, Number), verb(R, stem), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* Gapped question */ /* What is Snoopy? What is a beagle? What are dogs? */ gapped_question(isa(X, class(C)), Number) --> interrogative(what), tobe(Number), entity_name(X, Number), { isa(X, _) }. /* Who is a beagle? */ gapped_question(isa(individual(I), class(C)), singular) --> interrogative(who), tobe(singular), class_name(class(C), singular). /* Who does Snoopy like? Who does an ai_student read? Who do cats love? -- Note: this form of question expects the answer to be an individual */ gapped_question(relationship(X, individual(I), R), Number) --> interrogative(who), todo(Number), entity_name(X, Number), verb(R, stem). /* What does Snoopy fear? What does a dog chase? What do cats chase? -- Note: this form of question expects the answer to be a class */ gapped_question(relationship(X, class(C), R), Number) --> interrogative(what), todo(Number), entity_name(X, Number), verb(R, stem). /* Who does Garfield not like? Who does a jedi not like ? Who do cats not like? -- Note: this form of question expects the answer to be an individual */ gapped_question(~relationship(X, individual(I), R), Number) --> interrogative(who), todo(Number), entity_name(X, Number), negation, verb(R, stem). /* What does Garfield not chase? What does a dog not chase? What do dogs not like? -- Note: this form of question expects the answer to be a class */ gapped_question(~relationship(X, class(C), R), Number) --> interrogative(what), todo(Number), entity_name(X, Number), negation, verb(R, stem). /* Who likes Woodstock? Who fears cats? -- Note: this form of question expects the answer to be an individual */ gapped_question(relationship(individual(I), Y, R), singular) --> interrogative(who), verb(R, singular), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* What reads Nilsson? What chases cats? What loves Garfield? What chases birds? -- Note: this form of question expects the answer to be a class */ gapped_question(relationship(class(C), Y, R), singular) --> interrogative(what), verb(R, singular), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* Who doesn't like Nermal? Who does not chase rodents? -- Note: this form of question expects the answer to be an individual */ gapped_question(~relationship(individual(I), Y, R), singular) --> interrogative(who), not_todo(singular), verb(R, stem), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* What doesn't like Vader? What does not chase rodents? What don't like Butch? What do not like fleas? -- Note: this form of question expects the answer to be a class */ gapped_question(~relationship(class(C), Y, R), Number) --> interrogative(what), not_todo(Number), verb(R, stem), entity_name(Y, Number2), { (Y = individual(_), Number2 = singular) ; (Y = class(_), Number2 = plural) }. /* * Phrases and words used in constructing the various forms of sentences * */ /* * An entity is either the name of an individual or of a class. Individual * names are singular nouns; class names are of the form "a noun" or * plural nouns. * */ entity_name(individual(I), singular) --> individual_name(individual(I), singular). entity_name(class(C), Number) --> class_name(class(C), Number). individual_name(individual(I), singular) --> { var(I) ; capitalized_form(I, Word) }, noun(Word, singular), { nonvar(I) ; I = Word }. /* We'll let any singular noun be an individual_name */ class_name(class(C), singular) --> indefinite_article(A), noun(C, singular), { appropriate_article(A, C) }. /* We'll let any singular noun be a class_name if it is preceeded by an indefinite article. */ class_name(class(C), plural) --> noun(C, plural). /* Likewise, we'll let any plural noun be a class name */ /* * Parts of speech. If a word is known, that is it's part of speech - otherwise, * infer part of speech from spelling and context of usage * */ noun(Stem, Number) --> [Word], { known_word(Word, Number, noun(Stem)) }. noun(Stem, singular) --> [Stem], { not known_word(Stem, _, _), not ends_in_s(Stem), not known_word(_, singular, noun(Stem)) }. noun(Stem, plural) --> { var(Stem) ; trailing_s(Stem, Word) }, [Word], { not known_word(Word, _, _), trailing_s(Stem, Word), not known_word(_, plural, noun(Stem)) }. verb(Stem, Number) --> [Word], { known_word(Word, Number, verb(Stem)) }. verb(Stem, stem) --> [Stem], { known_word(_, _, verb(Stem)) }. verb(Stem, singular) --> { var(Stem) ; trailing_s(Stem, Word) }, [Word], { not known_word(Word, _, _), trailing_s(Stem, Word), not known_word(_, singular, verb(Stem)) }. verb(Stem, plural) --> [Stem], { not known_word(Stem, _, _), not ends_in_s(Stem), not known_word(_, plural, verb(Stem)) }. verb(Stem, stem) --> [Stem], { not known_word(Stem, _, _), not ends_in_s(Stem) }. tobe(Number) --> [Word], { known_word(Word, Number, tobe) }. not_tobe(Number) --> [Word], { known_word(Word, Number, not_tobe) }. not_tobe(Number) --> tobe(Number), [not]. todo(Number) --> [Word], { known_word(Word, Number, todo) }. not_todo(Number) --> [Word], { known_word(Word, Number, not_todo) }. not_todo(Number) --> todo(Number), negation. indefinite_article(Word) --> [Word], { known_word(Word, singular, indefinite_article) }. interrogative(what) --> [ Word ], { known_word(Word, _, interrogative(what)) }. interrogative(who) --> [ Word ], { known_word(Word, _, interrogative(who)) }. interrogative(why) --> [ Word ], { known_word(Word, _, interrogative(why)) }. else --> [ Word ], { known_word(Word, _, else) }. negation --> [ Word ], { known_word(Word, _, negation) }. /* * Vocabulary * * This section contains definitions for certain key vocabulary words like * the forms of "to be". For most words, the program guesses the part of * speech from context, and uses standard English rules to deal with singular * and plural forms of nouns, and with stem and third singular forms of * verbs. However, entries can be made here for words that are known to the * program to be of a particular part of speech (and should not be assumed to * be something else) orirregular nouns and verbs. * * These entries take the following form * * known_word(Form, Number, Interpretation) * * (Where interpretation is "special" if the word appears directly in the * grammar rules, and should only be recognized in one of the roles where * explicitly used.) * * Note that, in the database, nouns are always stored in their singular form * and verbs in their stem form. The grammar rules for noun and verb always * return this canonical form. * */ known_word(is, singular, tobe). known_word(are, plural, tobe). known_word('isn''t', singular, not_tobe). known_word('aren''t', plural, not_tobe). known_word(does, singular, todo). known_word(do, plural, todo). known_word('doesn''t', singular, not_todo). known_word('don''t', plural, not_todo). known_word(a, singular, indefinite_article). known_word(an, singular, indefinite_article). known_word(quit, _, quit). known_word(what, _, interrogative(what)). known_word(who, _, interrogative(who)). known_word(why, _, interrogative(why)). known_word(else, _, else). known_word(not, _, negation). known_word(mice, plural, noun(mouse)). known_word(deer, plural, noun(deer)). /* * Special functions necessitated by English syntax * */ /* * appropriate_article/2 * * Unifies first argument with "a" or "an" depending on first letter of * noun represented by second argument. * */ appropriate_article(An, Noun) :- name(Noun, [H|T]), member(H, "aeiou"), !, An = an. appropriate_article(a, _). /* * ends_in_s/1 - succeeds if argument is an atom that ends in the letter s * */ ends_in_s(Form) :- atom(Form), name(Form, FormName), append(_, "s", FormName). /* * trailing_s/2 * * add/remove trailing s to/from a form. The first argument is the form without * the s; the second, with the s. One argument needs to be instantiated to an atom * this predicate is called; the other will be unified with the appropriately * transformed version. This goal will fail if its first argument is * instantiated to a form that already ends in s, or if its second is * instantiated to a form that does not. * * If called with both arguments uninstantiated or instantiated to something * other than an atom, this predicate fails. * */ trailing_s(Form, Form_s) :- atom(Form), !, not ends_in_s(Form), name(Form, FormName), append(FormName, "s", Form_sName), name(Form_s, Form_sName). trailing_s(Form, Form_s) :- atom(Form_s), !, name(Form_s, Form_sName), append(FormName, "s", Form_sName), name(Form, FormName). trailing_s(_, _). /* * capitalized_form/2 - instantiates second argument to capitalized form of first. * first argument must be nonvar. * * If called with the first argument uninstantiated, or * instantiated to something other than an atom, this predicate * fails. * */ capitalized_form(Noun, Cap) :- atom(Noun), !, name(Noun, [ H | T ]), capitalize(H, HC), name(Cap, [ HC | T ]). /* **************************************************************************** * * Module (4): Respond * * Entry point: respond_to/2 * *************************************************************************** */ /* * respond_to/2 - Respond to a translated sentence of a specified class by * taking appropriate action in the database and then * constructing a reponse to be printed. In addition, key * information about the query is saved to support a subsequent * "Why?" or "What else?" query. */ /* Special cases - quit, untranslatable sentence */ respond_to(quit, [have, a, nice, day ]). respond_to(unrecognized, [sorry, i, 'don''t', understand, that ]). /* Special cases: "Why?", "Who/What else?" - look up the last inference and use that to reframe the question, if possible. */ respond_to(question(why, _), Response) :- last_inference(question(OriginalQuery, Number), SavedInference), !, respond_to(question(why(SavedInference), Number), Response). respond_to(question(why, _), [ sorry, i, 'don''t', know, what, 'you''re', asking, about ]) :- !. respond_to(question(tell_more, _), Response) :- last_inference(question(OriginalQuery, Number), SavedInference), OriginalQuery = gapped(_), !, respond_to(redo_question(OriginalQuery, SavedInference, Number), Response). respond_to(question(tell_more, _), [ sorry, i, 'don''t', know, what, 'you''re', asking, about ]) :- !. /* General case */ respond_to(TranslatedSentence, Response) :- retractall(current_goal(_)), assertz(current_goal(TranslatedSentence)), respond_to(TranslatedSentence, Response, InferenceToSave), retract(current_goal(Original)), maybe_save_inference(Original, InferenceToSave). /* * respond_to/3 - Actually does the work of constructing a response, and * also possibly returns an inference to be saved through its * third argument. (Saving the inference is dealt with by * respond_to/2 before returning the response to the caller.) */ /* Statement of fact - add to database */ respond_to(assertion(Fact, _), [ 'OK', ',', 'I', now, know, that | Restate ], _) :- assertz(Fact), restate(assertion(Fact, singular), Restate). /* Yes/no question - respond yes followed by a positive statement if we can infer truth of query, no followed by a negative statement if we can infer its falsity, and "I don't know" otherwise */ respond_to(question(yesno(Query), Number), [ yes, ',' | Restate ], Query) :- infer(Query, 1), restate(assertion(Query, Number), Restate), !. respond_to(question(yesno(Query), Number), [ no, ',' | Restate ], ~Query) :- infer(~Query, 1), restate(assertion(~Query, Number), Restate), !. respond_to(question(yesno(_), _), [ i, 'don''t', know ], _). /* Gapped question. Respond with appropriate information if we can find it, else "I don't know". */ respond_to(question(gapped(Query), Number), Restate, Query) :- infer(Query, 1), /* Note that variables in the Query have now been filled in, so when we turn it into an assertion the value wanted will appear at the right place. */ restate(assertion(Query, Number), Restate), !. respond_to(question(gapped(Query), _), [ i, 'don''t', know ], _). /* Why question. If information in question is a fact in database, respond "Because you told me ...", else if question can be inferred, cite beginning of inference procedure, else indicate that information asked about does not hold. */ respond_to(question(why(Query), Number), [ because, you, told, me, that | Restate], _) :- call(Query), restate(assertion(Query, Number), Restate), !. respond_to(question(why(Query), Number), Response, Step2) :- explain_inference(Query, Step1, Step2), restate(assertion(Step1, Number), Restate1), restate(assertion(Step2, Number), Restate2), append([ because | Restate1 ], [',', and | Restate2 ], Response), !. respond_to(question(why(Query), Number), [ but | StateNot ], ~Query) :- infer(~Query, 1), restate(assertion(~Query, Number), StateNot), !. respond_to(question(why(Query), Number), [ but, i, 'don''t', know, whether | Restate ], _) :- restate(assertion(Query, Number), Restate). /* Redo of a gapped question */ respond_to(redo_question(gapped(Query), Last, Number), Restate, Query) :- redo_inference(Query, Last), restate(assertion(Query, Number), Restate), !. respond_to(redo_question(_, _, _), [ 'i''ve', told, you, everything, i, know, about, that ], _). /* * maybe_save_inference/2 - Save last inference using a predicate of the * form last_inference/2 if one was returned * */ maybe_save_inference(redo_question(Query, _, Number), InferenceToSave) :- !, maybe_save_inference(question(Query, Number), InferenceToSave). maybe_save_inference(_, InferenceToSave) :- /* Don't bother */ var(InferenceToSave), !, retractall(last_inference(_, _)). maybe_save_inference(Original, InferenceToSave) :- retractall(last_inference(_, _)), assertz(last_inference(Original, InferenceToSave)). /* **************************************************************************** * * Module (5): Database * * This module serves as the database. * * The following structures are used for recording information and doing * inferences. Any can be asserted or queried as needed. None is present * initially, of course - they are created as the user supplies information. * * Individuals are represented by an individual/1 structure, classes by a * class/1 structure * * isa/2 - relates an individual to a class or a class to a class * description/2 - records a description of an individual or a class. The * second argument is either an atom (representing an * adjective used to describe the individual/class), or the * a structure whose functor is the name of a property and * whose argument is an adjective giving the value of that * property - e.g. white or color(white) * relationship/3 - records a relationship between two individuals and/or * classes. The third argument is the relationship. * ~one of the above - used to record that a given fact is known NOT to hold. * * Class names always use the singular form of the noun naming the class * Properties and relationships always use the stem form of the relevant verb * * Additional entry point: savable_predicate/1 - indicates that the specified * predicate should be stored on disk between runs * *************************************************************************** */ /* The following predicates will be saved if the user saves the database. */ savable_predicate(isa). savable_predicate(description). savable_predicate(behavior). savable_predicate(relationship). savable_predicate(~). /* **************************************************************************** * * Module (6): Engine * * The inference engine is able to infer that an individual is an instance * of a class specified by an isa fact and of all superclasses of that * class; that a class is a subclass of a class specified by an isa fact and * all superclasses of that class; that an individual inherits all properties * of classes of which it is an instance unless blocked by an explicit * negation at a lower level; and that a class inherits all properties of * classes of which it is a subclass unless blocked by an explicit negation * at a lower level. In the case of a relationship, inheritance is done on * both sides of the relationshp. * * The inference engine is also able to return the first two steps used in * the reasoning process to establish an inference, and can redo an inference * to find additional solutions. * * New facts can be added to the knowledge base by assert/1. The following are * the entry points for the inference engine: * * infer/2 - make an inference - can instantiate variables if * present in goal. The second parameter allows * the order of inference to be structured as step 1, * step 2, ... - initially short start at 1 * explain_inference/3 - explain the reasoning behind an inference - used to * answer "why" questions * redo_inference/2 - repeat an inference to find additional solutions - * used to answer "what else" questions * *************************************************************************** */ infer(isa(X, Y), _) :- isa(X, Y). infer(isa(X, Y), 1) :- isa(X, Z), infer(isa(Z, Y), 1). /* The rules for inferring a relationship are complicated by the fact that we have to allow for inheritance in the case of both the first and the second argument, but want to not be able to derive the same conclusion through two different paths. The second (step number) argument to infer is used to control order. */ infer(relationship(X, Y, R), _) :- relationship(X, Y, R). infer(relationship(X, Y, R), 1) :- isa(X, Z), infer(relationship(Z, Y, R), 1), /* The following suppresses inheritance when appropriate. */ not infer(~relationship(X, Y, R), 2). infer(relationship(X, Y, R), 1) :- isa(Y, Z), infer(relationship(X, Z, R), 2), /* The following suppresses inheritance when appropriate. */ not ~relationship(X, Y, R). infer(relationship(X, Y, R), 2) :- isa(Y, Z), infer(relationship(X, Z, R), 2), /* The following suppresses inheritance when appropriate. */ not ~relationship(X, Y, R). /* Infer things known to be false - (as opposed to assumed false under CWA */ infer(~isa(X, Y), _) :- ~isa(X, Y). infer(~isa(X, Y), 1) :- isa(X, Z), infer(~isa(Z, Y), 1). infer(~relationship(X, Y, R), _) :- ~relationship(X, Y, R). infer(~relationship(X, Y, R), 1) :- isa(X, Z), infer(~relationship(Z, Y, R), 1), /* The following suppresses inheritance when appropriate. */ not infer(relationship(X, Y, R), 2). infer(~relationship(X, Y, R), 1) :- isa(Y, Z), infer(~relationship(X, Z, R), 2), /* The following suppresses inheritance when appropriate. */ not relationship(X, Y, R). infer(~relationship(X, Y, R), 2) :- isa(Y, Z), infer(~relationship(X, Z, R), 2), /* The following suppresses inheritance when appropriate. */ not relationship(X, Y, R). /* Special code to handle double negatives */ infer(~ ~ Goal, Step) :- infer(Goal, Step). /* * explain_inference/3 - Generate explanation of an inference. First argument * must be an inferable conclusion that is not a fact. * Second and third arguments will be instantiated with * first two steps of inference chain. Fails if first * argument is not inferable */ explain_inference(Inference, Step1, Step2) :- clause(infer(Inference, Step), Body), call(Body), extract_first_steps(Body, Step1, Step2). extract_first_steps((Step1, infer(Step2, _)), Step1, Step2). extract_first_steps((Step1, infer(Step2, _), _), Step1, Step2). extract_first_steps((_, Rest), Step1, Step2) :- extract_first_steps(Rest, Step1, Step2). /* * redo_inference/2 - Redo an inference to find another answer. First argument * must be original query with an uninstqntiated variable; * second must be last answer found. If another solution * is found, original query will be unified with it. * Fails if there are no more solutions. */ redo_inference(Query, Last) :- retractall(last_inference_found), infer(Query, 1), found_right_one(Query, Last). found_right_one(_, _) :- last_inference_found, !. found_right_one(Last, Last) :- assertz(last_inference_found), !, fail. /* **************************************************************************** * * Module (7): Print * * Entry Point: print_sentence/2 * *************************************************************************** */ /* * print_sentence/2 - print a list of words in standard English format, * followed by an optional closing punctuation mark * */ print_sentence([ H | T ], Punct) :- write_capitalized(H), print_list(T), write(Punct), nl. print_list([]). print_list([H, N | T]) :- member(H, ['.', '?', '!']), !, write(H), write(' '), write_capitalized(N), print_list(T). print_list([H | T]) :- member(H, [',', '.', '?', '!']), !, write(H), print_list(T). print_list([H | T]) :- write(' '), write_word(H), print_list(T). write_capitalized(W) :- name(W, [H|T]), capitalize(H, CapH), put(CapH), put_rest(T). capitalize(Letter, Cap) :- Letter >= 97, Letter =< 122, !, Cap is Letter - 32. capitalize(Letter, Letter). put_rest([]). put_rest([H | T]) :- put(H), put_rest(T). write_word(i) :- !, write('I'). write_word(W) :- atomic(W), !, write(W). write_word(W) :- W =.. [H | T], write_word(H), print_list(T). /* **************************************************************************** * * Utility predicates: * * member/2 - succeeds if first argument is member of second argument list * append/3 - appends two lists, returns resultant list * **************************************************************************** */ member(I, [I|_]) :- !. member(I, [_|T]) :- member(I,T). append([], L, L). append([H|T], L, [H|AT]) :- append(T, L, AT).