% props.pl %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % * Adapted in part from rules-swi.pl (original code by Claude Sammut; % modified for iProlog by Bill Wilson, October 2001; % modified for SWI Prolog by Bill Wilson, April 2006). % * Translated and extended for sentence parsing by Ben Meadows, August 2013. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /* * Top-level commands: * run. % Run recognise-act cycles indefinitely. * run(X). % Run as many as X recognise-act cycles. * wm_trace(all). % Start tracing all predicates in working memory, % printing them to the screen at the end of each cycle. * wm_trace. % Stop tracing any predicates. * wm_trace(X). % Start tracing the pattern X, e.g. wm_trace(buffer(_)). * consult(X). % Load a file X in which commands such as % :- add(Y). or :- add_rule(Z). may be given. * add(X). % Add element X to working memory as a fact. * add_rule(X). % Add rule X to the set of rules in production memory. * remove(X). % Remove all elements matching X from working memory. * remove_rule(X). % Remove all rules with *name* X from production memory. * show_wm. % Shows all the facts in working memory. * show_pm. % Shows all the rules in production memory. * reset. % Prepares the system to run again, even if e.g. % in the middle of a run. */ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- dynamic wm/1. % This allows working memory facts to be asserted. :- dynamic pm/1. % This allows production memory rules to be asserted. :- dynamic already_fired/2. :- dynamic tracked_predicate/1. :- dynamic cycle_count/1. :- dynamic glob_cycle_count/1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % To express rules in a natural way, we define some operators % First argument to 'op' is the precedence % Second argument is the associativity (left, right, nonassociative) % Third argument is the operator name (or list of names) % This is basically a cosmetic trick to avoid writing the rules as normal % predicates within nested structures, e.g. % if(rule1, then(and(a, and(b, c)), d). % if(rule2, then(and(a, b), e). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- op(900, xfx, if). :- op(800, xfx, then). :- op(700, xfy, and). :- op(701, fy, if). % For error handling in incorrectly defined rules; % must have greater precedence than 'and' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Prints the contents of memory (we use "wm" to distinguish working memory % elements from other entries in Prolog's data base, and "pm" to similarly % distinguish rules in production memory) show_wm :- print('--------\nWorking Memory:\n'), ignore( (wm(X), print('* '), print(X), nl, fail) ), nl. show_pm :- print('--------\nProduction Memory:\n'), ignore( (pm(X), print('* '), print(X), nl, fail) ), nl. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Reset initial working memory %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% reset :- retractall(already_fired(_, _)), asserta(already_fired(null, false)), retractall(glob_cycle_count(_)), asserta(glob_cycle_count(0)), !. end :- asserta(ended), !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Run the recognise-act cycle % Select a rule, fire it and repeat until no rules are satisfied % If "fire" succeeds, the cut prevents backtracking % If "fire" fails, the cycle will repeat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% run :- run(infinity). run(Cycles) :- printcycle2, retractall(ended), retractall(max_cycle_count(_)), asserta(max_cycle_count(Cycles)), retractall(cycle_count(_)), asserta(cycle_count(0)), ignore(run_system_cycle). run_system_cycle :- ended, !. run_system_cycle :- % Liberal use of cuts to prevent unwanted backtracking !, cycle_count(X), ( ( max_cycle_count(infinity), Y is 0 ) ; ( max_cycle_count(MAX), (X < MAX), Y is (X + 1) ) ), glob_cycle_count(GX), ZX is (GX + 1), retractall(cycle_count(_)), asserta(cycle_count(Y)), retractall(glob_cycle_count(_)), asserta(glob_cycle_count(ZX)), !, select_rule(R), % Select a single rule for firing !, (R = [] ; ( printcycle1(R,ZX), fire(R), printcycle2, !, ignore(run_system_cycle)) ), !. printcycle1([],_) :- !. printcycle1((RuleName if _ then _), Cycle) :- print('Cycle '), print(Cycle), print(' / '), print(RuleName), nl. printcycle2 :- print_tracked_predicates, print('--------\n'). print_tracked_predicates :- true, ignore( (tracked_predicate(X), wm(X), print('* '), print(X), nl, fail) ), true. wm_trace :- retractall(tracked_predicate(_)), !. wm_trace(all) :- asserta(tracked_predicate(_)), !. wm_trace(X) :- asserta(tracked_predicate(X)), !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % "findall" collects all solutions to "can_fire" % "resolve" uses some policy to select one of those rules to fire %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% select_rule(SelectedRule) :- findall(Rule, can_fire(Rule), Candidates), resolve(Candidates, SelectedRule). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Find a rule that hasn't fired before and has its conditions satisfied %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% can_fire(RuleName if Condition then Conclusion) :- pm(RuleName if Condition then Conclusion), % Look up rule in data base satisfied(Condition), % Are all conditions satisfied? not(already_fired(RuleName, Condition)). % Has it already fired? %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % If pattern is "A and ..." then look for A in working memory and then check % the remainder recursively. % % (A and B) = (x and y and z) % A = x % B = y and Z % % If pattern is a single predicate, look it up. % Note that the cuts "!" prevent a conjunction reaching the simple clauses. % % The "check" predicate indicates something that is not a condition to be % located in working memory, but a Prolog command to be checked. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% satisfied(check(equal(X,Y)) and B) :- !, X = Y, satisfied(B). satisfied(check(equal(X,Y))) :- !, X = Y. satisfied(check(not_equal(X,Y)) and B) :- !, X \= Y, satisfied(B). satisfied(check(not_equal(X,Y))) :- !, X \= Y. satisfied(check(is_in(X,Y)) and B) :- !, is_in(X,Y), satisfied(B). satisfied(check(is_in(X,Y))) :- !, is_in(X,Y). satisfied(check(is_not_in(X,Y)) and B) :- !, not(is_in(X,Y)), satisfied(B). satisfied(check(is_not_in(X,Y))) :- !, not(is_in(X,Y)). satisfied(check(member(X,Y)) and B) :- !, member(X, Y), satisfied(B). satisfied(check(member(X,Y))) :- !, member(X, Y). satisfied(check(not_member(X,Y)) and B) :- !, not(member(X, Y)), satisfied(B). satisfied(check(not_member(X,Y))) :- !, not(member(X, Y)). /* satisfied(check(identical(X,Y)) and B) :- !, X == Y, satisfied(B). satisfied(check(identical(X,Y))) :- !, X == Y. satisfied(check(not_identical(X,Y)) and B) :- !, X \== Y, satisfied(B). satisfied(check(not_identical(X,Y))) :- !, X \== Y. */ satisfied(A and B) :- !, wm(A), satisfied(B). satisfied(A) :- !, wm(A). % Recursive member check: Element is a member of [a member of [a...]] List is_in(Element, List) :- member(Element, List). is_in(Element, List) :- member(X, List), is_in(Element, X). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Very simple conflict resolution strategy: pick the first rule. % Also check in case no rules were found. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% resolve([], []) :- !. resolve([X|_], X) :- !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Add "already_fired" clause to database so that this particular instantiation % of the rule is not fired again. % Add all terms in conclusion to database, if not already there. % Fail to force backtracking so that a new execution cycle begins. % % If there is no rule to fire, succeed. This terminates the execution cycle. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% fire(RuleName if Condition then Conclusion) :- !, assert(already_fired(RuleName, Condition)), process(Conclusion). fire(_). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % For each term in condition, add it to working memory if not already there. % 'Remove' retracts something from memory. % 'Add' asserts something to memory. % Other predicates (e.g. 'append' in the parser rules) are simply called. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% process(A and B) :- !, process_element(A), process(B). process(A) :- process_element(A). process_element(remove(X)) :- !, remove(X), !. process_element(add(X)) :- !, add(X), !. process_element(add_rule(X)) :- !, add_rule(X), !. process_element(X) :- X, !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % If term is in memory, don't do anything. % Otherwise, add new term to memory. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add_rule(Name if X then Y) :- pm(Name if X then Y), !. add_rule(Name if X then Y) :- !, assertz(pm(Name if X then Y)), !. add_rule(if X then Y) :- print('ERROR: Rule syntax not recognised. Rule name missing: \n'), print('"if '), print(X), print(' then '), print(Y), print('"'), !. add(A) :- wm(A), !. add(A) :- ground(A), !, assertz(wm(A)), !. remove(X) :- retractall(wm(X)), !. remove_rule(X) :- retractall(pm(X if _ then _)), !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initial directive. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- asserta(glob_cycle_count(0)).