(defparameter *every* 'allqzjx)


(defun which2 (&optional (tbl (thetable)) (s 2))
  (train tbl)
  (learn tbl s)
  )

(defun which2n (&optional (tbl (thetable)))
  (learnn tbl))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun train (tbl)
   (dolist (row (therows tbl))
     (how-manys (thecols tbl)    ; get the column headers
		(row-cells row)  ; get the cells
		(row-class row)  ; get the class of this row
		)))


(defun how-manys (cols cells class)
  (labels ((worker (col cell)
	     (how-many class
		       (col-name col)
		       cell
		       (sym-counts col))))
    (mapcar #'worker cols cells))) ; run down cols and cells in parallel

(defun how-many (class what cell hash)
  (when (knownp cell) ; skip any cell labelled "?"
    (inch `(,class   ,what ,cell) hash)
    (inch `(,*every* ,what ,cell) hash)))
    
(defun inch (key hash)
  "increment a hash bucket from zero"
  (incf (gethash key hash 0)))

(defun !how-manys1 ()
  (reset-seed)
  (data "../data/discrete-lisp/weather.lisp")
  (train (thetable))
  (with-output-to-string (s)
    (dolist (col (thecols))
      (showh (sym-counts col) :stream s))))

(deftest !how-manys ()
  (test (!how-manys1)
        "(ALLQZJX FORECAST OVERCAST) = 4
	(ALLQZJX FORECAST RAINY) = 5
	(ALLQZJX FORECAST SUNNY) = 5
	(NO FORECAST RAINY) = 2
	(NO FORECAST SUNNY) = 3
	(YES FORECAST OVERCAST) = 4
	(YES FORECAST RAINY) = 3
	(YES FORECAST SUNNY) = 2
	(ALLQZJX TEMP COOL) = 4
	(ALLQZJX TEMP HOT) = 4
	(ALLQZJX TEMP MILD) = 6
	(NO TEMP COOL) = 1
	(NO TEMP HOT) = 2
	(NO TEMP MILD) = 2
	(YES TEMP COOL) = 3
	(YES TEMP HOT) = 2
	(YES TEMP MILD) = 4
	(ALLQZJX HUMIDTY HIGH) = 7
	(ALLQZJX HUMIDTY NORMAL) = 7
	(NO HUMIDTY HIGH) = 4
	(NO HUMIDTY NORMAL) = 1
	(YES HUMIDTY HIGH) = 3
	(YES HUMIDTY NORMAL) = 6
	(ALLQZJX WINDY FALSE) = 8
	(ALLQZJX WINDY TRUE) = 6
	(NO WINDY FALSE) = 2
	(NO WINDY TRUE) = 3
	(YES WINDY FALSE) = 6
	(YES WINDY TRUE) = 3
	(ALLQZJX !PLAY NO) = 5
	(ALLQZJX !PLAY YES) = 9
	(NO !PLAY NO) = 5
	(YES !PLAY YES) = 9"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun learn (tbl s)
  (let ((out '()))
    (dolist (target (theklasses tbl) out)
      (push (learn1  target tbl s) out))))

(defun learnn (tbl)
  (roundsn (round0n tbl) tbl))

(defun learn1 (target tbl s)
  (let ((which (round0 target tbl)))
    (rounds target which tbl s)))

(defun round0 (target tbl)
  (let ((out '()))
    (dolist (col (thecols tbl))
      (unless (col-goalp col)
	(dokeys (key (sym-counts col))
	  (push (list 0 (second key) (third key)) out))))
    (remove-duplicates out :test #'equal)))

(defun round0n (tbl)
  (let ((out '()))
    (dolist (row (therows tbl))
      (let ((countr 0))
	(dolist (this (row-cells row))
	  (unless (col-goalp (nth countr (table-cols tbl)))
	    (push (list 0 (col-name (nth countr (table-cols tbl))) this) out))
	    (incf countr))))
    (remove-duplicates out :test #'equal)))

(defun rule-match (row rule table)
  (let ((colnums '()) (countr 0) (out t))
    (dolist (this (table-cols table))
      (push (list (col-name this) countr) colnums)
      (incf countr))
    (dolist (thisors (rule-ands rule) out)
      (unless (member (nth (getcolnum (ors-for thisors) colnums) (row-cells row)) (ors-values thisors))
	(setf out nil)))))

;(defun round0 (target tbl)
;  (let (out
;	(n (length (therows tbl))))
;    (labels
;	((worker (hash want m what class value &aux s)
;	   (if (eql class want)
;	     (if (setf s (b^2/b+r hash want m n what value))
;		 (push (list (round s 0.01)
;			     what value)
;		       out)))))
;     (dolist (col (thecols tbl))         ; for every column
;	(unless (col-goalp col)           ; that's not the goal
;	  (dokeys (key  (sym-counts col))
;	    (print key)			; for everything counted in that col
;	    (worker (sym-counts col)      ; get the hash table counds
;		    (klass-name target)   ; what class are we targetting?
;		    (klass-n target)      ; how many of them do we have?
;		    (col-name col)        ; what is the col name?
;		    (first key)           ; what class is being counted?
;		    (third key)           ; what value we looking at?
;		    ))))
;     (sort out #'> :key #'first))))

(defun b^2/b+r  (hash want m n what value) 
  (let* ((every (gethash `(,*every* ,what ,value) hash 0))
	 (b0    (gethash `(,want    ,what, value) hash 0))
	 (r0    (- every b0))
	 (b     (/ b0 m))        ; ratio in target
	 (r     (/ r0 (- n m)))) ; ration everwhere else
    (if (> b r)                  ; in more better than rester
	(/ (* b b)               ; b^2/(b+r)
	   (+ b r (randf 0.0000001))))))

(defun roundsn (which tbl)
  (let ((lives 5) (rules '()) (round 1) (max 0) (zero-score t))
    (dolist (this which)
      (let ((that (to-rule 'blandqxzy this)))
	(setf (rule-score that) (scoren that tbl))
	(unless (> 16 (rule-support that))
	  (push that rules))))
    (loop while (> lives 0) do
	 (let ((this nil) (found nil))
	   (dotimes (number 20)
	     (setf this (combine (twos (explode (normalize rules)))))
	     (setf (rule-score this) (scoren this tbl))
	     (dolist (that rules)
	       (if (equalp this that)
		   (setf found t)))
	     (unless (or found (> 5 (rule-support this)))
	       (push this rules))))
	 (setf rules (prune rules))
	 (if (> (rule-score (first rules)) max)
	     (setf max (rule-score (first rules))
		   lives 6))
	 (incf round)
	 (decf lives))
    (final-prune rules)))

(defun rounds (class which tbl s)
  (let ((lives 5) (rules '()) (round 1) (max 0) (zero-score t))
    (dolist (this which)
      (push (to-rule (klass-name class) this) rules))
    (dolist (r rules)
      (setf (rule-score r) (score r tbl s))
      (if (> (rule-score r) 0)
          (setf zero-score nil)))
    (if zero-score
        rules
        (progn
          (loop while (> lives 0) do
               (let ((this nil) (found nil))
                 (dotimes (number 20)
                   (setf this (combine (twos (explode (normalize rules)))))
                   (setf (rule-score this) (score this tbl s))
                   (dolist (that rules)
                     (if (equalp this that)
                         (setf found t)))
                   (unless (or found (= 0 (rule-support this)))
                     (push this rules)))
                 (setf rules (prune rules))
                 (if (> (rule-score (first rules)) max)
                     (setf max (rule-score (first rules))
                           lives 6))
                 (incf round)
                 (decf lives)))
	  (final-prune rules)))))

(defun !table1 ()
  (data "../data/discrete-lisp/iris.lisp")
  (print (thetable)))

(defun !table2 ()
  (data "../data/numeric/servo.lisp")
  (print (discretizetbln (thetable) 3)))

(defun !table3 ()
  (data "../data/LispData/ant/01-ant-a.lisp")
  (print (discretizetblcode (thetable) 10)))

(defun !learn1 ()
  (reset-seed)
  (data "../data/LispData/ant/01-ant-a.lisp")
  (which2 (discretizetblcode (thetable) 10)))

(defun !learn2 ()
  (reset-seed)
  (data "../data/proj3/soybean.lisp")
  (which2 (discretizetbl (thetable))))

(defun !learn3 ()
  (data "../data/proj3/iris.lisp")
  (which2 (discretizetbl (thetable))))

(defun !learn4 ()
  (reset-seed)
  (data "../data/numeric-lisp/weather.lisp")
  (which2n (discretizetbln (thetable))))
 
(defun !learn5 ()
  (reset-seed)
  (data "../data/xerces/xerces12.lisp")
  (which2n (discretizetbln (thetable))))

(defun !learnandrew ()
  (reset-seed)
  (data "../data/china.lisp")
  (which2n (discretizetbln (thetable))))

(defun !learnlqn ()
  (reset-seed)
  (data "lqn/lqn.lisp")
  (print-output (thetable))
  (which2n (discretizetbln (thetable))))

(defun !averageslqn ()
  (reset-seed)
  (data "lqn/lqn.lisp")
  (table-averages (thetable)))

(defun !printtablelqn ()
  (data "lqn/lqn.lisp")
  (print (thetable)))

(defun table-averages (tbl)
  (let ((out '()) (l (length (row-cells (first (table-rows tbl))))))
    (dolist (this (table-rows tbl) out)
      (push (list (nth (- l 1) (row-cells this)) (nth (- l 2) (row-cells this))) out))))

(defun print-output (tbl)
  (let ((out '()) (l (length (row-cells (first (table-rows tbl))))))
    (dolist (this (table-rows tbl) out)
      (print (list (nth (- l 1) (row-cells this)) (nth (- l 2) (row-cells this)) 2 )))))
      

                                        ;(deftest !learn ()
;  (test (!learn1)
;	";;; NO
;          (56 HUMIDTY HIGH)
;          (44 FORECAST SUNNY)
;          (39 WINDY TRUE)
;          (26 TEMP HOT)
;          (22 FORECAST RAINY)
        ;;; YES
;          (51 HUMIDTY NORMAL)
;          (44 FORECAST OVERCAST)
;          (42 WINDY FALSE)
;          (23 TEMP MILD)
;          (21 TEMP COOL)"))