gistfile1.el

(defun xindex-tot (tbl)
  "Consolidates xindex hash tables into a single table"
  (let ((ht (make-hash-table :test #'equal)))
    (dolist (attr (table-columns (xindex tbl)))
      (if (numeric-p attr)
	  (dohash (key value (numeric-f attr))
	    (setf key (push (numeric-name attr) key))
	    (setf (gethash key ht) value))
	  (dohash (key value (discrete-f attr))
	    (setf key (reverse key))
	    (setf key (push (discrete-name attr) key))
	    (setf (gethash key ht) value))))
    ht))

(defun xindex-tot-2 (tbl)
  (let (seen)
    (dolist (attr (table-columns (xindex tbl)))
      (if (numeric-p attr)
	  (push (numeric-f attr) seen)
	  (push (discrete-f attr) seen)))
    (reverse seen)))

(deftest test-xindex-tot ()
  (dohash (key value (xindex-tot (weather-numerics)))
    (format t "~A ~A~%" key value)))

(defun likelyhood (this seen)
  (let ((prob 13))
    (dolist (el this)
      (let ((s 0)(d 0))
	(if (not (numberp el))
	    (dohash (key value (nth (position el this) seen))
	      (if (member el key)
		  (progn (setf s (+ s value))
			 (setf d (+ d value)))
		  (setf d (+ d value))))
	    (dohash (key value (nth (position el this) seen))
	      (if (and (<= el (normal-max value))
		       (>= el (normal-min value)))
		  (progn (setf d 1) (setf s 1))
		  (if (not (= 1 s))
		      (setf d 1)))))
	(setf prob (* prob (/ s d)))))
    prob))

; (likelyhood '(RAINY 71 90 TRUE NO) (xindex-tot-2 (weather-numerics)))

(defun anomaly-detector (train test)
  (let ((seen (xindex-tot-2 train))
	(test-egs (mapcar #'eg-features (egs test)))
	(train-egs (mapcar #'eg-features (egs train)))
	(test-tmp)
	(train-tmp)
	(minmax))
    (dolist (eg train-egs)
      (push (list eg (likelyhood eg seen)) train-tmp))
    (setf minmax (find-min-max 
		  (mapcar #'first (mapcar #'cdr train-tmp))))

    (let ((min (first minmax))
	  (max (second minmax)))
      (format t "MIN: ~A MAX: ~A~%" min max)
      
      (dolist (eg test-egs)
	(push (list eg (likelyhood eg seen)) test-tmp))

      (print "********* TRAIN SET *********")
      (print train-tmp)
      (print "********* TEST SET *********")
      (print test-tmp))))

(defun normalize (tbl)
  "Computes (value - min)/(max - min) for all numeric cols"
  (let ((trans (super-transform tbl)))
    (dolist (column trans)
      (if (numericp (first column))
	  (progn 
	    (let* ((min-max (find-min-max (rest column)))
		   (min (first min-max))
		   (max (second min-max)))
	      (setf (rest column)
		    (mapcar #'(lambda (value) 
				(/ (- value min) (- max min))) (rest column))))
	    )))
    (setf trans (transpose trans))
    (data
     :name (table-name tbl)
     :columns (car trans)
     :klass (table-class tbl)
     :egs (cdr trans)
     )))

(deftest test-normal ()
  "Return a normalized table"
  (normalize (weather-numerics)))

(defun apply-minmax (tbl)
  (let ((trans (super-transform tbl)) (new-cols (table-columns tbl)))
    (dolist (attr new-cols)
      (if (numeric-p attr)
	  (setf (numeric-mm attr)
		(find-min-max 
		 (cdr (nth (position attr new-cols) trans))))))
    (setf (table-columns tbl) new-cols)
    tbl))


(defun normalize-mod (tbl)
  "Computes (value - min)/(max - min) for all numbers but rounds to nearest tenth"
  (let ((trans (super-transform tbl)))
    (dolist (column trans)
      (if (numericp (first column))
	  (progn 
	    (let* ((min-max (find-min-max (rest column)))
		   (min (first min-max))
		   (max (second min-max)))
	      (setf (rest column)
		    (mapcar #'(lambda (value) 
				(/ (fround (/ (- value min) (- max min)) .1) 10)) (rest column))))
	    )))
    (setf trans (transpose trans))
    (let ((new-table
	   (data
	    :name (table-name tbl)
	    :columns (car trans)
	    :klass (table-class tbl)
	    :egs (cdr trans)
	    )))
      (setf (table-columns new-table) (table-columns tbl))
      new-table)))

(defun remove-num-headers (tbl)
  (data
   :name (table-name tbl)
   :columns (mapcar #'(lambda (x)
			(intern
			 (replace-all
			  (string x) "$" "")))
			(columns-header (table-columns tbl)))
   :klass (table-class tbl)
   :egs (mapcar #'eg-features (egs tbl))))

; Run as: (normalize-mod (apply-minmax (weather-numerics)))