Liren Large Software Subsidy 9/09.iso/e/e051/2.ddi/EXAMPLES/MAC.OPS

Text File | 1986-10-18 | 11.3 KB | 366 lines

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A solution to the missionaries and cannibals problem
;;;
;;; This is a slightly repaired version of mac2.ops.  We want to make another
;;; version that makes left-would-be's one at a time, and doesn't make any
;;; (or at least not many) illegal proposed moves.  However, it must make
;;; illegal moves, since it builds on moves to make moves with greater
;;; numbers in the boat.  It would also be a good
;;; idea to have it remember things that didn't work, stored out on a file
;;; as separate productions.
;;;
;;; Paul suggests renaming the left-would-be's, etc, so that they don't
;;; get used in later instantiations
;;;
;;; Just split the move-left move-right rules to each make only one
;;; replacer, which doesn't let things go negative on the left.

(literalize left-bank-before move dir cannibals missionaries)
(literalize left-would-be move c-in-boat t-in-boat
              cannibals missionaries uid)

;;;;;;;;;;;;;;;;;;; generate possible moves ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generate moves left to right
;;;
;;; Some illegal moves are allowed to generate, so that legal moves may
;;; be built from them, as in [left 3c 3m, boat holds 3, can't move 2m to
;;; right, but can move 3m to right

;;; prevent negatives, but allow illegals
(p move-left-to-right-2m
    {<nboat> (num-in-boat 1)}
    (move <i> to-right)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries {<m> > 1})
  -->
  (make left-would-be ^move <i> ^c-in-boat 0 ^t-in-boat 2
    ^cannibals <c> ^missionaries (compute <m> - 2) ^uid (genatom)))

;;; only if it is legal
(p move-left-to-right-cm
    {<nboat> (num-in-boat 1)}
    (move <i> to-right)
    (left-bank-before ^move <i> ^cannibals {<c> > 0}
                ^missionaries {<m> = <c>})
  -->
  (make left-would-be ^move <i> ^c-in-boat 1 ^t-in-boat 2
    ^cannibals (compute <c> - 1) ^missionaries (compute <m> - 1)
    ^uid (genatom)))

;;; prevent negatives, not illegals
(p move-left-to-right-2c
    {<nboat> (num-in-boat 1)}
    (move <i> to-right)
    (left-bank-before ^move <i> ^cannibals {<c> > 1} ^missionaries <m>)
  -->
  (make left-would-be ^move <i> ^c-in-boat 2 ^t-in-boat 2
    ^cannibals (compute <c> - 2) ^missionaries <m>     ^uid (genatom)))

(p move-left-to-right-plus-c
    (move <i> to-right)
    (boat-holds <k>)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    (num-in-boat {<nb> > 1 < <k>})
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
                 ^cannibals {<cl> > 0} ^missionaries <ml>)
  -->
  (make left-would-be ^move <i>
    ^c-in-boat (compute <cb> + 1) ^t-in-boat (compute <nb> + 1)
    ^cannibals (compute <cl> - 1) ^missionaries <ml> ^uid (genatom)))

(p move-left-to-right-plus-m
    (move <i> to-right)
    (start-num <n>) (boat-holds <k>)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    (num-in-boat {<nb> > 1 < <k>})
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
                 ^cannibals <cl> ^missionaries {<ml> > 0})
  -->
  (make left-would-be ^move <i>
    ^c-in-boat <cb> ^t-in-boat (compute <nb> + 1)
    ^cannibals <cl> ^missionaries (compute <ml> - 1) ^uid (genatom)))

;;; Generate moves right to left ;;;

;;; prevent negatives, not illegals
(p move-right-to-left-1m
    {<nboat> (num-in-boat 0)}
    (move <i> to-left)
    (start-num <n>)
    (left-bank-before ^move <i> ^cannibals <c>
                ^missionaries {<m> < <n>})
  -->
  (make left-would-be ^move <i> ^c-in-boat 0 ^t-in-boat 1
    ^cannibals <c> ^missionaries (compute <m> + 1) ^uid (genatom)))

(p move-right-to-left-1c
    {<nboat> (num-in-boat 0)}
    (move <i> to-left)
    (start-num <n>)
    (left-bank-before ^move <i> ^cannibals {<c> < <n>} ^missionaries <m>)
  -->
  (make left-would-be ^move <i> ^c-in-boat 1 ^t-in-boat 1
    ^cannibals (compute <c> + 1) ^missionaries <m> ^uid (genatom)))

(p move-right-to-left-plus-c
    (move <i> to-left)
    (start-num <n>)
    (boat-holds <k>)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    (num-in-boat {<nb> < <k>})
    (left-would-be ^move <i> ^c-in-boat <cb>
                 ^t-in-boat <nb>
        ^cannibals {<cl> < <n>} ^missionaries <ml>)
  -->
  (make left-would-be ^move <i>
    ^c-in-boat (compute <cb> + 1) ^t-in-boat (compute <nb> + 1)
    ^cannibals (compute <cl> + 1) ^missionaries <ml> ^uid (genatom)))


(p move-right-to-left-plus-m
    (move <i> to-left)
    (start-num <n>)
    (boat-holds <k>)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    (num-in-boat {<nb> < <k>})
    (left-would-be ^move <i> ^c-in-boat <cb>
                 ^t-in-boat <nb>
        ^cannibals <cl> ^missionaries {<ml> < <n>} )
  -->
  (make left-would-be ^move <i>
    ^c-in-boat <cb> ^t-in-boat (compute <nb> + 1)
    ^cannibals <cl> ^missionaries (compute <ml> + 1) ^uid (genatom)))

(p incremental-remove-duplicates
    (num-in-boat)
    -(prune-moves duplicates)
   -->
  (make prune-moves duplicates))

(p increment-num-in-boat
    (boat-holds <k>)
    {<nboat> (num-in-boat {<nb> < <k>})}
    {<duple> (prune-moves duplicates)}
   -->
  (remove <duple>)
  (modify <nboat> ^2 (compute <nb> + 1)))

(p end-move-generate
    (boat-holds <k>)
    {<nboat> (num-in-boat >= <k>)}
    (move <i> <dir>)
   -->
   (remove <nboat>)
   (make prune-moves <dir>))

;;;;;;;;;;;;;;;;;;;;;;;; prune moves left or right ;;;;;;;;;;;;;;;;;
;;; note that if the before and after conditions on the banks
;;; are legal, the boat trip must also have been legal


(p too-many-cannibals-left
    (move <i>)
    {<illegal>
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
        ^cannibals <cl> ^missionaries {> 0 < <cl>})}
       (prune-moves << to-left to-right >>)
  -->
  (remove <illegal>))


(p too-many-cannibals-right
    (start-num <n>)
    (move <i>)
    {<illegal>
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
        ^cannibals <cl> ^missionaries {> <cl> < <n>})}
       (prune-moves << to-left to-right >>)
  -->
  (remove <illegal>))


(p delete-duplicates
    (move <i>)
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
               ^cannibals <cl> ^missionaries <ml> ^uid <uid>)
       {(left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
                  ^cannibals <cl> ^missionaries <ml> ^uid <> <uid>)
    <duple>}
       (prune-moves << duplicates to-left to-right >>)
  -->
  (remove <duple>))

(p no-return
       (prune-moves << to-left to-right >>)
    (start-num <n>) (move <i> <dir>)
      (left-bank-before ^dir <> <dir> ^cannibals <cl>
                           ^missionaries <nl>)
    (left-would-be ^move <i> ^cannibals <cl>
                     ^missionaries <nl>)
  -->
  (remove 5))

(p done-pruning
    (prune-moves {<dir> << to-left to-right >>})
  -->
  (remove 1)
  (make pick <dir>))


;;;;;;;;;;;;;;;;;;; pick move left or right ;;;;;;;;;;;;;;;;;;;;;;;;
;;; Here is where we look for the end condition, discovering we have
;;; solved the problem, because we had to end on a move to the right
;;; success 0 0 is end condition

(p pick-move-left-to-right
    {<picker> (pick to-right)}
    (boat-holds <k>)
    {<mover> (move <i> <dir>)}
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    {<chosen>
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
               ^cannibals <cl> ^missionaries <ml>)}
    {<winometer> (success)}
    -(left-would-be ^move <i> ^t-in-boat > <nb>)
  -->
  (remove <picker>)
  (remove <mover>)
  (remove <chosen>)
  (make left-bank-before ^move (compute <i> + 1) ^dir to-left
             ^cannibals <cl> ^missionaries <ml>)
  (make num-in-boat 0)
  (make move (compute <i> + 1) to-left)
;;; success is added last in order to insure the rule looking for
;;; it fires
  (modify <winometer> success <cl> <ml>))

(p pick-move-right-to-left
    {<picker> (pick to-left)}
    (boat-holds <k>)
    {<mover> (move <i> <dir>)}
    (start-num <n>)
    (left-bank-before ^move <i> ^cannibals <c> ^missionaries <m>)
    {<chosen>
    (left-would-be ^move <i> ^c-in-boat <cb> ^t-in-boat <nb>
               ^cannibals <cl> ^missionaries <ml>)}
    -(left-would-be ^move <i> ^t-in-boat < <nb>)
  -->
  (remove <picker>)
  (remove <mover>)
  (remove <chosen>)
  (make left-bank-before ^move (compute <i> + 1) ^dir to-right
             ^cannibals <cl> ^missionaries <ml>)
  (make move (compute <i> + 1) to-right)
  (make num-in-boat 1))


;;;;;;;;;;;;; back-track if we get stuck ;;;;;;;;;;;;;;;;;;;;;;;

(p no-luck-path-1
    (success > 0)
    (pick)
    -(back-track)
   -->
   (make back-track))

(p no-luck-path-2
    (success ^3 > 0)
    (pick)
    -(back-track)
   -->
   (make back-track))

(p clean-back
    {<keepbacking> (back-track)}
    {<mover> (move <i>)}
    {<wrongpath> (left-bank-before ^move <i>)}
    -(left-would-be ^move <i>)
   -->
   (remove <wrongpath>)
   (modify <mover> ^2 (compute <i> - 1))
   (modify <keepbacking> back-track))

(p back-stop-success
    (back-track)
    {<mover> (move <i>)}
    (left-would-be ^move <i>)
    (left-bank-before ^move <i> ^dir <dir>)
    {<pickup> (pick)}
   -->
   (remove 1)
   (modify <pickup> ^2 <dir>)
   (modify <mover> ^3 <dir>))

(p back-stop-failure
    (back-track)
    {<mover> (move 0)}
    -(left-would-be)
   -->
   (remove 1)
   (remove <mover>)
   (make no-path-works))


;;;;;;;;;;;;;;;;;;; I/O part ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p get-vals (start)  -->
  (remove 1)
  (write
    (crlf)
    "A production system to solve the generalized missionaries"    (crlf)
    "and cannibals problem.  In this problem we have an equal"    (crlf)
    "number of missionaries and cannibals on the left bank of" (crlf)
    "a river, with a boat to take them across.  The boat will" (crlf)
    "not hold all the missionaries and cannibals, so several" (crlf)
    "crossings are needed.  If ever the cannibals outnumber the" (crlf)
    "missionaries on either bank or in the boat, disaster will" (crlf)
    "strike."
    (crlf) (crlf)
    "Enter the number of missionaries starting at the left bank" (crlf)
    "we assume the same number of cannibals on the left bank," (crlf)
    "and no missionaries or cannibals on the right bank" (crlf))
  (bind <x> (accept))
  (write
    (crlf)
    "Enter the maximum number of people who can travel in the" (crlf)
    "boat in one trip." (crlf))
  (bind <y> (accept))
  (make start-num <x>)
  (make boat-holds <y>)
  (make left-bank-before ^move 1 ^dir to-right
             ^cannibals <x> ^missionaries <x>)
  (make success <x> <x>)
  (make num-in-boat 1)
  (make move 1 to-right))

(p we-did-it    (success 0 0)
        (start-num <n>)
        {<aftermove> (move <i>)}
         {<nboat> (num-in-boat 0)}
  -->
  (remove 1 <aftermove> <nboat>)
  (bind <movenum> (compute <i> - 1))
  (write (crlf)(crlf)
      "We have succeeded in transporting " <n> " cannibals"
      (crlf)
      "and " <n> " missionaries safely from the left bank"
    (crlf)
    "to the right bank in " <movenum> " moves."
    (crlf)(crlf)))

(p no-path-end  (no-path-works)
        (start-num <n>)
  -->
  (remove 1 2)
  (write (crlf)(crlf)
     "We have been unable to find a schedule to transport " <n> " cannibals"
     (crlf)
     "and " <n> " missionaries safely from the left bank to the right bank."
     (crlf)(crlf)))

(p no-can-do (start-num > 0) (boat-holds < 2)
   -->
   (write (crlf))
   (write "sorry charlie, no can do.")
   (write (crlf))
   (halt))