;;; ********************************************************************
;;; case.ss
;;; Susan Fox
;;; December 27, 2000

;;; Contains the Case ADT
;;; There are basic operations common to all cases, and then there are
;;; specifics relating to case indices and content that are defined
;;; separately.  In the case of indices, the operations are somewhat
;;; unified so a single match? function can compute the values for
;;; each different kind of case, and for different kinds of features

;;; Requires utilities to be loaded
(if (not (top-level-bound? 'UTIL.SSLOADED))
    (load "util.ss"))

(define CASE.SSLOADED #t)

;;; *********************************************************************
;;; Case ADT


;;; A case contains an index, case contents, and case statistics

(define make-case
  (lambda (index contents . stats)
    (if (null? stats)
	(list index contents (initial-stats))
	(list index contents stats))))

(define index-of car)
(define contents-of cadr)
(define statistics-of caddr)



;;; *********************************************************************

;;; Statistics for a case are not a global ADT, but they
;;; really are one, just subservient to the Case ADT.  Statistics
;;; for each case are kept as a list of three numbers, plus a list
;;; of the actual match values when the case was selected:  
;;; (num-uses num-success num-fail list-of-match-values)

(define initial-stats
  (lambda ()
    (list 0 0 0 '())))


(define num-uses car)
(define num-success cadr)
(define num-fail caddr)
(define match-values cadddr)


;;; update-stats takes a case, a boolean for the case's success or failure
;;; and the match value for that usage and updates the statistics list
;;; accordingly
;;;
(define update-stats
  (lambda (case success? match-value)
    (let ([stats (statistics-of case)])
      (set-car! stats (add1 (num-uses stats)))
      (if success?
	  (set-car! (cdr stats) (add1 (num-success stats)))
	  (set-car! (cddr stats) (add1 (num-fail stats))))
      (set-car! (cdddr stats) (cons match-value (match-values stats))))))


;;; average-match-value takes a case and returns the average match
;;; value for that case's usage
;;;
(define average-match-value
  (lambda (case)
    (let ([match-list (match-values (statistics-of case))])
      (if (null? match-list)
	  0
	  (average match-list)))))


;;; success-rate takes a case and returns the percentage of successes;
;;; in usages of the case
;;;
(define success-rate
  (lambda (case)
    (let ([succ (num-success (statistics-of case))]
	  [total (num-uses (statistics-of case))])
      (if (zero? total)
	  0
	  (/ succ total)))))

;;; fail-rate takes a case and returns the percentage of failures
;;; in usages of the case
;;;
(define fail-rate
  (lambda (case)
    (let ([fail (num-fail (statistics-of case))]
	  [total (num-uses (statistics-of case))])
      (if (zero? total)
	  0
	  (/ fail total)))))


;;; *********************************************************************

;;; Another pseudo-ADT is the index.  There are certain operations
;;; that exist for indices in general, plus some for each kind of
;;; index.

;;; Indices vary in their contents based on the type of case they
;;; describe.  However, to make things simple, the *structure* of
;;; indices is uniform.  Each index is a essentially a frame, or
;;; an association list: it
;;; is a list containing sublists.  The first term in each sublist
;;; is a symbol describing the feature contained there-in.  The
;;; second term is the actual description of the feature.  Only these
;;; second terms are actually dependent on the case contents.

;;; There is a special value 'unspec which is used to indicate that
;;; that particular feature is unspecified.  Matching simply ignores
;;; any features where one value or the other is 'unspec

;;; One feature every index has is 'case-type, which is used to
;;; specify weighting values for combining different features.
;;; Cases with different case-types are automatically assigned
;;; the maximum score value

;;; build-index takes the index type, first of all, and then
;;; any number of feature pairs given by name and then value.  It
;;; checks to see if there are features that are not given by the
;;; casetype-specific data, or if some features of a particular type
;;; are missing.  It prints a warning, but builds the index anyway
;;; Missing features are filled in with unspec
;;;
(define build-index
  (lambda (case-type . feature-pairs)
    (if (not (case-type? case-type))
	(begin
	  (warn "Unknown case type")
	  (cons (list 'case-type case-type) feature-pairs))
	(if (unspec? case-type)
	    (cons (list 'case-type case-type) feature-pairs)
	    (let ([type-features (get-features case-type)]
		  [given-features (map descriptor feature-pairs)])
              (let ([unknowns (outliers given-features type-features)]
		    [missings (outliers type-features given-features)])
                (if (not (null? unknowns))
		    (warn "a provided feature is not defined for the case type"))
                (cons (list 'case-type case-type)
		  (append feature-pairs
		    (map (lambda (miss) (list miss 'unspec)) missings)))))))))
		  




(define descriptor car)
(define feature-value cadr)

(define Max-Score 100)
(define Min-Score 0)

;;; unspec? takes a feature value and returns #t if it is the
;;; special unspec value
;;;
(define unspec?
  (lambda (feat-value)
    (equal? feat-value 'unspec)))


;;; access-feature takes an index and a feature descriptor and returns
;;; the feature's *value* (2nd term) if it exists, and #f otherwise
;;;
(define access-feature
  (lambda (feat-name index)
    (let ([feature (assoc feat-name index)])
      (and feature
	  (feature-value feature)))))
	  


;;; match? takes two indices and returns a match value for them...
;;; a real number in the range of 0 to Max-Score.  A zero value means
;;; the indices are identical; a Max-Score value means they do not match
;;; at all
;;;
(define match?
  (lambda (index1 index2)
    (let ([type1 (access-feature 'case-type index1)]
	  [type2 (access-feature 'case-type index2)])
      (if (or (unspec? type1) (unspec? type2))
	  Min-Score
	  (if (not (equal? type1 type2))
	      Max-Score
	      (combine-scores (get-weights type)
		(map (lambda (name)
		       (match-feature? name index1 index2))
		  (get-features type))))))))




;;; match-feature? takes two indices and a feature descriptor and
;;; compares just those that feature of both indices, returning the 
;;; match value for that feature
;;;
(define match-feature?
  (lambda (feat-name index1 index2)
    (let ([feat1 (access-feature feat-name index1)]
	  [feat2 (access-feature feat-name index2)])
      (if (or (not feat1) (not feat2))     ;; if don't have feature
	  Max-Score
	  (if (or (unspec? feat1) (unspec? feat2))
	      Min-Score
	      ((get-compare-function feat-name) feat1 feat2))))))



;;; combine-scores takes a set of weights and a set of scores and
;;; produces a composite score by taking the sum of the product
;;; of weights and scores
;;;
(define combine-scores
  (lambda (weights scores)
    (apply + (map * weights scores))))


;;; --------------------------------------------------------------------

;;; Here are the case-type specific portions of the ADT

;;; This uses another data type, simply a global association list
;;; which contains weights and feature lists for each different kind
;;; of case
;;;
(define similarity-info
  (list (list 'index-case '(0) '(case-type))
	(list 'adapt-case '(0) '(case-type))
	(list 'plan-case
	      '(0 7.14 7.14 7.14 7.14 7.15 
		     7.14 7.14 7.14 7.14
		     7.14 7.14 7.14 7.14 7.14)
	      '(case-type sonar motors map location behaviors
			  task-loc task-urgency plan goal goal-urgency
			  pending-goals loc-conf plan-conf behav-conf))))
	
(define weight-list cadr)
(define feature-list caddr)

;;; case-type? takes a case type and determines if it is one
;;; of the defined case types
;;;
(define case-type?
  (lambda (case-type)
    (or (unspec? case-type)
	(assoc case-type similarity-info))))
	
	
;;; get-weights takes a case type and retrieves the list of 
;;; weights from a global knowledge base
;;;
(define get-weights
  (lambda (case-type)
    (weight-list (assoc case-type similarity-info))))


;;; get-features takes a case type and retrieves the list of
;;; features from the global similarity information
;;;
(define get-features
  (lambda (case-type)
    (feature-list (assoc case-type similarity-info))))



;;; There is also a global set of comparison functions, one for
;;; each different type of feature involved
;;; For right now, these are selected using the get-compare-function
;;; procedure
;;;
(define get-compare-function
  (lambda (feature-name)
    (case feature-name
      [(case-type) eq?]
      [else (lambda (f1 f2)
	      (pretty-print f1)
	      (newline)
	      (pretty-print f2)
	      (newline)
	      (display "Please enter an estimate for the difference (0-100): ")
	      (read))])))




;;; *********************************************************************
;;; Operations specific to behavior cases

(define behavior-case?
  (lambda (case)
    (eq? (car (contents-of case) 'behavior))))

(define behavior-list
  (lambda (case)
    (if (not (behavior-case? case))
	'()
	(cdr (contents-of case)))))


(define behav-descrip car)
(define behav-priority cadr)
(define behav-name caar)

;;; activate-behavior takes a behavior and calls the proper function to
;;; communicate with the robot, converting from the text descriptions
;;; of arguments to numeric at the same time
;;;
(define activate-behavior
  (lambda (behavior)
    (record-case (behav-descrip behavior)
      [stop () (beh-stop)]
      [moveForward (velocity) (beh-moveForward (convert-speed velocity))]
      [goStraight (speed heading)
	(beh-goStraight (convert-speed speed)
	  (convert-heading heading))]
      [avoidObstacle (distance speed)
	(beh-avoidObstacle (convert-distance distance)
	  (convert-speed speed))]
      [avoidCollision (distance turnRate)
	(beh-avoidCollision (convert-distance distance)
	  (convert-parameter turnRate))]
      [slowAvoid (distance speed)
	(beh-slowAvoid (convert-distance distance)
	  (convert-speed speed))]
      [goToPos (position speed accuracy)
	(beh-goToPos (convert-parameter position)
	  (convert-speed speed)
	  (convert-parameter accuracy))]
      [followHallway (corridor direction)
	(beh-followHallway (convert-parameter corridor)
	  (convert-heading direction))]
      [enterDoorway (door direction)
	(beh-enterDoorway (convert-parameter door)
	  (convert-heading direction))]
      [turnTo (pos)
	(beh-turnToPos (convert-parameter pos))]
      [turnTo (direction angle)
	(beh-turnToAngle (convert-heading direction)
	  (convert-parameter angle))]
      [localize () (beh-localize)]
      [else
	(error 'activate-behavior "Unknown behavior ~s" (behav-name behavior))]
      )))


;;; convert-parameter takes a parameter and, if it is one of the listed
;;; symbols, converts it to a numeric value.  If it is a number, it leaves
;;; it alone.
;;;
(define convert-parameter
  (lambda (param)
    (if (not (number? param))
	(warn "Unknown parameter value"))
    param))
	  


;;; convert-speed converts a textual desription of a speed into a
;;; number.  If given a number, it returns it
;;;
(define convert-speed
  (lambda (vel)
    (case vel
      [(very-slow) 25]
      [(slow) 50]
      [(mod-slow) 60]
      [(moderate) 75]
      [(mod-fast) 90]
      [(fast) 100]
      [(very-fast) 120]
      [else (if (number? vel)
		vel
		(begin
		  (warn "Unknown speed given!")
		  25))])))


;;; convert-distance, for now does nothing
;;;
(define convert-distance
  (lambda (dist)
    (if (not (number? dist))
	(begin
	  (warn "Unknown distance value")
	  20)
	dist)))


;;; convert-heading converts a few kinds of headings into
;;; degree values (???)... most importantly it translates
;;; curr-head into the current heading
;;;
(define convert-heading
  (lambda (head)
    (case head
      [(left) -90]
      [(right) 90]
      [(back) 180]
      [(curr-head) 0]
      [else (if (not (number? head))
		(begin
		  (warn "Unknown heading")
		  0)
		head)])))