;;; FILE: map-color.ss
;;;
;;; kyle wagner
;;; q351/b351 - AI
;;; 
;;; Homework 1
;;;
;;; Map-coloring problem-specific search routines
;;;
;;;   Use with Mike Gasser's search.ss
;;; 
;;;
;;; Call like this:
;;;    (search depth-first-merge
;;;	       color-init-config
;;;	       color-extend color-goal? color-estimate color-print-state)))
;;;
;;; Or, just call do-search:
;;;    (do-search)
;;;



;;;
;;; Problem states look like this:
;;;   (distance-so-far distance-left configuration)
;;;
;;; (state-distance state) => distance-so-far
;;; (state-estimate state) => distance-left
;;; (state-config state) => configuration
;;;
;;; (config->state config estimate) => new *initial* state
;;;


;;;
;;; configs look like this:
;;; 
;;; ((a . blue) (b . red) (c . none) (d . none))
;;; All countries in the map must contain a color, even if that color is 'none.
;;; The above config works only for a map with countries a,b,c,d.
;;;
(define country-name
  (lambda (country)
    (car country)))
(define country-color
  (lambda (country)
    (cdr country)))
(define nocolor?
  (lambda (color)
    (equal? color 'none)))






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; color-extend
;;;
;;; INPUT: state - a problem state
;;; OUTPUT: list of states legally reached from state
;;; DESCRIP: States with no uncolored countries cannot be extended.d
;;;          If a state has an uncolored country, the first one encountered
;;;          is colored in all possible colors.
;;;
(define color-extend
  (lambda (state)
    (let* ([graph '([a (b e f)]
		    [b (a e f)]
		    [c (b d e f)]
		    [d (c e f)]
		    [e (a b c d f)]
		    [f (a b c d e)])]
	   [colors '(blue red yellow green)]
	   [num-colors (length colors)])
      (let* ([config (state-config state)]
	     [old-dist (state-distance state)]

	     ;; First, find a country that isn't colored yet
	     [old-country (find-uncolored config)]
	     [old-country+color (assoc old-country config)]

	     ;; Make list with that country having each color
	     [new-countries (map cons
				 (make-list num-colors old-country)
				 colors)]

	     ;; Make new configs, with new country/color in place of
	     ;;   uncolored country -- all possible configs are made
	     [num-new-countries (length new-countries)]
	     [new-configs (map subst
			       new-countries
			       (make-list num-new-countries old-country+color)
			       (make-list num-new-countries config))]

	     ;; Remove illegal configs
	     [num-new-configs (length new-configs)]
	     [new-configs2 (map legal-country-color?
				new-countries
				new-configs)]
	     [new-configs3 (filter not-false? new-configs2)]

	     ;; Make new states from remaining configs
	     [num-states (length new-configs3)]
	     [new-states (map make-state
			      (make-list num-states old-dist)
			      new-configs3)])
	(if (null? old-country)
	    '()
	    new-states)))))


;;;
;;; find-uncolored
;;;
;;; Finds the first uncolored country in the configuration - returns () 
;;;   if all states are colored
;;;
(define find-uncolored
  (lambda (config)
    (cond
     [(null? config) '()]
     [(nocolor? (country-color (car config))) (country-name (car config))]
     [else (find-uncolored (cdr config))])))




;;;
;;; legal-country-color?
;;;
;;; Takes a single country/color pair and sees if any adjoining countries
;;;   have the same color.  Also, looks for states that are uncolored.
;;;   If any of these are found, return #f.  Else, return config.
;;;
(define legal-country-color?
  (lambda (country config)
    (let* ([graph '([a (b e f)]
		    [b (a e f)]
		    [c (b d e f)]
		    [d (c e f)]
		    [e (a b c d f)]
		    [f (a b c d e)])]
	   [color (country-color country)]
	   [name (country-name country)]
	   [neighbors (cadr (assoc name graph))]
	   [num-neighbors (length neighbors)]
	   
	   ;;
	   ;; get-color
	   ;;
	   ;; Take a country-color pair and extract color; if #f, 
	   ;;
	   [get-color (lambda (country config)
			(let ([country (assoc country config)])
			  (if country
			      (country-color country)
			      #f)))]

	   [neighbor-colors (map get-color
				 neighbors
				 (make-list num-neighbors config))]
	   [neighbor-colors2 (filter not-false? neighbor-colors)])
      (if (and (member color neighbor-colors2)
	       (not (nocolor? color)))
	  #f
	  config))))



;;;
;;; filter
;;;
;;; INPUT: ls, a list
;;;        pred?, a predicate
;;; OUTPUT: ls, with all items removed for which pred? is false
;;;
;;;
(define filter
  (lambda (pred? ls)
    (cond
     [(null? ls) '()]
     [(pred? (car ls)) (cons (car ls) (filter pred? (cdr ls)))]
     [else
      (filter pred? (cdr ls))])))



;;;
;;; not-false?
;;;
(define not-false?
  (lambda (x)
    (not (eq? x #f))))



;;;
;;; make-state
;;;
;;; Incr. old-dist by one,  tack config on. (est. is added later by merge - 
;;;    just put a junk value there for now)
;;;
(define make-state
  (lambda (old-dist config)
    (list (add1 old-dist) 0 config)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; color-goal? 
;;;
;;; INPUT: state - a problem state
;;; OUTPUT: #t if goal, #f if not
;;; DESCRIP: assuming that all maps are legally-colored maps, goal maps
;;;          are those where all countries have colors (all colors must be
;;;          legal).  Return #t if all countries have a color, #f otherwise.
;;;
(define color-goal?
  (lambda (state)
    (let* ([config (state-config state)]
	   
	   ;; Remove all colors from config list
	   [colors (map cdr config)])
      
      ;; Check for color 'none
      (if (member 'none colors)
	  #f
	  #t))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; color-estimate
;;;
;;; INPUT: state - a problem state
;;; OUTPUT: number which is est of dist from goal
;;;
(define color-estimate
  (lambda (state)
    0))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; color-print-state
;;;
;;; INPUT: state - a problem state
;;; DESCRIP: used to show the state in a nice format
;;;
(define color-print-state
  (lambda (state)
    (let ([config (state-config state)])
      (pretty-print config))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Testing only...
;;; 


(define do-search
  (lambda ()
    (search depth-first-merge
	    color-init-config
	    color-extend color-goal? color-estimate color-print-state)))

(define color-init-config
  '((a . none) (b . none) (c . none) (d . none) (e . none) (f . none)))