home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_NOV86.ZIP / CHAIN.NOV < prev    next >
Encoding:
Text File  |  1986-09-25  |  17.1 KB  |  666 lines
  1.  
  2.  
  3.                    Forward Chaining in PROLOG
  4.                         by Dennis Merrit
  5.                 November 1986 AI EXPERT magazine
  6.  
  7.  
  8.  
  9.                  OOPS - A Toy Production System
  10.  
  11. This is an interpreter for files containing rules coded in the
  12. OOPS format.
  13.  
  14. The => prompt accepts three commands:
  15.  
  16.    load. -  prompts for name of rules file
  17.             enclose in single quotes
  18.    exit. -  does what you'd expect
  19.    go.   -  starts the inference
  20.  
  21. hit any key to continue
  22.  
  23. =>load.
  24. File name? 'room.ari'.
  25. =>go.
  26.  
  27. Enter a single item of furniture at each prompt.
  28. Include the width (in feet) of each item.
  29. The format is Item:Length.
  30.  
  31. The legal values are:
  32. [couch,chair,table_lamp,end_table,coffee_table,tv,standing_lamp,end]
  33.  
  34. When there is no more furniture, enter "end:end".
  35. adding - goal(read_furniture)
  36. Rule fired 1
  37.  
  38. furniture> couch:6.
  39. adding - furniture(couch,6)
  40. Rule fired 3
  41.  
  42. furniture> chair:4.
  43. adding - furniture(chair,4)
  44. Rule fired 3
  45.  
  46. furniture> chair:3.
  47. adding - furniture(chair,3)
  48. Rule fired 3
  49.  
  50. furniture> coffee_table:5.
  51. adding - furniture(coffee_table,5)
  52. Rule fired 3
  53.  
  54. furniture> end_table:2.
  55. adding - furniture(end_table,2)
  56. Rule fired 3
  57.  
  58. furniture> end_table:3.
  59. adding - furniture(end_table,3)
  60. Rule fired 3
  61.  
  62. furniture> tv:4.
  63. adding - furniture(tv,4)
  64. Rule fired 3
  65.  
  66. furniture> sofa:5.
  67. Unknown piece of furniture, must be one of:
  68. [couch,chair,table_lamp,end_table,coffee_table,tv,standing_lamp,end]
  69. Rule fired 4
  70.  
  71. furniture> table_lamp:2.
  72. adding - furniture(table_lamp,2)
  73. Rule fired 3
  74.  
  75. furniture> end:end.
  76. adding - furniture(end,end)
  77. Rule fired 3
  78. adding - goal(read_walls)
  79. Rule fired 2
  80.  
  81. What is the length of the north and south sides? 10.
  82.  
  83. What is the length of the east and west sides? 7.
  84. adding - wall(north,10)
  85. adding - wall(south,10)
  86. adding - wall(east,7)
  87. adding - wall(west,7)
  88. adding - goal(find_door)
  89. Rule fired 5
  90.  
  91. Which wall has the door? east.
  92.  
  93. What is the width of the door? 4.
  94. adding - wall(east,3)
  95. adding - position(door,east)
  96. adding - goal(find_plugs)
  97. Which walls have plugs? "end" when no more plugs:
  98. Rule fired 6
  99.  
  100. Side: west.
  101. adding - position(plug,west)
  102. Rule fired 8
  103.  
  104. Side: end.
  105. adding - position(plug,end)
  106. Rule fired 8
  107. Rule fired 7
  108. adding - position(couch,north)
  109. adding - wall(north,4)
  110. Rule fired f2
  111. adding - position(tv,south)
  112. adding - wall(south,6)
  113. Rule fired f3
  114. adding - position(coffee_table,front_of_couch : north)
  115. Rule fired f4
  116. adding - position(chair,west)
  117. adding - wall(west,4)
  118. Rule fired f6
  119. adding - position(chair,west)
  120. adding - wall(west,0)
  121. Rule fired f6
  122. adding - position(end_table,north,nolamp)
  123. adding - wall(north,1)
  124. Rule fired f9
  125. adding - position(table_lamp,north)
  126. adding - position(end_table,north,lamp)
  127. Rule fired f11
  128. adding - buy(extension_cord,south)
  129. adding - position(plug,south)
  130. Rule fired f12
  131. adding - buy(extension_cord,north)
  132. adding - position(plug,north)
  133. Rule fired f13
  134. Recommendations:
  135.  
  136. furniture positions:
  137.  
  138. position(plug,north)
  139. position(plug,south)
  140. position(table_lamp,north)
  141. position(chair,west)
  142. position(chair,west)
  143. position(coffee_table,front_of_couch : north)
  144. position(tv,south)
  145. position(couch,north)
  146. position(plug,west)
  147. position(door,east)
  148. position(end_table,north,lamp)
  149.  
  150. purchase recommendations:
  151.  
  152. buy(extension_cord,north)
  153. buy(extension_cord,south)
  154.  
  155. furniture which wouldn't fit:
  156.  
  157. furniture(end_table,2)
  158.  
  159.  
  160. Rule fired f14
  161. =>exit.
  162.  
  163.                          From AI EXPERT:
  164.                             Listing 1
  165.  
  166. % ROOM is an expert system for placing furniture in a living room.
  167. % It is written using the OOPS production system rules language.
  168.  
  169. % It is only designed to illustrate the use of a forward chaining
  170. % rules based language for solving configuration problems.  As such
  171. % it makes many simplifying assumptions (such as furniture has no
  172. % width).  It just decides which wall each item goes on, and does
  173. % not decide the relative placement on the wall.
  174.  
  175. % Furniture to be placed in the room is stored in terms of the form
  176. % "furniture(item,length)".  The rules look for unplaced furniture,
  177. % and if found attempt to place it according to the rules of thumb.
  178. % Once placed, the available space on a wall is updated, the furniture
  179. % is recorded on a wall with a term of the form "position(item,wall)",
  180. % and the original "furniture" term is removed.
  181.  
  182.  
  183. % These are the terms which are initially stored in working storage.
  184. % They set a goal used to force firing of certain preliminary rules,
  185. % and various facts about the problem domain used by the actual
  186. % configuration rules.
  187.  
  188. initial_data([goal(place_furniture),
  189.               not_end_yet,
  190.               legal_furniture([couch, chair, table_lamp, end_table,
  191.                                coffee_table, tv, standing_lamp, end]),
  192.               opposite(north,south),
  193.               opposite(south,north),
  194.               opposite(east,west),
  195.               opposite(west,east),
  196.               right(north,west),
  197.               right(west,south),
  198.               right(south,east),
  199.               right(east,north),
  200.               left(north,east),
  201.               left(east,south),
  202.               left(south,west),
  203.               left(west,north)]).
  204.  
  205. % Rules 1-8 are an example of how to generate procedural behavior
  206. % from a non-procedural rule language.  These rules force a series
  207. % of prompts and gather data from the user on the room and furniture
  208. % to be configured.  They are included to illustrate the kludgy
  209. % nature production systems in a conventional setting.
  210.  
  211. % This is in contrast to rules f1-f14 which elegantly configure the room.
  212.  
  213. rule 1:
  214.   [1: goal(place_furniture),     % The initial goal causes a rule to
  215.    2: legal_furniture(LF)]       % to fire with introductory information.
  216.  ==>                             % It will set a new goal.
  217.   [retract(1),
  218.    cls,nl,
  219.    write('Enter a single item of furniture at each prompt.'),nl,
  220.    write('Include the width (in feet) of each item.'),nl,
  221.    write('The format is Item:Length.'),nl,nl,
  222.    write('The legal values are:'),nl,
  223.    write(LF),nl,nl,
  224.    write('When there is no more furniture, enter "end:end".'),nl,
  225.    assert(goal(read_furniture))].
  226.  
  227. rule 2:
  228.   [1: furniture(end,end),               % When the furniture is read
  229.    2: goal(read_furniture)]             % set the new goal of reading
  230.  ==>                                    % reading wall sizes
  231.   [retract(all),
  232.    assert(goal(read_walls))].
  233.  
  234. rule 3:
  235.   [1: goal(read_furniture),             % Loop to read furniture.
  236.    2: legal_furniture(LF)]
  237.  ==>
  238.   [prompt('furniture> ', F:L),
  239.    member(F,LF),
  240.    assert(furniture(F,L))].
  241.  
  242. rule 4:                              % If rule 3 matched and failed
  243.   [1: goal(read_furniture),          % the action, then member must
  244.    2: legal_furniture(LF)]           % have failed.
  245.  ==>
  246.   [write('Unknown piece of furniture, must be one of:'),nl,
  247.    write(LF),nl].
  248.  
  249. rule 5:
  250.   [1: goal(read_walls)]
  251.  ==>
  252.   [retract(1),
  253.    prompt('What is the length of the north and south sides? ', LengthNS),
  254.    prompt('What is the length of the east and west sides? ', LengthEW),
  255.    assert(wall(north,LengthNS)),
  256.    assert(wall(south,LengthNS)),
  257.    assert(wall(east,LengthEW)),
  258.    assert(wall(west,LengthEW)),
  259.    assert(goal(find_door))].
  260.  
  261. rule 6:
  262.   [1: goal(find_door)]
  263.  ==>
  264.   [retract(1),
  265.    prompt('Which wall has the door? ', DoorWall),
  266.    prompt('What is the width of the door? ', DoorWidth),
  267.    retract(wall(DoorWall,X)),
  268.    NewWidth = X - DoorWidth,
  269.    assert(wall(DoorWall, NewWidth)),
  270.    assert(position(door,DoorWall)),
  271.    assert(goal(find_plugs)),
  272.    write('Which walls have plugs? "end" when no more plugs:'),nl].
  273.  
  274. rule 7:
  275.   [1: goal(find_plugs),
  276.    2: position(plug,end)]
  277.  ==>
  278.   [retract(all)].
  279.  
  280. rule 8:
  281.   [1: goal(find_plugs)]
  282.  ==>
  283.   [prompt('Side: ', Wall),
  284.    assert(position(plug,Wall))]. 
  285.  
  286. % Rules f1-f13 illustrate the strength of rule based programming.
  287. % Each rule captures a rule of thumb used in configuring furniture
  288. % in a living room.  The rules are all independent, transparent,
  289. % and can be easily maintained.  Complexity can be added without
  290. % concern for the flow of control.
  291.  
  292. % f1, f2 - place the couch first, it should be either opposite the
  293. % door, or to its right, depending on which wall is longer.
  294.  
  295. rule f1:
  296.   [1: furniture(couch,LenC),          % an unplaced couch
  297.       position(door, DoorWall),       % find the wall with the door
  298.       opposite(DoorWall, OW),         % the wall opposite the door
  299.       right(DoorWall, RW),            % the wall to the right of the door
  300.    2: wall(OW, LenOW),                % available space opposite
  301.       wall(RW, LenRW),                % available space to the right
  302.       LenOW >= LenRW,                 % if opposite wall bigger than right
  303.       LenC =< LenOW]                  % length of couch less than wall space
  304.  ==>
  305.   [retract(1),                        % remove the furniture term
  306.    assert(position(couch, OW)),       % assert the new position
  307.    retract(2),                        % remove the old wall,length
  308.    NewSpace = LenOW - LenC,           % calculate the space now available
  309.    assert(wall(OW, NewSpace))].       % assert the wall with new space left
  310.  
  311. rule f2:
  312.   [1: furniture(couch,LenC),
  313.    2: position(door, DoorWall),
  314.    3: opposite(DoorWall, OW),
  315.    4: right(DoorWall, RW),
  316.    5: wall(OW, LenOW),
  317.    6: wall(RW, LenRW),
  318.       LenOW =< LenRW,
  319.       LenC =< LenRW]
  320.  ==>
  321.   [retract(1),
  322.    assert(position(couch, RW)),
  323.    retract(6),
  324.    NewSpace = LenRW - LenC,
  325.    assert(wall(RW, NewSpace))].
  326.  
  327. % f3 - the tv should be opposite the couch
  328.  
  329. rule f3:
  330.   [1: furniture(tv,LenTV),
  331.    2: position(couch, CW),
  332.    3: opposite(CW, W),
  333.    4: wall(W, LenW),
  334.       LenW >= LenTV]
  335.  ==>
  336.   [retract(1),
  337.    assert(position(tv, W)),
  338.    retract(4),
  339.    NewSpace = LenW - LenTV,
  340.    assert(wall(W, NewSpace))].
  341.  
  342. % f4, f5 - the coffee table should be in front of the couch or if there
  343. % is no couch, in front of a chair.
  344.  
  345. rule f4:
  346.   [1: furniture(coffee_table,_),
  347.    2: position(couch, CW)]
  348.  ==>
  349.   [retract(1),
  350.    assert(position(coffee_table, front_of_couch:CW))].
  351.  
  352. rule f5:
  353.   [1: furniture(coffee_table,_),
  354.    2: position(chair, CW)]
  355.  ==>
  356.   [retract(1),
  357.    assert(position(coffee_table, front_of_chair:CW))].
  358.  
  359. % f6, f7 - chairs should be on adjacent walls from the couch
  360.  
  361. rule f6:
  362.   [1: furniture(chair,LC),
  363.       position(couch, CW),
  364.       right(CW, ChWa),
  365.       left(CW, ChWb),
  366.    4: wall(ChWa, La),
  367.       wall(ChWb, Lb),
  368.       La >= Lb,
  369.       La >= LC]
  370.  ==>
  371.   [retract(1),
  372.    assert(position(chair, ChWa)),
  373.    NewSpace = La - LC,
  374.    retract(4),
  375.    assert(wall(ChWa, NewSpace))].
  376.  
  377. rule f7:
  378.   [1: furniture(chair,LC),
  379.       position(couch, CW),
  380.       right(CW, ChWa),
  381.       left(CW, ChWb),
  382.       wall(ChWa, La),
  383.    4: wall(ChWb, Lb),
  384.       La =< Lb,
  385.       Lb >= LC]
  386.  ==>
  387.   [retract(1),
  388.    assert(position(chair, ChWb)),
  389.    NewSpace = Lb - LC,
  390.    retract(4),
  391.    assert(wall(ChWb, NewSpace))].
  392.  
  393.  
  394. rule f8:
  395.   [1: furniture(chair,LC),
  396.    2: position(couch, CW),
  397.    3: left(CW, ChW),
  398.    4: wall(ChW, L),
  399.       L >= LC]
  400.  ==>
  401.   [retract(1),
  402.    assert(position(chair, ChW)),
  403.    NewSpace = L - LC,
  404.    retract(4),
  405.    assert(wall(ChW, NewSpace))].
  406.  
  407. % put end_tables next to the couch first, then on the walls with
  408. % the chairs
  409.  
  410. rule f9:
  411.   [1: furniture(end_table,TL),
  412.    2: position(couch, W),
  413.    3: not(position(end_table, W)),
  414.    4: wall(W, L),
  415.       L >= TL]
  416.  ==>
  417.   [retract(1),
  418.    assert(position(end_table, W, nolamp)),
  419.    NewSpace = L - TL,
  420.    retract(4),
  421.    assert(wall(W, NewSpace))].
  422.  
  423. rule f10:
  424.   [1: furniture(end_table,TL),
  425.    2: position(chair, W),
  426.    3: not(position(end_table, W)),
  427.    4: wall(W, L),
  428.       L >= TL]
  429.  ==>
  430.   [retract(1),
  431.    assert(position(end_table, W, nolamp)),
  432.    NewSpace = L - TL,
  433.    retract(4),
  434.    assert(wall(W, NewSpace))].
  435.  
  436. % put the table lamps on the end tables
  437.  
  438. rule f11:
  439.   [1: furniture(table_lamp,_),
  440.    2: position(end_table, W, nolamp)]
  441.  ==>
  442.   [retract(all),
  443.    assert(position(table_lamp, W)),
  444.    assert(position(end_table, W, lamp))].
  445.  
  446. % get extension cords if needed
  447.  
  448. rule f12:
  449.   [1: position(tv, W),
  450.    2: not(position(plug, W))]
  451.  ==>
  452.   [assert(buy(extension_cord, W)),
  453.    assert(position(plug, W))].
  454.  
  455. rule f13:
  456.   [1: position(table_lamp, W),
  457.    2: not(position(plug, W))]
  458.  ==>
  459.   [assert(buy(extension_cord, W)),
  460.    assert(position(plug, W))].
  461.  
  462. % When no other rules fire, here is the summary
  463.  
  464. rule f14:
  465.   [1: not_end_yet]
  466.  ==>
  467.   [retract(1),
  468.    write('Recommendations:'),nl,nl,
  469.    write('furniture positions:'),nl,nl,
  470.    list(position(_,_)),
  471.    list(position(_,_,_)),nl,
  472.    write('purchase recommendations:'),nl,nl,
  473.    list(buy(_,_)),nl,
  474.    write('furniture which wouldn''t fit:'),nl,nl,
  475.    list(furniture(_,_)),nl,nl].
  476.  
  477.  
  478.  
  479.                             Listing 2
  480.  
  481.  
  482. % OOPS - A toy production system interpreter.  It uses a forward chaining,
  483. %        data driven, rule based approach for expert system development.
  484. %
  485. % author Dennis Merritt
  486. % Copyright (c) Hathaway Software, 1986
  487.  
  488. :-public main/0, restart/0.
  489.  
  490. % operator definitions
  491.  
  492. :-op(800,xfx,==>).          % used to separate LHS and RHS of rule
  493. :-op(500,xfy,:).            % used to separate attributes and values
  494. :-op(810,fx,rule).          % used to define rule
  495. :-op(700,xfy,#).            % used for unification instead of =
  496.  
  497. main:- welcome, supervisor.
  498.  
  499. restart:-halt.
  500.  
  501. welcome:-
  502.   cls,
  503.   tmove(5,0),
  504.   write($         OOPS - A Toy Production System$),nl,nl,
  505.   write($This is an interpreter for files containing rules coded in the$),nl,
  506.   write($OOPS format.$),nl,nl,
  507.   write($The => prompt accepts three commands:$),nl,nl,
  508.   write($   load. -  prompts for name of rules file$),nl,
  509.   write($            enclose in single quotes$),nl,
  510.   write($   exit. -  does what you'd expect$),nl,
  511.   write($   go.   -  starts the inference$),nl,nl,
  512.   write($hit any key to continue$),nl,nl,
  513.   keyb(_,_),cls.
  514.  
  515. % the supervisor, uses a repeat fail loop to read and process commands
  516. % from the user
  517.  
  518. supervisor:-
  519.   cls,
  520.   repeat,
  521.   write('=>'),
  522.   read(X),
  523.   do(X),
  524.   fail.
  525.  
  526. % actions to take based on commands
  527.  
  528. do(exit):-halt,!.
  529. do(go):-initialize,go,!.
  530. do(load):-load,!.
  531. do(list):- list,!.       % lists all of working storage
  532. do(list(X)):- list(X),!. % lists all which match the pattern
  533.  
  534. % loads the rules (Prolog terms) into the Prolog database
  535.  
  536. load:-
  537.   write('File name? '),
  538.   read(F),
  539.   [F].                     % loads a rule file into interpreter work space
  540.  
  541. % assert each of the initial conditions into working storage
  542.  
  543. initialize:-
  544.   call(initial_data(X)),
  545.   assert_list(X).
  546.  
  547. % working storage is represented by database terms stored
  548. % under the key "fact"
  549.  
  550. assert_list([]):-!.
  551. assert_list([H|T]):-
  552.   recordz(fact,H,_),
  553.   !,assert_list(T).
  554.  
  555. % the main inference loop, find a rule and try it.  if it fired, say so 
  556. % and repeat the process.  if not go back and try the next rule.  when
  557. % no rules succeed, stop the inference
  558.  
  559. go:-
  560.   call(rule ID: LHS ==> RHS),
  561.   try(LHS,RHS),
  562.   write('Rule fired '),write(ID),nl,
  563.   !,go.
  564. go.
  565.  
  566. % match the LHS against working storage, if it succeeds process the
  567. % actions from the RHS
  568.  
  569. try(LHS,RHS):-
  570.   match(LHS,Lrefs),
  571.   process(RHS,Lrefs),!.
  572.  
  573. % recursively go through the LHS list, matching conditions agains
  574. % working storage
  575.  
  576. match([],[]):-!.
  577. match([N:Prem|Rest],[N:Lref|Lrest]):-
  578.   !,
  579.   (recorded(fact,Prem,Lref);
  580.    test(Prem),Lref=0),          % a comparison test rather than a fact
  581.   match(Rest,Lrest).
  582. match([Prem|Rest],[x:Lref|Lrest]):-
  583.   (recorded(fact,Prem,Lref);    % condition number not specified
  584.    test(Prem),Lref=0),
  585.   match(Rest,Lrest).
  586.  
  587. % various tests allowed on the LHS
  588.  
  589. test(not(X)):-
  590.   recorded(fact,X,_),
  591.   !,fail.
  592. test(not(X)):- !.
  593. test(X#Y):- X=Y,!.
  594. test(X>Y):- X>Y,!.
  595. test(X>=Y):- X>=Y,!.
  596. test(X<Y):- X<Y,!.
  597. test(X=<Y):- X=<Y,!.
  598. test(X = Y):- X is Y,!.
  599. test(member(X,Y)):- member(X,Y),!.
  600.  
  601. % recursively execute each of the actions in the RHS list
  602.  
  603. process([],_):-!.
  604. process([Action|Rest],Lrefs):-
  605.   take(Action,Lrefs),
  606.   !,process(Rest,Lrefs).
  607.  
  608. % if its retract, use the reference numbers stored in the Lrefs list,
  609. % otherwise just take the action
  610.  
  611. take(retract(N),Lrefs):-
  612.   (N == all; integer(N)),
  613.   retr(N,Lrefs),!.
  614. take(A,_):-take(A),!.
  615.  
  616. take(retract(X)):- recorded(fact,X,R), erase(R), !.
  617. take(assert(X)):- recorda(fact,X,_),write(adding-X),nl,!.
  618. take(X # Y):- X=Y,!.
  619. take(X = Y):- X is Y,!.
  620. take(write(X)):- write(X),!.
  621. take(nl):- nl,!.
  622. take(read(X)):- read(X),!.
  623. take(prompt(X,Y)):- nl,write(X),read(Y),!.
  624. take(cls):- cls, !.
  625. take(member(X,Y)):- member(X,Y), !.
  626. take(list(X)):- list(X), !.
  627.  
  628. % logic for retraction
  629.  
  630. retr(all,Lrefs):-retrall(Lrefs),!.
  631. retr(N,[]):-write('retract error, no '-N),nl,!.
  632. retr(N,[N:Lref|_]):- erase(Lref),!.
  633. retr(N,[_|Rest]):- !,retr(N,Rest).
  634.  
  635. retrall([]):-!.
  636. retrall([N:Lref|Rest]):-
  637.   (Lref==0;
  638.    erase(Lref)),
  639.   !,retrall(Rest).
  640.  
  641. % list all of the terms in working storage
  642.  
  643. list:-
  644.   recorded(fact,X,_),
  645.   write(X),nl,
  646.   fail.
  647. list:-!.
  648.  
  649. % lists all of the terms which match the pattern
  650.  
  651. list(X):-
  652.   recorded(fact,X,_),
  653.   write(X),nl,
  654.   fail.
  655. list(_):-!.
  656.  
  657. member(X,[X|_]):-!.
  658. member(X,[H|T]):-
  659.    member(X,T).
  660.  
  661.  
  662. -
  663.   recorded(fact,X,_),
  664.   write(X),nl,
  665.   fail.
  666. li