home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / AIE8906.ZIP / MENZIES.CDE < prev    next >
Encoding:
Text File  |  1988-08-18  |  8.3 KB  |  276 lines
  1. % Complete Prolog listing of knowledge interpreter/ compiler
  2. % Tim Menzies, 1988
  3.  
  4. :- op(995,    xfx,    if).
  5. :- op(985,    xfx,    then).
  6. :- op(975,    xfy,    or).
  7. :- op(950,    xfy,    and).
  8. :- op(925,    fx,    not).
  9. :- op(900,      fx,     mention).
  10. :- op(900,    xfx,    :=).
  11. :- op(150,    xfx,    are).
  12. :- op(125,    xfy,    of).
  13. :- op(100,    xfx,    from).
  14. :- op( 50,    xfx,    be).
  15. :- op( 50,    xfx,    #).
  16.  
  17. dd(    calf,        % data dictionary for the calf database.
  18.     [cname, pen],     % the key for this database are the two 
  19.             % fields "cname" and "pen". The actual
  20.             % fields are :
  21.     [cname,        % calf name    
  22.     col,        % colour
  23.     tbid,        % tuberculois test ID number
  24.     pen,        % pen number
  25.     yob,        % year of birth
  26.     mood,        % temperament
  27.     sex,        % sex
  28.     balls]).    % castrated?
  29.  
  30. calf(    daisy,    brown,    456,    7,    1987,    sweet,    female,    no).
  31. calf(    ivy,    red,    546,    8,    1988,    aloof,    female,    no).
  32. calf(    ben,    brown,    465,    9,    1986,    nasty,    male,    yes).
  33. calf(    rover,    grey,    701,    10,    1985,    sweet,    male,    no).
  34.  
  35. raw((     known(age,AGE), 
  36.     known(torso,TORSO), 
  37.     known(this_year,NOW),
  38.     bagof(AGE1, 
  39.         (calf(_,_,_,_,YOB,_,_,_),
  40.         AGE1 is NOW-YOB), 
  41.          LIST),
  42.     maximum(LIST,MAX),
  43.     (AGE / (TORSO/2 * 3.14159) + 7) > MAX)).
  44.  
  45. % If "known" can't find a certain fact, it asks the user for the fact, 
  46. % then stores the fact for later use.
  47.  
  48. known(X,Y) :- fact(X,Y) ,!.
  49. known(X,Y) :-
  50.     ask(["Enter a value for [",X,"] : "],Y),
  51.     assert(fact(X,Y)).
  52.  
  53. maximum([H],H).
  54. maximum([H|T],MAX) :- 
  55.     maximum(T,TEMP), 
  56.     (TEMP > H -> MAX is TEMP | MAX is H).
  57.  
  58. rad(DIAM,X) :- X is DIAM/(2 * 3.14159).
  59. maxof(X,Y)  :- bagof(Y,X,L), maximum(L,Y).
  60.  
  61. :- op(900,xfx,if), op(850,xfx,then), op(800,xfy,and).
  62. X and Y :- X,Y.
  63.  
  64. rule1 
  65. if      known(age,AGE)        and 
  66.     known(this_year,NOW)     and
  67.     maxof(    (calf(_,_,_,_,YOB,_,_,_) and 
  68.         MAX is NOW - YOB),
  69.           MAX)        and
  70.     known(torso,TORSO)     and 
  71.     rad(TORSO,RADIUS)    and
  72.     (AGE / RADIUS + 7) > MAX
  73. then    print("significant!").
  74.  
  75. rule2
  76. if     age / radius of torso + 7  > max of age of calf 
  77. then    mention "significant!".
  78.  
  79. rule3
  80. if     age / radius of torso + 7  > eldest_age of calf 
  81. then    mention "significant!".
  82.  
  83. user_knows(age).
  84. user_knows(torso).
  85. user_knows(this_year).
  86.  
  87. pi(3.14159).
  88.  
  89. X from Y be (Z,KEY) :-         % # 1;
  90.     call_list([X,Y,Z,KEY]).    % use known selector for query.
  91. X from Y be (Z,ID) :-         % # 2; clause # 1 failed, 
  92.     not(call_list([X,Y,_,_])),     % and the selector doesn't exist,
  93.     selector(X,Y,SELECTOR),    % make the selector,
  94.     assert(SELECTOR),    % assert it,
  95.     call_list([X,Y,Z,ID]).        % use asserted selector for query.
  96. X from Y be _ :-        % # 3; clause # 2 failed,
  97.     not(call_list([X,Y,_,_])),    % the selector doesn't exist (i.e.
  98.                 % "selector" failed),
  99.     print("Unknown db query [", X from Y,"]."), 
  100.     fail.            % flag an error and fail.
  101.  
  102. call_list(LIST) :-             % construct a Prolog goal at runtime.
  103.     GOAL =.. LIST, 
  104.     call(GOAL).        % call the Prolog theorm prover on that GOAL.
  105. call(GOAL) :- GOAL.        % NOTE: call is a built-in in some Prologs.
  106.  
  107. selector(FIELD,DB, (FIELD(DB,VALUE,KEYS1) :- SELECTOR)) :-
  108.     dd(DB,KEYS,FIELDS),
  109.     length(FIELDS,ARITY),        % built-in Prolog predicate        
  110.     functor(SELECTOR,DB,ARITY),    % built-in Prolog predicate
  111.     args([FIELD|KEYS],FIELDS,SELECTOR,[VALUE|KEYS1]).
  112.  
  113. % args: extract the args that have the same position in CLAUSE as 
  114. % the ELEMENTS in the LIST.
  115. args([],_,_,[]).
  116. args([ELEMENT|ELEMENTS],LIST,CLAUSE,[ARG|ARGS]) :-
  117.     nth(ELEMENT,LIST,NTH),
  118.     arg(NTH,CLAUSE,ARG),        % built-in Prolog predicate
  119.     args(ELEMENTS,LIST,CLAUSE,ARGS).
  120.  
  121. % nth: the atom X is the NTH element within the passed LIST
  122. nth(X,[X|TAIL],1).
  123. nth(X,[Y|TAIL],N) :- nth(X,TAIL,TEMP), N is TEMP + 1.
  124.  
  125. X from Y are Z :-
  126.     are(X,Y,Z,SELECTOR),
  127.     call(SELECTOR).
  128.  
  129. are([], _, [], _).  
  130. are([FIELD|FIELDS], DB, [VALUE|VALUES], SELECTOR) :-  
  131.     selector(FIELD,DB,(FIELD(DB,VALUE,ID) :- SELECTOR)), 
  132.     are(FIELDS,DB,VALUES,SELECTOR).
  133.  
  134. radius(IN,OUT)     :- calc(IN / (2 * pi), OUT).
  135. age(calf,OUT)      :- calc(this_year - yob from calf,OUT).
  136. max(IN, OUT)   :- 
  137.     bagof(OPTION, calc(IN,OPTION),OPTIONS),     
  138.     maximum(OPTIONS,OUT).
  139.  
  140. % Pre-defined operators
  141. % :- op(700, xfx, [is, >=, >, =, /=, <, <=]). 
  142. % :- op(500, yfx, [+, -]), op(500, fx,  [+, -]).
  143. % :- op(400, yfx, [*, /]), op(350, xf,  [^]), op(300, xfx, [mod]).
  144.  
  145. :- op(125,   xfy, of).
  146. :- op(100,   xfx, from).
  147.  
  148. calc(X,X) :-         % # 1; X is a number.
  149.     number(X).    
  150. calc(X of Y,Z) :-     % # 2; X is a procedure.
  151.     call_list([X,Y,Z]).
  152. calc(X of Y,Z) :-    % # 3; X is a undefined procedure
  153.     not(clause(X(Y,Z),_)),
  154.     print("Bad procedure call [",X of Y,"]."),
  155.     fail.
  156. calc(X from Y,Z) :-    % # 4; X is a database query. 
  157.     X from Y be (Z,_).
  158. calc(OP(X, Y), OUT) :-    % # 5; 
  159.     maths(OP),    % we have a mathematical calculation to do;
  160.     calc(X,X1),      % calculate the value of the calculation's    
  161.     calc(Y,Y1),     % parameters;
  162.     Z =.. [OP,X1,Y1], 
  163.     OUT is Z.    % perform the calculation.    
  164. calc(OP(X,Y),true) :-    % # 6;
  165.     logic(OP),    % we have a logical comparision to do;
  166.     calc(X,X1),    % 
  167.     calc(Y,Y1),    %
  168.     call_list([OP,X1,Y1]). 
  169.             % if call_list fails, no value is bound (as per
  170.             % standard Prolog).
  171. calc(X,Y) :-         % # 7; data from the user.
  172.     user_knows(X), 
  173.     known(X,Y).
  174. calc(X,Y) :-         % # 8; a constant.
  175.     atom(X), 
  176.     call_list([X,Y]).
  177.  
  178. maths(infix is).  maths(infix +).  maths(infix -).
  179. maths(infix *).   maths(infix /).  maths(infix ^).
  180. maths(infix mod).
  181.  
  182. logic(infix >=).  logic(infix >).  logic(infix =).  
  183. logic(infix /=).  logic(infix <).  logic(infix <=).  
  184.  
  185. expand(X,Y,VAL) :- 
  186.     expand_calc(X,Y,VAL), 
  187.     !.            % only do one parse
  188.  
  189. expand_calc(X,_,_) :-         % # 1 : catch variables before they
  190.     var(X),            % fall into the rest of the parse
  191.                 % and match inappropriately.
  192.     print("ERROR: variable in expression").
  193. expand_calc(OP(X,Y), CODE,OUT) :-     % # 2 : expand boolean expressions.
  194.     logic(OP), 
  195.     expand(X,CODE1,OUT1), 
  196.     expand(Y,CODE2,OUT2),
  197.     optimise(boolean, 
  198.         CODE1,CODE2,OP,OUT1,OUT2,OUT,
  199.         CODE).
  200. expand_calc(OP(X,Y),CODE,OUT) :- % # 3 : expand arithmetic expressions.
  201.     maths(OP),
  202.     expand(X,CODE1,OUT1), 
  203.     expand(Y,CODE2,OUT2),
  204.     optimise(arithmetic, 
  205.         CODE1,CODE2,OP,OUT1,OUT2,OUT,
  206.         CODE).
  207.  
  208. optimise(boolean,             % # 1 : boolean expression,
  209.                     % all values known
  210.     X = VAL1,Y = VAL2,OP,VAL1,VAL2,OUT,
  211.     OUT = OUT) :-
  212.     call_list([OP,VAL1,VAL2]) -> OUT = true | OUT = fail.
  213. optimise(boolean,             % # 2 : boolean expression,
  214.                     % LHS known, RHS unknown
  215.     VAL1 = VAL1,CODE2,OP,VAL1,OUT2,OUT,
  216.     (CODE2,OP(VAL1,OUT2),OUT = true)).
  217. optimise(boolean,             % # 3 : boolean expression,
  218.                     % LHS unknown, RHS known
  219.     CODE1,VAL2 = VAL2,OP,OUT1,VAL2,OUT,
  220.     (CODE1,OP(OUT1,VAL2),OUT = true)).
  221. optimise(boolean,            % # 4 : boolean expression,
  222.                     % all unknown. 
  223.     CODE1,CODE2,OP,OUT1,OUT2,OUT,
  224.     (CODE1,CODE2,OP(OUT1,OUT2),OUT = true)).
  225. optimise(arithmetic,             % # 5 arithmetic expression,
  226.                     % all values known
  227.     VAL1 = VAL1,VAL2 = VAL2,OP,VAL1,VAL2,OUT,
  228.     OUT = OUT) :-
  229.     CODE =.. [OP,VAL1,VAL2],
  230.     OUT is CODE.
  231. optimise(arithmetic,             % # 6 arithmetic expression,
  232.                     % LHS known, RHS unknown
  233.     VAL1 = VAL1,CODE2,OP,VAL1,OUT2,OUT,
  234.     (CODE2, OUT is CODE)) :-
  235.     CODE =.. [OP,VAL1,OUT2].
  236. optimise(arithmetic,             % # 7 arithmetic expression,
  237.                     % LHS unknown, RHS known
  238.     CODE1,VAL2 = VAL2,OP,OUT1,VAL2,OUT,
  239.     (CODE1, OUT is CODE)) :-
  240.     CODE =.. [OP,OUT1,VAL2].
  241. optimise(arithmetic,             % # 8 arithmetic expression,
  242.                     % all unknown.
  243.     CODE1,CODE2,OP,OUT1,OUT2,OUT,
  244.     (CODE1, CODE2, OUT is CODE)) :-
  245.     CODE =.. [OP,OUT1,OUT2].
  246.  
  247. max(    IN, OUT,
  248.     CODE = calc(IN,OPTION))   
  249.     :- 
  250.     bagof(OPTION,CODE,OPTIONS),     
  251.     maximum(OPTIONS,OUT).
  252.  
  253. expand_calc(X of Y,CODE,OUT) :-        % # 5 : calls to a
  254.                     % simple procedure.
  255.     clause(X(Y,OUT),calc(THIS,OUT)),
  256.     expand(THIS,CODE,OUT).
  257. expand_calc(X of Y,TAIL,OUT) :-     % # 6 : calls to 
  258.                     % a non-simple procedure.
  259.     clause(X(Y,OUT,CODE = calc(THIS,VAR)),TAIL),
  260.     expand(THIS,CODE,VAR).
  261. expand_calc(X from Y,SELECTOR,OUT) :-     % # 7 : database queries,
  262.     clause(X(Y,OUT,_),SELECTOR).      % return a known selector
  263. expand_calc(X from Y,X(Y,OUT,_),OUT) :- % # 8 : database query,
  264.     selector(X,Y,X(Y,OUT,_)).      % generate and return a selector
  265. expand_calc(X,Y = Z,Y) :-         % # 9 : constants
  266.     atom(X), 
  267.     clause(X(Z),true).
  268. expand_calc(X,known(X,OUT),OUT) :-    % # 10 : facts from the user.
  269.     user_knows(X).
  270. expand_calc(X,Y = X,Y) :-        % # 11 : numbers. 
  271.     number(X).
  272. expand_calc(X,_,_) :-            % # 12 : none of the above-
  273.                     % invalid structure
  274.     print("Compiler failure on [",X,"]."), 
  275.     fail.                % flag an error and fail.
  276.