;This file contains functions to implement a general search algorithm.
;  The top-level functions is called SEARCH and takes 4 arguments
;     1.  A description of the start state
;     2.  A predicate recognizing goal states
;     3.  A function creating a list of successors of a given state
;     4.  A function estimating the value of a given state
;           (low values correspond to good states--values may be negative)
;  In the case of a minimization problem, if the estimator is always optimistic
;     (i.e., if it always underestimates the value of the best solution
;     attainable from a given state), then the algorithm will return the
;     correct minimal solution
;  In SEARCH, states created but not expanded are stored with their estimated
;     values in a priority queue.  As successors are created, they are paired
;     with their values and inserted into the queue.  The algorithm is based
;     on that of Charniak & McDermott, p.269.


;This is an insertion function for insertion sort.  it inserts the state into
;  the list val-statelist based on the value of the estimator function
;  Initially the state does not have a value, but every element of the
;  val-statelist does.  The state is given a value when it is inserted

(define (insert-sorted state val-statelist estimator)
 (cond ((null? val-statelist) (list (build-val-state (estimator state) state)))       ((< (estimator state) (eval-state (car val-statelist)))
                               (cons (build-val-state (estimator state) state)
                                          val-statelist))
       ( else (cons (car val-statelist)
                    (insert-sorted state (cdr val-statelist) estimator)))))


;this is an insertion sort.  the estimator is passed to the insertion function

(define (state-sort statelist estimator)
  (cond ((null? statelist) #!null)
        ( else (insert-sorted (car statelist)
                     (state-sort (cdr statelist) estimator) estimator))))


;These functions retrieve the value and state components of a value-state pair
;  and construct such a pair given the two components

(define (eval-state val-state) (car val-state))
(define (build-val-state val state) (list val state))
(define (get-state val-state) (cadr val-state))


;This function merges two lists of value-state pairs

(define (state-merge val-statelist1 val-statelist2)
  (cond ((null? val-statelist1) val-statelist2)
        ((null? val-statelist2) val-statelist1)
        ((< (eval-state (car val-statelist1)) (eval-state (car val-statelist2)))
               (cons (car val-statelist1)
                     (state-merge (cdr val-statelist1) val-statelist2)))
        ( else (cons (car val-statelist2)
                     (state-merge val-statelist1 (cdr val-statelist2))))))


;This is the main function.  It initializes the queue and calls a recursive
;  search function

(define (search start goal? successors estimator)
  (rec-search (list (build-val-state (estimator start) start))
              goal?
              successors
              estimator))


;This is the recursive version of the search function which does all the work.
;  As long as the queue is not empty, this function will fetch and expand the
;  first state in the queue, and merge the successors into the queue.
;  If the state fetched from the queue is ever a goal state, this goal
;  state will be returned.  Otherwise, the empty list is returned.

(define (rec-search queue goal? successors estimator)
  (cond ((null? queue) '( ))
        (else (let ((current (get-state (car queue))))
                (cond ((goal? current) current)
                      (else (rec-search 
                              (state-merge 
                                (state-sort (successors current) estimator)
                                (cdr queue))
                              goal?
                              successors
                              estimator)))))))



;These are the four arguments for a sample instance of the sum of subsets
;  problem.  A state for this problem consists of
;     in position 3, the elements not yet considered
;     in position 2, the elements included so far
;     in position 1, the sum of the elements included so far
;  Here the target sum is 100, and the legal elements are
;     1, 2, 4, 8, 16, 32, 64, and 128.

(define start '(0 () (128 64 32 16 8 4 2 1)))
(define (goal? state) (= (car state) 100))

      ;This function builds a list of the states obtained by first including
      ;  and then excluding the current element

(define (successors state)
  (cond ((null? (caddr state)) '())
        (else (list (list (+ (car state) (caaddr state))
                          (cons (caaddr state) (cadr state))
                          (cdaddr state))
                    (list (car state) (cadr state) (cdaddr state))))))

      ;States which have already exceeded the target sum are given very
      ;  large estimates.  Otherwise the estimate is just the distance
      ;  from the target
(define (estimator state)
  (cond ((> (car state) 100) 9999)
        (else (- 100 (car state)))))

;this function just makes execution a little easier

(define (go) (search start goal? successors estimator))