(in-package :sddr-tests)

;;; Update history:
;;;
;;; 10-14-2015 simplified walking in Monkey and Bananas [CKR]
;;; 10-13-2015 created file, based on DDR version [CKR]

;;; This is a basic framework for doing planning
;;; with the deductive retriever (DDR). 
;;;
;;; There are three core predicates.
;;;
;;;   (PLAN plan start-state goal-state)
;;;      Asserts that plan leads from start-state
;;;      to goal-state. Plan is either nil or
;;;      (CONS action plan).
;;;
;;;   (RESULTS action current-state next-state)
;;;      Asserts that doing action in current-state
;;;      leads to next-state. 
;;;
;;;   (STEP action current-state goal-state)
;;;      Asserts that action is a good step in a plan to get
;;;      from current-state to goal-state. 
;;;
;;; To define a planner:
;;;   - Design the terms to represent actions and states.
;;;     States should be simple and unique, i.e.,
;;;     there should be just one way to describe any
;;;     given state.
;;;
;;;   - Define RESULTS rules to indicate how each action
;;;     changes a state. These rules are normally
;;;     very simple.
;;;
;;;   - Define STEP rules to pick the best action and avoid
;;;     endless loops.
;;;
;;;   - Include the following two rules for PLAN. No others
;;;     are needed.

(defparameter *plan-kb*
  '(
    ;; Use the empty plan if current state = goal state
    (<- (plan nil ?goal ?goal))
    
    ;; Use the plan (cons action actions) if 
    ;;   - action is a good step for the current and goal states
    ;;   - remaining actions is a plan that gets from the 
    ;;     action result state to the goal
    (<- (plan (cons ?action ?actions) ?current ?goal)
        (step ?action ?current ?goal)
        (results ?action ?current ?result)
        (plan ?actions ?result ?goal))
    ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Blocks world, super-simplified
;;;
;;; We represent the state of the world as a stack of
;;; blocks. A stack is a list, e.g.,
;;;
;;;   (cons a (cons b (cons c nil))))
;;;
;;; for the stack with A on B on C. 
;;;
;;; The goal is to change from one stack to another,
;;; using a (minimal) sequence of POP and PUSH actions. 

(defparameter *blocks-world-kb*
  '(
    ;; ACTION RESULT RULES
    
    ;; POP removes the top block of the stack
    ;; (PUSH x) puts x on top of the stack
    
    (<- (results pop (cons ?x ?stack) ?stack))
    
    (<- (results (push ?x) ?stack (cons ?x ?stack)))
    
    ;; STEP SELECTION RULES 

    ;; Choose POP if the current stack isn't a substack
    ;; of the goal stack
    ;; Choose (PUT x) if x + current stack is a substack
    ;; of the goal stack
    
    (<- (step pop ?current ?goal)
        (not (substack ?current ?goal)))
        
    (<- (step (push ?x) ?current ?goal)
        (substack (cons ?x ?current) ?goal))
    
    ;; (SUBSTACK stack1 stack2) is true if stack1
    ;; equals some substack of stack2
    
    (<- (substack ?stack ?stack))
    
    (<- (substack ?s1 (cons ?y ?s2))
        (substack ?s1 ?s2))
    ))

(define-test blocks-world
    (let ((*rules* (append *plan-kb* *blocks-world-kb*)))
      (assert-true
       (ask '(plan ?x nil (cons a nil)) *rules*))
      
      (assert-true
       (ask '(plan ?x (cons a nil) nil) *rules*))
      
      (assert-true
       (ask '(plan ?x (cons a nil) (cons b nil)) *rules*))
      
      (assert-true
       (ask '(plan ?x (cons b (cons a nil)) (cons a (cons b nil)))
            *rules*))
      
      (assert-true
       (ask '(plan ?x 
                   (cons b (cons c (cons a nil))) 
                   (cons c (cons b (cons a nil))))
            *rules*))
      ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Monkey and Bananas
;;;
;;; We represent monkey and banana problem states with
;;; the functional term:
;;;
;;;   (mb-state monkey-loc box-loc)
;;;
;;; Box can be at the DOOR, WINDOW or CENTER or room. 
;;; Monkey can be those places or on top of box. The
;;; goal state has the form
;;;
;;;   (mb-state box-top bananas-loc)
;;;
;;; i.e., the box has to be under the bananas and the
;;; monkey has to be on the box, e.g., 
;;;
;;;   (plan (mb-state door window)
;;;         (mb-state box-top center)
;;;         ?actions))

;;; Rule variable naming conventions:
;;;   mloc - monkey location
;;;   bloc - box location
;;;   gloc - goal (bananas) location

;;; Global variables:
;;;   *monkey-kb* - rules about actions and results
;;;   *room-kb* - the named room locations

(defparameter *monkey-kb*
  '(
    ;; ACTION RESULT RULES
    
    ;; climb-box changes the monkey's location from
    ;; a room location to the top of the box.
    ;;
    ;; The monkey has to be at the box.
    (<- (results climb-box
                 (mb-state ?bloc ?bloc)
                 (mb-state box-top ?bloc)))
    
    ;; push-box changes the location of both the monkey
    ;; and the box.
    (<- (results (push-box ?bloc1 ?bloc2)
                 (mb-state ?bloc1 ?bloc1)
                 (mb-state ?bloc2 ?bloc2)))
        
    ;; walk changes the location of the monkey.
    (<- (results (walk-to ?mloc2)
                 (mb-state ?mloc1 ?bloc)
                 (mb-state ?mloc2 ?bloc)))
    
    
    ;; STEP SELECTION RULES 
    ;;
    ;; These rules are needed to avoid endless loops and wasted
    ;; search. These rules omit many preconditions that don't
    ;; arise in this specific combination of rules.
    
    ;; Choose climb-box if box under bananas, and monkey not
    ;; not on the box already
    (<- (step climb-box
              (mb-state ?gloc ?gloc)
              (mb-state box-top ?gloc)))
    
    ;; Choose push-box to bananas if monkey at box, and
    ;; box not at bananas, 
    (<- (step (push-box ?bloc ?gloc)
              (mb-state ?bloc ?bloc)
              (mb-state ?mloc ?gloc))
        (different ?bloc ?gloc))
    
    ;; Choose walk to box if not at box
    (<- (step (walk-to ?bloc)
              (mb-state ?mloc ?bloc)
              (mb-state ?mloc-2 ?gloc))
        (different ?mloc ?bloc))

    ))

;; A room with 3 locations (box top is not included)

(defparameter *room-kb*
  '(
    (<- (different window center))
    (<- (different center window))
    (<- (different window door))
    (<- (different door window))
    (<- (different center door))
    (<- (different door center))
   ))

(define-test monkey
    (let ((*rules* (append *plan-kb* *monkey-kb* *room-kb*)))
      (assert-true
       (ask '(plan ?plan
                   (mb-state box-top center)
                   (mb-state box-top center))
            *rules*))
      
      (assert-true
       (ask '(plan ?plan
                   (mb-state center center)
                   (mb-state box-top center))
            *rules*))
      
      (assert-true
       (ask '(plan ?plan 
                   (mb-state window window)
                   (mb-state box-top center))
            *rules*))

      (assert-true
       (ask '(plan ?plan
                   (mb-state door window)
                   (mb-state box-top center))
            *rules*))

      (assert-false
       (ask '(plan ?plan
                   (mb-state box-top window)
                   (mb-state box-top center))
            *rules*))
      ))