;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-

;;; Copyright 2007 by Robert St. Amant.

;;; To download the code for simple-POP and simple-GP, visit
;;; <http://www.csc.ncsu.edu/faculty/stamant/simple-pop/simple-pop.html>.

;;; This software is released under the license described by Peter
;;; Norvig: <http://www.norvig.com/license.html>.  If you find this
;;; software useful, please send email to <stamant@csc.ncsu.edu>.

;;; About simple-planners.lisp:

;;; This code is intended to provide a relatively consistent interface
;;; to the functionality of simple-POP (both versions) and simple-GP.
;;; While these planners can be invoked by the functions simple-POP
;;; and simple-GP, respectively, it seems reasonable have a consistent
;;; method by which any of the planners can be used.  This is done via
;;; classes that wrap up the pre-processing functionality and variable
;;; binding context specific to each planner.  For example, an action
;;; in the propositional version of simple-POP is an instance of the
;;; class propositional-action, while in the first-order version it's
;;; an instance of first-order-action; this is managed by binding
;;; *action-class* appropriately.  The simple-POP planners can take
;;; actions directly from a domain definition, but simple-GP turns
;;; first-order actions into propositions by expanding them and
;;; binding their variables to domain objects.  All this is wrapped up
;;; in the methods plan and generate-actions, which can be specialized
;;; to the class of a specific planner.

;;; Thus, in combination with the PDDL code in
;;; simple-pddl-domains.lisp, we can do the following:

#||
> (plan (make-instance 'propositional-POP-planner) 'sussman :domain 'three-blocks)
#<Plan: Start, (Move C From A To Table), (Move B From Table To C), (Move A From Table To B), Finish>

> (plan (make-instance 'POP-planner) 'sussman :domain 'three-blocks)
#<Plan: Start, (Move C From A To Table), (Move B From Table To C), (Move A From Table To B), Finish>

> (plan (make-instance 'GP-planner) 'sussman :domain 'three-blocks)
#<Plan: [(Move C From A To Table)]; [(Move B From Table To C)]; [(Move A From Table To B)]>
||#

;;; The same planner instance can be reused to solve different
;;; planning problems in different domains.

;;; Alternatively, the specific planner functions can be called
;;; directly, though this requires additional explicit bookkeeping.
;;; Mainly this means setting up the variables that indicate classes
;;; to be instantiated and ensuring that the actions for the planner
;;; are properly structured and available.

;;; ==============================
;;; A basic class for planners, not intended to be instantiated alone.

(defclass basic-planner ()
  ((planner-bindings :accessor planner-bindings :initarg :planner-bindings :initform nil
		   :documentation "An alist of bindings for *plan-class*,
		    *action-class*, and *step-class*, specific to a planner.")))

(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro with-planner-bindings (planner &body body)
  (let ((planner-var (gensym))
	(bindings-var (gensym))) 
    `(let* ((,planner-var ,planner)
	    (,bindings-var (planner-bindings ,planner-var)))
       (progv		 ; Bind dynamic class variables appropriately.
	   (mapcar #'first ,bindings-var)
	    (mapcar #'second ,bindings-var)
	 ,@body)))))

(defmethod plan ((the-planner basic-planner) problem &rest rest &key domain &allow-other-keys)
  (let* ((problem (PDDL-problem problem domain)))
    (with-planner-bindings the-planner
      (apply #'run-planner the-planner
	     (PDDL-problem-init problem) (PDDL-problem-goal problem)
	     (generate-actions the-planner (domain-action-forms domain) problem)
	     rest))))

(defmethod generate-actions ((the-planner basic-planner) action-forms problem)
  (declare (ignore problem))
  (mapcar #'(lambda (action-form)
	      (apply #'make-action :allow-other-keys t action-form))
	  action-forms))

;;; ==============================
;;; A propositional POP planner

(defvar *propositional-POP-planner-bindings*
  '((*action-class* propositional-action)
    (*step-class* propositional-step)
    (*plan-class* propositional-pop-plan)
    ;; AIMA compatibility
    (*variable-prefix-char* #\?)))

(defclass propositional-POP-planner (basic-planner)
  ()
  (:default-initargs
   :planner-bindings *propositional-POP-planner-bindings*))

(defmethod run-planner ((the-planner propositional-POP-planner) init goal actions
			&rest rest &key &allow-other-keys)
  "Extract the initial state, goal, and actions from a problem
  and pass them as arguments to simple-POP."
  (apply #'simple-POP init goal actions :allow-other-keys t rest))

;;; ==============================
;;; A first-order POP planner

;;; Note that the class POP-planner inherits
;;; propositional-POP-planner.  An instance of POP-planner
;;; can be treated identically with an instance of
;;; propositional-POP-planner at the top level, because all the
;;; differences in functionality are governed at the action, step, and
;;; plan level.

;;; That is, the top-level simple-POP function creates a start state
;;; in the form of a minimal plan.  For the propositional planner this
;;; is a propositional-pop-plan instance, for the first-order planner
;;; a pop-plan instance.  The appropriate methods are invoked
;;; automatically; the same happens for actions and steps.  Because
;;; the basic algorithm remains the same for propositional and
;;; first-order POP planning, relatively little needs to be changed.

(defvar *POP-planner-bindings*
  '((*action-class* first-order-action)
    (*step-class* first-order-step)
    (*plan-class* pop-plan)
    ;; AIMA compatibility
    (*variable-prefix-char* #\?)))

(defclass POP-planner (propositional-POP-planner)
  ()
  (:default-initargs
   :planner-bindings *POP-planner-bindings*))

;;; ==============================
;;; A GraphPlan planner

(defvar *GP-planner-bindings*
  '((*action-class* propositional-action)
    (*plan-class* gp-plan)
    ;; AIMA compatibility
    (*variable-prefix-char* #\?)))

(defclass GP-planner (basic-planner)
  ()
  (:default-initargs
   :planner-bindings *GP-planner-bindings*))

(defvar *GP-planner* (make-instance 'GP-planner))

(defmethod generate-actions ((the-planner GP-planner) action-forms problem)
  (let ((objects (PDDL-problem-objects problem)))
    (loop for action-form in action-forms
       if (getf action-form :parameters)
       append (propositionalize-action action-form objects)
       else collect (apply #'make-action :allow-other-keys t action-form))))

;;; Translate first-order actions into propositions, simply by binding
;;; each parameter of each action to all known objects.

(defmethod propositionalize-action (action-form objects)
  (let ((name (getf action-form :name))
	(parameters (getf action-form :parameters))
	(precond (getf action-form :precond))
	(effect (getf action-form :effect)))
    (multiple-value-bind (neq-list remaining-precond)
	(bipartition-if #'inequalityp precond)
      (let ((inequalities (mapcar #'make-neq neq-list)))
	(loop for bindings in (all-bindings-list parameters objects)
	   when (valid-bindings-p bindings inequalities)
	   collect (make-action :name (propositionalized-action-name name bindings)
				:precond (sublis bindings remaining-precond)
				:effect (sublis bindings effect)))))))

(defun all-bindings-list (variables values &optional (bindings-list (list nil)))
  (if (null variables)
      bindings-list
      (apply #'append
	     (mapcar #'(lambda (bindings)
			 (mapcar #'(lambda (value)
				     (cons (make-binding (first variables) value)
					   bindings))
				 values))
		     (all-bindings-list (rest variables)
					values bindings-list)))))

(defun propositionalized-action-name (name bindings)
  (list name (mapcar #'binding-val bindings)))

(defmethod run-planner ((the-planner GP-planner) init goal actions
			&rest rest &key &allow-other-keys)
  (multiple-value-bind (solution solution-p planning-graph)
      (apply #'simple-GP init goal actions :allow-other-keys t rest)
    (values (when solution-p
	      (make-plan :actions solution :planning-graph planning-graph))
	    solution-p
	    planning-graph)))

;;; ==============================
;;; EOF