(defmacro country (state-color-binding)
  `(car ,state-color-binding))

(defmacro find-countries (state)
  `(real-find-countries ,state ,state))

(defmacro  colors-used (state)
  `(real-colors-used ,state nil))

(defmacro num-countries (map)
  `(real-num-countries ,map nil))

(defmacro most-popular (countries)
  `(real-most-popular nil ,countries))

;; "real-find-countries" recursively goes through "colored-c's" which is
;; originaly "state" and calls the aux function on the boarders of the
;; first country in "colored...."  The aux function will return an
;; uncolored countrty from the list of countries given it.  If it
;; returns nil "real-find..." will recurse with the cdr of "colored..."
;; Finally it will return a country that is boardering one of the
;; colored countries but is itself uncolored.

(defun real-find-countries (state colored-countries)
  (cond ((null colored-countries) nil)
	(t (let ((country (aux-find-countries state
				 (boarders (country (car colored-countries))))))
	     (cond ((null country)
		    (real-find-countries state (cdr colored-countries)))
		   (t (append country (real-find-countries state (cdr colored-countries)))))))))

;; "aux-find-countries" goes through "boarders" checking each element to
;; see if it has been colored according to "state."  It returns nil
;; or an uncolored country from "boarders."

(defun aux-find-countries (state boarders)
  (cond ((null boarders) nil)
	((chosen (car boarders) state) (aux-find-countries state (cdr boarders)))
	(t (cons (car boarders) (aux-find-countries state (cdr boarders))))))

;; "chosen" goes through "state" checking to see if "country" is one
;; of the countries in "state."  If so it returns t otherwise nil.

(defun chosen (country state)
  (cond ((or (null country) (null state)) nil)
	((eq country (country (car state))) t)
	(t (chosen country (cdr state)))))

;; "boarders" goes through *map* looking for "country" as the starting
;; country.  When it finds it it returns a list of the countries that
;; boarder it.

(defun boarders (country)
  (mapcan (function (lambda (country-group)
		      (cond ((eq country (car country-group))
			     (cdr country-group))
			    (t nil))))
	 *map*))

;; "color" creates a list of all country-color bindings for the given country
;; using *colors*.

(defun color (country)
 (mapcar (function (lambda (color)
		     (list country color)))
	 *colors*))

;; "bad-state" takes a state as its argument.  It calls "same-colored..."
;; which returns a list of lists of all the countries in "state" that have the
;; same color.  "boardering?" then looks at that list of lists and sees if,
;; for each list, any of these countries boarder each other.

(defun bad-state (state)
  (boardering? (same-colored-countries state)))

;; "boardering?" takes a list who's elements are lists of countries.
;; It cdr's down the list checking to see if any of the counties in a
;; list are boardering.  It does this by going through each element (country)
;; of each sublist, checking to see if that elements boardering coutries
;; are any of the other countries in that sublist.

(defun boardering? (same-countries-list)
  (let ((same-countries (car same-countries-list)))
	(cond ((null same-countries-list) nil)
	      ((mapcan (function (lambda (country)
				   (cond ((intersectp same-countries (boarders country)) (list t))
					 (t nil))))
		       same-countries) t)
	      (t (boardering? (cdr same-countries-list))))))

;; "thing1" and "thing2" can be atoms or lists.  If they are both atoms
;; "intersectp" succeeds if they are eq.  If one is an atom and
;; is a memq of the other it succeeds.  If they are both lists and
;; an element of one is a memq then it succeeds.

(defun intersectp (thing1 thing2)
  (cond ((and (atom thing2) (atom thing1)) (eq thing1 thing2))
	((atom thing2) (memq thing2 thing1))
	((atom thing1) (memq thing1 thing2))
	(t (mapcan (function (lambda (symbol)
			       (cond ((memq symbol thing2) (list t))
				     (t nil))))
		   thing1))))

;; "same-colored-countries" takes a state as its input.  It takes the
;; first country-color binding (c-c) of state and looks for all other
;; countries of state with the same color (using find-same); these
;; are also in c-c form for easy removal from "state," which is done
;; after the list of these countries is bound to "same-c-countries."
;; "state" now has everything of that color removed.  A list is made
;; who's first element is the list of countries of that color, and who's
;; cdr is "same-colored-countries" of the modified "state."

(defun same-colored-countries (state)
  (cond ((null state) nil)
	(t (let ((same-c-countries (find-same (cadar state) state)))
	     (cond ((greaterp (length same-c-countries) 1)  ;always at
		                                            ;least one
		    (mapc (function (lambda (c-c)           
				      (setq state (remove c-c state))))
			  same-c-countries)

		    (cons (mapcar (function (lambda (c-c)    
					      (country c-c)))
				  same-c-countries)
			  (same-colored-countries state)))

		   (t (same-colored-countries (cdr state))))))))

;; "find-same" makes a list of all c-c's in "state" who's color is "color."

(defun find-same (color state)
  (cond ((null state) nil)
	((eq color (cadar state)) (cons (car state)
					(find-same color (cdr state))))
	(t (find-same color (cdr state)))))

;; "real-colors-used" goes through "state" looking in the color field.
;; It keeps track of colors in "used."  If the color in question is
;; in "used" it recurses on the cdr of "state," otherwise it recurses
;; with a new "used" that contains that color.

(defun real-colors-used (state used)
  (let ((color (cadar state)))
    (cond ((null state) used)
	  ((memq color used) (real-colors-used (cdr state) used))
	  (t (real-colors-used (cdr state) (cons color used))))))

;; "real-num-countries" returns the number of different countries mentioned
;; in the map.  It calls "aux-num-countries" on each section of the map
;; which returns a list of countries mentioned so far "used." 

(defun real-num-countries (map used)
  (cond ((null map) (length used))
	(t (real-num-countries (cdr map) (aux-num-countries (car map) used)))))
	 
;; "aux-num-countries" is given a section of a map and a list of countries
;; already accounted for.  If in the sub-map there are countries that
;; are not in the "used" list, it will add them to it.  It returns the
;; "used" list.

(defun aux-num-countries (sub-map used)
  (let ((country (car sub-map)))
    (cond ((null sub-map) used)
	  ((memq country used) (aux-num-countries (cdr sub-map) used))
	  (t (aux-num-countries (cdr sub-map) (cons country used))))))

;; "real-most-popular" keeps a list "counted" of occurances of countries
;; in "countries."  After it completes this list it calls "aux-post-popular"
;; which returns the country that occured most.

(defun real-most-popular (counted countries)
  (cond ((null countries) (country (aux-most-popular counted (list nil 0))))
	(t (real-most-popular (cons (list (car countries)
					  (count (car countries) countries 0))
				    counted)
			      (cdr countries)))))

;; "count" is given a country, a list of countries and a number (0 unless
;; called within itself).  It recursively goes through "countries" adding
;; 1 to "c" on the next recursion if the car of "countries" is the country.
;; When it's done it returns "c."

(defun count (country countries c)
  (cond ((null countries) c)
	((eq country (car countries)) (count country (cdr countries) (add1 c)))
	(t (count country (cdr countries) c))))

;;  "aux-most-popular" is given a list of country occurrence bindings and
;; a list which is the most occuring country so far and it's number (starts
;; out as '(nil 0).  It goes down the "list," when it finds a country that
;; has a greater occurence than the "best" country it makes that the "best."
;; When it is done it returns the "best."

(defun aux-most-popular (list best)
  (cond ((null list) best)
	((greaterp (cadar list) (cadr best)) (aux-most-popular (cdr list) (car list)))
	(t (aux-most-popular (cdr list) best))))