(defstruct rule
  class ; "Yes/No"
  ands;list of ors
  score
  avgs
  utils
  (marked nil)
  support)

(defmethod print-object ((r rule) stream)
  (unless (equal (rule-class r) 'blandqxzy)
    (format t "Class: ~A~%" (rule-class r)))
  (format t  "Given that:~%")
  (dolist (this (rule-ands r))
    (format t "~T~T~A is in ~A ~%" (ors-for this) (ors-values this)))
  (format t "Score: ~F~%" (rule-score r))
  (format t "Support: ~D~%" (rule-support r))
  (if (null (rule-avgs r))
      (progn
	(format t "Pd: ~D~%" (* 100 (first (rule-utils r))))
	(format t "Pf: ~D~%" (* 100 (- 1 (second (rule-utils r)))))
	(format t "Prec: ~D~%" ( * 100 (third (rule-utils r)))))
     (format t "Averages: ~A~%~%" (rule-avgs r)))
  r)


(defstruct ors
  for;          weather
  values);    sunny/cloudy


(defstruct centroid
  center
  rows
  classcount)
      
(defun square (x)
  (* x x))

(defun combine (rlist) ;combine two rules
  (let ((r1 (first rlist)) (r2 (second rlist)))
    (let ((r3 (make-rule :class (rule-class r1) :score 0)))
      (dolist (r1ands (rule-ands r1))
        (push (copy-ors r1ands) (rule-ands r3)));deep copy to avoid errors
      (dolist (r2ands (rule-ands r2))
        (let ((no-match t))
          (dolist (r3ands (rule-ands r3))
            (progn
              (if (eq (ors-for r2ands) (ors-for r3ands))
                  (progn
                    (setf (ors-values r3ands) (sort (copy-list (remove-duplicates (concatenate 'list (ors-values r2ands) (ors-values r3ands)) :test #'equalp)) #'string-lessp)
                          no-match nil)))))
          (if no-match
              (push r2ands (rule-ands r3)))))
      (setf (rule-ands r3) (sort (copy-list (rule-ands r3)) #'string-lessp :key #'ors-for))
      r3)))

(defun to-rule (klass lst) ;take something from which in round0 and alters it to match rules structure
  (make-rule :class klass :ands (list (make-ors
                                       :for (second lst)
                                       :values (list (intern (string (third lst))))))
              :score (first lst)));;change to score function later)

(defun twos (lst)
  (let ((r1 (nth (randi (length lst)) lst)) 
	(r2 (nth (randi (length lst)) lst)))
    (if (eq r1 r2);change equals function
        (twos0 lst r1 19 361 r1)
	(let ((diff (diff-angle (rule-utils r1) (rule-utils r2))))
	      (if (> 15 diff)
		  (list r1 r2)
		  (twos0 lst r1 19 diff r2))))))

(defun twos0 (lst r1 x min-diff min-r)
  (let ((r2 (nth (randi (length lst)) lst)))
    (if (<= x 0)
	(list r1 r2)
	(if (eq r1 r2)
	    (twos0 lst r1 (- x 1) min-diff min-r)
	    (let ((diff (diff-angle (rule-utils r1) (rule-utils r2))))
	      (if (> 15 diff)
		  (list r1 r2)
		  (if (< diff min-diff)
		      (twos0 lst r1 (- x 1) diff r2)
		      (twos0 lst r1 (- x 1) min-diff r2))))))))


(defun explode (lst)
  (let ((out '()))
    (dolist (this lst)
      (dotimes (i (first this))
        (push (second this) out)))
    out))

(defun normalize (lst) ;lst or rules, returns ((num rule),(num rule)...)
  (let ((out '())(sum 0)) ;testing if this new style works
    (dolist (this lst)
      (if (< sum (rule-score this))
	  (setf sum (rule-score this))))
    (dolist (this lst)
      (push (list (floor (* 100 (/ (rule-score this) sum))) this) out))
    out))

(defun prune (lstin)
  (let ((out1 '()) (max 0)(cntr 0))
    (dolist (this lstin)
      (unless (= 0 (rule-support this))
	(push this out1)))
    (setf out1 (sort (copy-list out1) #'> :key #'rule-score))
    (reverse out1)))
      

(defun score (r tbl s)
  (let ((colnums '()) (countr 0) (rowlistin (therows tbl))(a 0)(b 0)(c 0)(d 0)(loc 0)(bugs 0))
    (dolist (this (thecols tbl))
      (push (list (col-name this) countr) colnums)
      (incf countr))
    (dolist (this rowlistin)
      (if (rule-match this r tbl)
	  (progn
	    (incf bugs 0)
	    (if (equal (rule-class r) (row-class this))
		(incf d)
		(incf c)))
	  (if (equal (rule-class r) (row-class this))
	      (incf b)
	      (incf a))))
    (setf (rule-support r) (support a b c d))
    (setf (rule-avgs r) (list (* 100 (pd a b c d)) (* 100 (- 1 (pf a b c d))) (* 100 (prec a b c d))))
    (sum (rule-utils r))))
      
(defun scoren (r tbl)
  (let ((colnums '()) (countr 0) (rowlistin (therows tbl)) (rowlistout '()) (goals '()))
    (dolist (this (thecols tbl))
      (push (list (col-name this) countr) colnums)
      (if (col-goalp this)
	  (push countr goals))
      (incf countr))
    (dolist (this rowlistin)
      (if (rule-match this r tbl)
	  (push this rowlistout)))
    (let ((goalsums '()) (goalavgs '()))
      (dotimes (x (length goals))
	(push 0 goalsums))
      (dolist (thisrow rowlistout)
	(let ((counter1 0))
	  (dolist (g goals)
	    (progn
	      (incf (nth counter1 goalsums) (nth g (row-cells thisrow)))
	      (incf counter1)))))
      (dolist (this goalsums)
	(if (= this 0)
	    (push 0 goalavgs)
	    (push (float (/ this (length rowlistout))) goalavgs)))
      (setf (rule-support r) (length rowlistout))
      (setf (rule-avgs r) goalavgs)
      (setf goals (reverse goals))
      (let ((weighted-avgs '()))
	(dolist (i goals)
	  (if (eq #\! (col-goalp (nth i (table-cols tbl))))
	      (if (= 0 (nth (position i goals) goalavgs))
		  (push 0 weighted-avgs)
		  (push (/ (- (nth (position i goals) goalavgs) (num-min (nth i (table-cols tbl))))
			   (- (num-max (nth i (table-cols tbl))) (num-min (nth i (table-cols tbl))))) weighted-avgs))
	      (if (= 0 (nth (position i goals) goalavgs))
		  (push 0 weighted-avgs)
		  (push (/ (- (num-max (nth i (table-cols tbl))) (nth (position i goals) goalavgs))
			   (- (num-max (nth i (table-cols tbl))) (num-min (nth i (table-cols tbl))))) weighted-avgs))))
	(setf (rule-utils r) weighted-avgs)
	(magnitude weighted-avgs)))))

(defun pd (a b c d)
  (/ (float d) (float (+ d b .0000000001))))

(defun pf (a b c d)
  (/ (float c) (float (+ a c .0000000001))))

(defun prec (a b c d)
  (/ (float d) (float (+ c d .0000000001))))

(defun support (a b c d)
  (/ (float (+ c d)) (float (+ a b c d))))

(defun accuracy (a b c d)
  (/ (float (+ a d)) (float (+ a b c d))))

(defun sum (l)
  (if (null l)
      0
      (+ (first l) (sum (rest l)))))

(defun entropy (tbl lst)
  (let ((sum 0) (l (length lst)))
    (dolist (class (table-klasses tbl) sum)
      (let ((n 0))
        (dolist (row lst)
          (if (eql (row-class row) (klass-name class))
              (incf n)))
        (unless (= n 0)
          (incf sum (* (/ n l) (- 0 (log (/ n l))))))))))

(defun getcolnum (col colnums)
  (unless (null colnums)
    (if (eq col (first (first colnums)))
	(second (first colnums))
	(getcolnum col (rest colnums)))))


(defun final-prune (lst)
  (dolist (this (copy-list lst))
    (unless (rule-marked this)
      (dolist (that (copy-list lst))
	(unless (or (equalp this that) (rule-marked that))
	  (if (pareto-dominate (rule-utils that) (rule-utils this))
	      (progn
		(setf (rule-marked this) t)))))))
  (remove-marks lst))

(defun pareto-dominate (lst1 lst2)
  (if (null lst1)
      t
      (if (< (first lst1) (first lst2))
	  nil
	  (pareto-dominate (rest lst1) (rest lst2)))))

(defun remove-marks (lst)
  (if (null lst)
      '()
      (if (rule-marked (first lst))
	  (remove-marks (rest lst))
	  (cons (first lst) (remove-marks (rest lst))))))