;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Examples of defining your own heuristic cost fn.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (heuristic-tlform . tlform-spec)
  "Return a cost function that uses a list of temporal formulas specs
   as a heuristic. A tlform-spec is (tlform success unknown fail)
   where, success, unknown, and fail, are heuristic ranks for the
   three cases."
  ;;
  ;;Get the progressed versions of the tlforms from the previous plan
  ;;step, if it exists. Then progress them through the current plan
  ;;step. Finally, return the value of the current plan by testing to
  ;;see if the progressed formulas are true, false, or unknown. 
  ;;
  ;;Complication, use the tlplan::plan-user field to memoize the
  ;;computation. This is a significant savings: (1) the cost function
  ;;can be called multiple times on the same plan, and (2) we don't
  ;;want to evaluate the temporal formulas by progressing them
  ;;through all of the previous worlds, just through the current world
  ;;(which means we must have available the progression through the
  ;;previous worlds.)
  ;;
  (let ((tlforms (map first tlform-spec))
        (success-values (map second tlform-spec))
        (unknown-values (map third tlform-spec))
        (fail-values (map fourth tlform-spec)))
    
    (lambda (plan)
      (let ((pro-tlforms (plan-user plan))
            (prev-tlforms '())
            (prev-plan (plan-previous plan))
            (value 0))
        (cond

         ;; pro-tlform not know, previous plan step exists but does
         ;; not have a progressed tlform. Progress original tlform
         ;; through previous world, memoize, and then through current
         ;; world, memoize.
         
         ((and (null? pro-tlforms) prev-plan
               (null? (plan-user prev-plan)))
          (set! prev-tlforms
            (special-progress tlforms (plan-world/action prev-plan)))
          (set-plan-user prev-plan prev-tlforms)
          (set! pro-tlforms
            (special-progress prev-tlforms (plan-world/action plan)))
          (set-plan-user plan pro-tlforms))
         
         ;; pro-tlform not know, previous step has progressed tlform.
         ;; Progress throught current world and memoize.
         
         ((and (null? pro-tlforms) 
	       prev-plan
               (plan-user prev-plan))
          (set! prev-tlforms (plan-user prev-plan))
          (set! pro-tlforms
            (special-progress prev-tlforms (plan-world/action plan)))
          (set-plan-user plan pro-tlforms)))
        
        ;; Now return value

        (for-each
         (lambda (pro-tlform success unknown fail)
	   (cond
	    ((equal? pro-tlform '(false)) ;plan falsifies.
	     (set! value (+ value fail)))
	    ((equal? pro-tlform '(true)) ;plan satifies.
	     (set! value (+ value success)))
	    (else
	     (set! value (+ value unknown)))))
         pro-tlforms success-values unknown-values fail-values)
        value))))
  
(define (special-progress tlforms world/action)
  "Specialized progress-formula that takes a list of temporal formulas,
   progresses them all and returns (true) or (false) instead
   of T or '(). Also automatically sets bindings to '(). Note that
   progress-formula correctly progresses (true) and (false), so we can
  let tlform take these values."
  (map
   (lambda (tlform)
     (let ((pro-tlform
	    (progress-formula tlform world/action '())))
       (cond
	((eq? pro-tlform #t)
	 '(true))
	((eq? pro-tlform '())
	 '(false))
	(else pro-tlform))))
   tlforms))
       



