home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / prolog / pdprolog / know.pro < prev    next >
Text File  |  1986-05-05  |  14KB  |  423 lines
  1. /*   PIE.TM : A PROLOG INFERENCE ENGINE AND TRUTH MAINTENANCE      */
  2. /*            SYSTEM                                               */
  3.  
  4.  
  5.  
  6. /* This file contains most of the fundamental predicates necessary */
  7. /* for doing truth maintenance. PIE uses the prolog interpreter as */
  8. /* an input parser by declaring most of the PIE syntax as goals.   */
  9. /* Prior to execution the operators must be declared.This is       */
  10. /* simplified by using the redirect feature of ADA Prolog with the */
  11. /* command line:       'prolog kops'                               */
  12. /* The system is not yet complete and several extentions are       */
  13. /* planned, many of which have already been implemented but        */
  14. /* remain to be integrated with this particular piece of code.     */
  15. /* Examples of planned extentions follow: one-directional rules,   */
  16. /* a non-rule based inference based on mathematical set covering,  */
  17. /* confidence factors, and more refined techniques for displaying  */
  18. /* and editing a knowledge base. At the moment it is useful to know*/
  19. /* or have a copy of the underlying representation. There is not   */
  20. /* a lot of code here and it has not been thoroughly tested, but it*/
  21. /* is quite powerful and flexible.                                 */
  22.  
  23.  
  24. /* Sets 'X implies Y' up as a goal. NOTE: In order for the input to*/
  25. /* be parsed properly antecedents and consequents must be given as */
  26. /* lists, e.g. '[X is a male,X is a human] implies [X is a man]'.  */
  27. /* Consequents may themselves be rule declarations. The rules      */
  28. /* are bi-directional and may contain Prolog goals as elements     */
  29. /* of the antecedent or consequent lists. To force forward         */
  30. /* chaining 'fc' may be made a member of the antecedent or         */
  31. /* consequent lists.                                               */
  32.  
  33. X implies Y :-
  34.         assert_r(X implies Y).
  35.  
  36.  
  37.  
  38. /* Cycles through all the forward chaining rules to find out if  */
  39. /* the most recent assertion will cause any to fire. The         */
  40. /* efficiency of this function can be increased dramatically by  */
  41. /* copying the original rule to a 'non-conflict' stack and       */
  42. /* effacing those conditions that have already been met. This    */
  43. /* will result in ever shorter antecednt lists for the rules.    */
  44.  
  45.  
  46. fc:-
  47.         clause(rule(N,D,Y implies Z,C),true),
  48.         given_mem(Y),
  49.         check_mult_con(N,Z),
  50.         fail.
  51. fc.
  52.  
  53. /* Checks to see if an antecedent that is part of a list exists  */
  54. /* as a given in the kb.                                         */
  55.  
  56. given_mem([]).
  57. given_mem([Y|Z]):-
  58.         (Y;fact(N,D,Y,C)),
  59.         given_mem(Z),!.
  60.  
  61. /* Reads through a list of consequents and passes them on to     */
  62. /* the infer function only if they do not already exist in the   */
  63. /* kb. This should be enhanced so that confidence factors can    */
  64. /* be incremented.                                               */
  65.  
  66. check_mult_con(N,[]).
  67. check_mult_con(N,[X|Y]):-
  68.         infer(N,X),
  69.         check_mult_con(N,Y),!.
  70.  
  71.  
  72.  
  73. /*The PIE assert adds facts to the knowledge base. While doing  */
  74. /*so it checks to make sure that no conflicting facts exist. If */
  75. /*conflicting facts do exist their identity is displayed.       */
  76. /*Planned extentions include backward truth maintenance, wherein */
  77. /*the inferences that led to both of the conflicting facts will */
  78. /*be evaluated for confidence and 'distance' from input.        */
  79. /* A typical assertion made by the user might look like:        */
  80. /*                assert([bill is a man]).                      */
  81. /* If the assert(X) is followed by an 'fc', forward chaining    */
  82. /* will occur for the entire system.                            */
  83.  
  84. /* This is a special instance of the PIE assert. It allows new  */
  85. /* relations to be declared in the form of operators. Asserting */
  86. /* 'loves is a relation' will allow subsequent use of 'loves' as*/
  87. /* an infix operator in antecedents or consequents of rules,    */
  88. /* e.g. [X loves Y] implies [Y loves X].                        */
  89.  
  90. assert([]).
  91. assert([X is a Rel|Y]) :-
  92.         nonvar(R),
  93.         R=relation,
  94.         gensym(rel,N),
  95.         asserta(relation(N,_)),
  96.         op(10,xfx,X),
  97.         assert(Y).
  98. assert([X|Y]):-
  99.         fact(Number,Dependence,X,Confidence),
  100.         assert(Y).
  101. assert([X|Y]):-
  102.         fact(Number,Dependence,not(X),Confidence),!,
  103.         print('Sorry, in conflict with existing information.'),nl,
  104.         print('Dependency for ',Number),nl,
  105.         prt_dependency(Number),
  106.         assert(Y).
  107. assert([not(X)|Y]):-
  108.         fact(Number,Dependence,X,Confidence),!,
  109.         print('Sorry, in conflict with existing information.'),nl,
  110.         print('Dependency for ',Number),nl,
  111.         prt_dependency(Number),
  112.         assert(Y).
  113.  
  114. assert([not(X)|Y]):-
  115.         check_word(X,_),
  116.         functor(X,F,N),
  117.         (atom(X);N>0),
  118.         gensym(f,Number),
  119.         assertz(fact(Number,input,not(X),Conf)),
  120.         print('Inserted: ',Number,' not',X),nl,!,
  121.         assert(Y).
  122. assert([X|Y]):-
  123.         check_word(X,_),
  124.         functor(X,F,N),!,
  125.         N>0,
  126.         gensym(f,Number),
  127.         assertz(fact(Number,input,X,C)),
  128.         print('Inserted: ',Number,' ',X),nl,!,
  129.         assert(Y).
  130.  
  131.  
  132. /* Specifically designed for adding rules to the knowledge base */
  133.  
  134. assert_r(not(X)):-
  135.         check_word(X,Y),
  136.         functor(X,F,N),
  137.         F=implies,
  138.         gensym(r,Number),
  139.         assertz(rule(Number,input,not(X),Conf)),!,
  140.         print('Inserted: ',Number,' not',X),nl.
  141. assert_r(X):-
  142.         check_word(X,Y),
  143.         functor(X,implies,N),
  144.         gensym(r,Number),
  145.         assertz(rule(Number,input,X,Conf)),!,
  146.         print('Inserted: ',Number,' ',X),nl.
  147.  
  148. /* The 'infer' clause allows assertions to be made as a result of */
  149. /* inference. It is similar to 'assert', but allows the passing   */
  150. /* of a dependency bound to 'N'.                                  */
  151.  
  152. infer(N,not(X)):-
  153.         fact(Num,Dependence,X,Confidence),!,
  154.         print('Sorry, in conflict with existing information.'),nl,
  155.         print('Dependency of existing info ',Num,' ',X),nl,
  156.         prt_dependency(Num),
  157.         print('Dependence of new conflicting info not',X),nl,
  158.         prt_dependency(N).
  159. infer(N,X):-
  160.         fact(Num,Dependence,not(X),Confidence),!,
  161.         print('Sorry, in conflict with existing information.'),nl,
  162.         print('Dependency of existing info ',Num,'not',X),nl,
  163.         prt_dependency(Num),
  164.         print('Dependence of new conflicting info ',X),nl,
  165.         prt_dependency(N).
  166. infer(N,X):-
  167.         (X;fact(_,_,X,_);rule(_,_,X,_)).
  168. infer(N,X):-
  169.         X='implies'(_,_),
  170.         gensym(r,Number),
  171.         assertz(rule(Number,N,X,Conf)),
  172.         print('Inserted: ',Number,' ',X),nl,!.
  173. infer(N,X):-
  174.         (atom(X);true),
  175.         gensym(f,Number),
  176.         assertz(fact(Number,N,X,Conf)),
  177.         print('Inserted: ',Number,' ',X),nl,!.
  178.  
  179. /* Builds a vocabulary for the system and ensures that typographical errors */
  180. /* are not introduced. A typographical error might result in what would     */
  181. /* to be two different values for an attribute or two different attributes  */
  182. /* for an object.                                                           */
  183.  
  184. check_word(X,_):-
  185.         var(X).
  186. check_word(X,_):-
  187.         word(X).
  188. check_word(X,Y):-
  189.         X= '`s'(A,B),
  190.         check_word(A,A1),
  191.         check_word(B,B1).
  192. check_word(X,Y):-
  193.         X= 'is a'(A,B),
  194.         check_word(A,A1),
  195.         check_word(B,B1),
  196.         setval(B1,A1).
  197. check_word(X,Y):-
  198.         X=F(A,B),
  199.         check_word(A,A1),
  200.         check_word(B,B1),
  201.         setval(A1,B1).
  202. check_word([X|Tail],_):-    /* Allows the use of ';'and lists within a list */
  203.         check_word(X,_),
  204.         (Tail =[];check_word(Tail,_)).
  205. check_word(X,Y):-
  206.         print('Is ',X,' a correct value? y/n: '),
  207.         ((ratom(y),X=Y);(replace_value(Y))).
  208. replace_value(Y):-
  209.         print('Please, type in correct value: '),
  210.         ratom(Y).
  211. setval(A,B):-
  212.         nonvar(A),
  213.         nonvar(B),
  214.         asserta(legval(A,B)).
  215. setval(A,B):-
  216.         nonvar(A),
  217.         asserta(word(A)),
  218.         fail.
  219. setval(A,B):-
  220.         nonvar(B),
  221.         asserta(word(B)),
  222.         fail.
  223. setval(_,_).
  224.  
  225. /* A simple recursive function that will print out the rule    */
  226. /* numbers on which a fact or rule depends. Extensions to this */
  227. /* will allow for viewing in various modes and editing.        */
  228.  
  229. prt_dependency(input).
  230. prt_dependency(N):-
  231.         (fact(N,input,_,_);rule(N,input,_,_)),
  232.         print('input').
  233. prt_dependency(N):-
  234.         (fact(N,D,_,_);rule(N,D,_,_)),
  235.         (fact(D,D1,X,Conf);rule(D,D1,X,Conf)),
  236.         write(D),tab(2),write(X),tab(2),write(Conf),nl,
  237.         prt_dependency(D1).
  238.  
  239. rule(X):-
  240.     rule(X,Dep,Body,Conf),
  241.     print(X,'  ',Dep,'  ',Body,'  ',Conf),nl.
  242. rules:-
  243.     clause(rule(A,B,C,D),true),
  244.     print(A,' ',B,' ',C,' ',D),nl,
  245.     fail.
  246. rules.
  247.  
  248. fact(X):-
  249.     fact(X,Dep,Body,Conf),
  250.     print(X,'  ',Dep,'  ',Body,'  ',Conf),nl.
  251. facts:-
  252.     clause(fact(Num,Dep,Body,Conf),true),
  253.     print(Num,'  ',Dep,'  ',Body,'  ',Conf),nl,
  254.     fail.
  255. facts.
  256.  
  257.  
  258.  
  259. /* Allows removal of rules or facts by reference to their gensym  */
  260. /* index. This could easily be enhanced by allowing instantiation */
  261. /* through explicitly typing out the item to be removed.          */
  262. /* Automatically removes assertions that depend on the retracted  */
  263. /* item.                                                          */
  264.  
  265. remove(N):-
  266.         retract(rule(N,D,X implies Y,C)),
  267.         print('Removed: ',N,' ',X,'implies',Y),nl,
  268.         remove_con(N,Y).
  269. remove(N):-
  270.         retract(fact(N,D,X,C)),
  271.         clause(rule(N1,_,Y implies Z,_),true),
  272.         print('Removed: ',N,' ',X),nl,
  273.         mem(X,Y),
  274.         remove_con(N1,Z),
  275.         fail.
  276.  
  277. /* 'Remove' will automatically forward chain in order re-infer  */
  278. /* things that may be obtained through a different route than   */
  279. /* that affected by the retraction process. This is necessary   */
  280. /* because not all facts are taken advantage of in inferencing. */
  281. /* That is to say, if a fact already exists 'infer' and 'assert'*/
  282. /* will not add them redundantly to the kb. This will change    */
  283. /* with the addition of confidence factors.                     */
  284.  
  285. remove(N):-
  286.         fc.
  287.  
  288.  
  289. /* Exhaustively checks facts in the kb and removes them if they */
  290. /* depend on another item removed. NOTE: 'N=D' is part of a     */
  291. /* disjunction, if it fails the fact will be reinserted in the  */
  292. /* kb. At the moment this does not take advantage of the ADA    */
  293. /* Prolog indexing capability, but it should in a dedicated     */
  294. /* ADA application.                                             */
  295.  
  296. remove_con(N,[]).
  297. remove_con(N,[X|Y]):-
  298.         retract(fact(N1,N,X,C)),
  299.         print('Removed: ',N1,' ',X),nl,
  300.         remove_con(Y).
  301. remove_con([X|Y]):-
  302.         remove_con(Y).
  303.  
  304.  
  305.  
  306.  
  307. /* Activates backward chaining. A complex function, the first */
  308. /* two clauses REQUIRE a list to function properly, but valid- */
  309. /* ation is not done. This is required by the inference       */
  310. /* mechanism. Its effect is to ensure that inheritance is not */
  311. /* carried over to uninstantiated objects.                    */
  312.  
  313. obtain([]).
  314. obtain(X):-
  315.         X =[Y|Z],!,
  316.         obtain_1(Y),
  317.         obtain(Z).
  318. obtain_1(X):-
  319.         X.
  320. obtain_1(X):-
  321.         clause(fact(N,D,X,C),true).
  322.  
  323. obtain_1(X):-
  324.         clause(rule(N,D,Y implies Z,C),true),
  325.         nl,
  326.         not(chk(N)),     /* Prevents double pattern match. */
  327.         mem(X,Z),
  328.         asserta(chk(N)),
  329.         obtain(Y).      /* Recursive check for ant as a con.*/
  330. obtain_1(F(A,B)):-
  331.         X=F(A,F1(C,D)),
  332.         nonvar(F1),!,
  333.         print(A,' ',F,' ',C,' ',F1,' ',D),nl,
  334.         obtain_1a(F(A,F1(C,D))),
  335.         assert([F(A,F1(C,D))]),
  336.         refresh.          /* Removes 'chk' tag. */
  337. obtain_1(F(A,B)):-
  338.         print(A,' ',F,' ',B),nl,
  339.         obtain_1b(F(A,B)),
  340.         assert([F(A,B)]),
  341.         refresh.
  342. obtain_1a(F(A,F1(B,C))):-
  343.         print('Please,fill in the blanks:'),nl,
  344.         get_val(A,_),
  345.         print(A,' ',F,' '),
  346.         get_val(B,A),
  347.         print(B,' ',F1,' '),
  348.         get_val(C,B).
  349. obtain_1b(F(A,B)):-
  350.         print('Please,fill in the blanks:'),nl,
  351.         get_val(A,_),
  352.         print(A,' ',F,' '),
  353.         get_val(B,A).
  354. get_val(X,_):-
  355.         nonvar(X).
  356. get_val(X,Y):-
  357.         listvals(Y),
  358.         r_val(X,Y).
  359. r_val(X,Y):-
  360.         ratom(Z),
  361.       /*  legval(Y,Z), */
  362.         Z=X.
  363.  
  364.  
  365. /* Refreshes rules */
  366. refresh:-
  367.     retract(chk(_)),
  368.     fail.
  369. refresh.
  370.  
  371.  
  372. listvals(_).  /* Temporarily axiomatic */
  373. listvals(X):-
  374.         clause(legval(X,Y),true),
  375.         print(Y),nl,
  376.         fail.
  377. listvals(_).
  378.  
  379.  
  380. /* Standard Prolog append.                                      */
  381.  
  382. append([],X,X).
  383. append([A|B],C,[A|D]):-
  384.         append(B,C,D).
  385.  
  386.  
  387. /* Standard Prolog member.                                      */
  388.  
  389. mem(X,[X|_]).
  390. mem(X,[Y|Z]):-
  391.         mem(X,Z).
  392.  
  393. /* Standard Prolog gensym.                                       */
  394.  
  395. gensym( Root, Atom ) :-
  396.         get_num( Root, Num ),
  397.         name( Root, Name1 ),
  398.         integer_name( Num, Name2 ),
  399.         append( Name1, Name2, Name ),
  400.         name( Atom, Name ).
  401.  
  402. get_num( Root, Num ) :-
  403.         retract( current_num( Root, Num1 )), !,
  404.         Num is Num1 + 1,
  405.         asserta( current_num( Root, Num)).
  406.  
  407. get_num( Root, 1 ) :- asserta( current_num( Root, 1 )).
  408.  
  409. integer_name( Int, List ) :- integer_name( Int, [], List ).
  410. integer_name( I, Sofar, [C|Sofar] ) :-
  411.         I < 10, !, C is I + 48.
  412. integer_name( I, Sofar, List ) :-
  413.         Tophalf is I/10,
  414.         Bothalf is I mod 10,
  415.         C is Bothalf + 48,
  416.         integer_name( Tophalf, [C|Sofar], List ).
  417.  
  418.  
  419. append( [], L, L ).
  420. append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).
  421.  
  422.  
  423.