(load "mm")
(in-package :mm)

;;=======================================================================
;; File: train-biases.lisp
;; First three "biased choosers" plus data generation functions
;;   for Mastermind course project, CMSC 471, Fall 2009
;; (c) Marie desJardins, November 2009
;; VERSION 0.0:  LAST UPDATED 11/9/09
;;   WARNING:  This code is woefully underdocumented and
;;      hastily implemented!



;; Biased learners only operate with 8 pegs and 8 colors.
;; Brittleness alert! - code looks general but may not work
;;   with a different number of pegs and/or colors.

(setf *code-length* 8)
(setf *colors* '(r o y g b i v w))


(export '(train-bias1-pos train-bias1-neg train-bias2-pos
			  train-bias2-neg check-train-bias2
			  train-bias3-pos train-bias3-neg
			  check-train-bias3 train-bias-flag
			  gen-instances print-to-file
			  generate-training-data))


;; TRAINING BIAS #1: Only generate codes that use the
;; latter half of the color list (in this case: colors 5 through 8)
;; Notice that to learn this bias, the only feature that is
;; necessary is a set of boolean features has-color(i), for
;; each color i.

(defun train-bias1-pos (&optional (colors *colors*) 
				  (code-length *code-length*))
  "Generate a positive training example for test bias #1 
   (only use colors 5 through 8)"
  (setf *code*
	(loop for i from 1 to code-length
	      collect (nth (+ (random (/ (length colors) 2))
			      (/ (length colors) 2))
			   colors))))

(defun train-bias1-neg (&optional (colors *colors*) 
				  (code-length *code-length*))
  "Generate a negative training example for test bias #1 
   (i.e., NEVER use colors 5 through 8)"
  (setf *code*
	(loop for i from 1 to code-length
	      collect (nth (random (/ (length colors) 2))
			   colors))))



;; TRAINING BIAS #2:  Use each color that appears in the
;; code *exactly twice*.  Notice that this bias implicitly
;; assumes that the code length is even, and that there are
;; at least half as many colors as the length of the code.
;; Notice also that the has_color(i) feature set of training
;; bias #1 will not be adequate to represent this bias.
;; Here you will want to use something like n_color(i), but
;; the learned decision tree will still be rather complex.

(defun train-bias2-pos (&optional (colors *colors*) 
				  (code-length *code-length*))
  (train-bias-flag colors code-length #'check-train-bias2 t))


(defun train-bias2-neg (&optional (colors *colors*) 
				  (code-length *code-length*))
  (train-bias-flag colors code-length #'check-train-bias2 nil))

(defun check-train-bias2 (code flag)
  (loop for c in code
	always 
	(let ((count (count-if #'(lambda (x) (eq c x))
			       code)))
	  (if flag (member count '(0 2))
	    (not (member count '(0 2)))))))


;; TRAINING BIAS #3: Use exactly 3 different colors.
;; What's a reasonable feature set for this bias?

(defun train-bias3-pos (&optional (colors *colors*) 
				  (code-length *code-length*))
  (train-bias-flag colors code-length #'check-train-bias3 t))


(defun train-bias3-neg (&optional (colors *colors*) 
				  (code-length *code-length*))
  (train-bias-flag colors code-length #'check-train-bias3 nil))

(defun check-train-bias3 (code flag &aux (colors nil))
  (loop for c in code
	do (setf colors (adjoin c colors)))
  (if flag (eq (length colors) 3)
    (not (eq (length colors) 3))))


;; TRAIN-BIAS-FLAG (colors code-length test flag) - depending
;; on whether FLAG is T or NIL, return a positive or negative
;; instance of the bias represented by the TEST function.

(defun train-bias-flag (colors code-length test flag)
  "Generate random codes until finding one that does (if flag=T)
   or does not (flag=NIL) match the conditions of the test function"
  (loop while t
	do (progn
	     (setf *code* (mm-gen-random colors code-length))
	     (if (funcall test *code* flag)
		 (return-from train-bias-flag *code*)))))


(defun gen-instances (n posgen neggen outfile
			&optional (colors *colors*)
			(code-length *code-length*))
  "Generate n positive instances and n negative instances, interleaved,
   using the provided generation functions."
  (with-open-file
   (*standard-output* outfile :direction :output
					 :if-exists :supersede)
   (loop for i from 1 to n
	 do 
	 (progn (print-to-file "+" (funcall posgen colors code-length))
		(print-to-file "-" (funcall neggen colors code-length))))))

(defun print-to-file (label code)
  (format t "~a " label)
  (loop for c in code do (format t "~s " c))
  (terpri))

(defun generate-training-data
  (&optional (n 100)
	     (posgens (list #'train-bias1-pos #'train-bias2-pos
			    #'train-bias3-pos))
	     (neggens (list #'train-bias1-neg #'train-bias2-neg
			    #'train-bias3-neg))
	     (outfiles (list "train-bias1.txt" "train-bias2.txt" 
			     "train-bias3.txt")))
  "Generate n (default 100) instances with the specified 
   positive-instance and negative-instance generation functions
   into the specified output files."
  (loop for pos in posgens
	for neg in neggens
	for outfile in outfiles
	do (gen-instances n pos neg outfile)))