;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  attention.lisp
;;;  Written by:  Shaul Markovitch
;;;  Last time modified: 10/1/2000
;;;
;;;  This file contains the set of techniques used for macro
;;;  generation and attention filtering.  An attention filter
;;;  technique gets the search node of the goal state and returns a
;;;  set of newly generated macros.  Typically such a technique will
;;;  extract the solution path and will select subpathes that will be
;;;  converted
;;;  to macros. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; spread-attention-filter is a rather primitive attention filtering
;;; technique.  Its parameters are the minimum and maximum length of
;;; generated macros.  It goes along the solution path and cut it to
;;; subpathes whoes length is randomly generated between these values.
;;; It is called "spread" because it has some logic - it generates
;;; macros that are spread over the space.
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass attention-filter ()())

(defparameter *default-minimal-length* 3)
(defparameter *default-maximal-length* 10)

(defclass spread-attention-filter 
  (attention-filter)
  ((min-length 
  :initform *default-minimal-length*
  :initarg :min-length
  :accessor spread-attention-filter-min-length)
    (max-length 
   :initform *default-maximal-length*
  :initarg :max-length
  :accessor spread-attention-filter-max-length)
   ))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; generate-macros
;;;
;;; This is the main function which is called from the learning
;;; component.  It gets as input the outcome of the search (specified
;;; as a "search-outcome" structure), the attention technique
;;; (specified as a "technique" structure), and the domain (specified
;;; as a "domain" structure).  Its only operation is to call the
;;; technique function.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  
  
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; speard-macros
;;;
;;; The actual function that implements the spread-macros technique.
;;; It calls the "extract-path" function in order to extract from the
;;; solution node a list of states and operators that makes the
;;; solution path.  It then loops over the path, and build macros of
;;; random length which is not shorter than the minimum length defined
;;; in the technique and not longer than the maximum length.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod generate-macros
  (search-outcome (attention-method spread-attention-filter) domain
  macro-db search-strategy)
  (declare (ignore macro-db search-strategy))
  (let* ((min-length (spread-attention-filter-min-length attention-method))
         (max-length (spread-attention-filter-max-length attention-method))	
         (solution-path (extract-path search-outcome domain))
         
         )    
     (loop while (>= (length solution-path) min-length)
           for macro-length = (min
                               (+ min-length
                                 (random (- max-length min-length)))
                               (length solution-path))
           collect (make-macro
                              :start-state (second (pop solution-path))
                              :end-state (second (elt solution-path 
                                                      (- macro-length 2)))
                              :operators 
                                  (loop repeat (1- macro-length)
                                        for op-state = (pop solution-path)
                                        collect (first op-state))
                              :length macro-length))))
                                  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; min-to-better
;;;
;;; Extracts paths that lead from a local minimum to the first state
;;; which is better than the local minimum
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass min-to-better (attention-filter)
   ())
 
(defmethod generate-macros
  (search-outcome (attention-method min-to-better) domain 
   macro-db search-strategy)
  (let* (	
        (solution (extract-path search-outcome domain))
        (final-state (search-node-state (search-outcome-solution-path search-outcome)))
         )    
     (loop for element in solution
           for rest-path on (rest solution)
           for val = (third element)
           when (local-minimum-p (second element) final-state domain 
                  macro-db search-strategy :val val)
           collect
             (let* ((ops nil)
               (end-state (loop for cand in rest-path
                     do (push (first cand) ops)
                     (when (< (third cand) val)
                         (return (second cand))))))
                
             (make-macro
               :start-state (second element)
               :end-state end-state
               :operators (reverse ops)
               :length (length ops))))))
 
  
         

(defun local-minimum-p 
   (state final-state domain macro-db search-strategy
   &key (val (funcall (domain-heuristic-fn domain) state final-state)))
   (loop for op in (get-operators state
				  (make-problem :init-state state
						:goal-state
						final-state)
				  domain search-strategy
				  macro-db)
         for succ = (apply-operator op state domain)
         always (or (null succ)
		    (<= val (funcall (domain-heuristic-fn domain)
				     succ final-state)))))
         
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; peak-to-peak
;;;
;;; Extracts paths that connects two heuristic peaks in the solution path
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         
(defclass peak-to-peak (attention-filter)
   ())
 
(defmethod generate-macros
  (search-outcome (attention-method peak-to-peak) domain 
   macro-db search-strategy)
  (declare (ignore macro-db search-strategy))
  (let* (	
        (solution (extract-path search-outcome domain))
        
	(start-state (second (first solution)))
	(ops nil))
     (loop for element in (butlast (rest solution))
           for previous-element in (butlast solution 2)
	   for next-element in (rest (rest solution))
	   do  (push (first element) ops)
	   when (and (< (third element)(third previous-element))
		      (< (third element)(third next-element)))
	   collect
	   (let
	       ((new-macro 
		 (make-macro
		  :start-state start-state
		  :end-state (second element)
		  :operators (reverse ops)
		  :length (length ops))))
	     (setf start-state (second element)
		   ops nil)
	     new-macro))))