(defparameter *every* 'allqzjx) (defun which2 (&optional (tbl (thetable)) (report t)) (train tbl) (learn tbl report) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 report) (dolist (target (theklasses tbl)) (learn1 target tbl report) )) (defun learn1 (target tbl report) (let ((which (round0 target tbl))) (rounds target which tbl report))) (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)) ; 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 rounds (class which tbl report) (declare (ignore tbl)) (format report ";;; ~a~%" (klass-name class)) (dolist (one which) (format report " ~a~%" one))) (defun !learn1 () (reset-seed) (data "../data/discrete-lisp/weather.lisp") (with-output-to-string (s) (which2 (thetable) s))) (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)"))