(defun discretizetbln (tbl &optional (numbins 10)) (minmax tbl) (let ((newtbl (make-table :name (table-name tbl) :klasses (table-klasses tbl)))) (dolist (thisrow (table-rows tbl)) (let ((thisrow2 (copy-row thisrow))) (push thisrow2 (table-rows newtbl)))) (dolist (this (table-cols tbl)) (if (col-goalp this) (setf (table-cols newtbl) (append (table-cols newtbl) (list this))) (if (typep this 'num) (let ((pos (position this (table-cols tbl))) (dlist (discretizer this numbins))) (dolist (r (table-rows newtbl)) (setf (nth pos (row-cells r)) (num-to-descr (nth pos (row-cells r)) dlist))) (setf (table-cols newtbl) (append (table-cols newtbl) (list (make-sym :name (col-name this) :goalp (col-goalp this)))))) (let ((pos (position this (table-cols tbl)))) (dolist (r (table-rows newtbl)) (if (numberp (nth pos (row-cells r))) (setf (nth pos (row-cells r)) (intern (write-to-string (nth pos (row-cells r))))))) (setf (table-cols newtbl) (append (table-cols newtbl) (list this))))))) newtbl)) (defun discretizetblcode (tbl &optional (numbins 10)) (minmax tbl) (let ((newtbl (make-table :name (table-name tbl) :klasses (list (make-klass :name 'zero :n 0) (make-klass :name 'one :n 0) (make-klass :name 'more-than-one :n 0))))) (dolist (thisrow (table-rows tbl)) (let ((thisrow2 (copy-row thisrow))) (push thisrow2 (table-rows newtbl)))) (dolist (this (table-cols tbl)) (if (col-goalp this) (let ((pos (position this (table-cols tbl))) (dlist (discretizer this numbins))) (dolist (r (table-rows newtbl)) (print r) (setf (row-cells r) (append (row-cells r) (list (cond ((eq 0 (nth pos (row-cells r))) 'zero) ((eq 1 (nth pos (row-cells r))) 'one) (t 'more-than-one))))) (print r) (dolist (k (table-klasses newtbl)) (if (equal (row-class r) (klass-name k)) (progn (incf (klass-n k) 1))))) (setf (table-cols newtbl) (append (table-cols newtbl) (list (make-sym :name (col-name this) :goalp (col-goalp this)))))) (if (and (typep this 'num) (not (= (col-name this) 'loc))) (let ((pos (position this (table-cols tbl))) (dlist (discretizer this numbins))) (dolist (r (table-rows newtbl)) (setf (nth pos (row-cells r)) (num-to-descr (nth pos (row-cells r)) dlist))) (setf (table-cols newtbl) (append (table-cols newtbl) (list (make-sym :name (col-name this) :goalp (col-goalp this)))))) (let ((pos (position this (table-cols tbl)))) (dolist (r (table-rows newtbl)) (if (numberp (nth pos (row-cells r))) (setf (nth pos (row-cells r)) (intern (write-to-string (nth pos (row-cells r))))))) (setf (table-cols newtbl) (append (table-cols newtbl) (list this))))))) newtbl)) (defun discretizetbl (tbl &optional (numbins 10)) (minmax tbl) (let ((newtbl (make-table :name (table-name tbl) :klasses (table-klasses tbl)))) (dolist (thisrow (table-rows tbl)) (let ((thisrow2 (copy-row thisrow))) (push thisrow2 (table-rows newtbl)))) (dolist (this (table-cols tbl)) (if (typep this 'num) (let ((pos (position this (table-cols tbl))) (dlist (discretizer this numbins))) (dolist (r (table-rows newtbl)) (setf (nth pos (row-cells r)) (num-to-descr (nth pos (row-cells r)) dlist))) (setf (table-cols newtbl) (append (table-cols newtbl) (list (make-sym :name (col-name this) :goalp (col-goalp this)))))) (let ((pos (position this (table-cols tbl)))) (dolist (r (table-rows newtbl)) (if (numberp (nth pos (row-cells r))) (setf (nth pos (row-cells r)) (intern (write-to-string (nth pos (row-cells r))))))) (setf (table-cols newtbl) (append (table-cols newtbl) (list this)))))) newtbl)) (defun minmax (tbl) (dolist (this (table-cols tbl)) (if (typep this 'num) (let ((pos (position this (table-cols tbl)))) (dolist (thisrow (table-rows tbl)) (if (> (nth pos (row-cells thisrow)) (num-max this)) (progn (setf (num-max this) (nth pos (row-cells thisrow))))) (if (< (nth pos (row-cells thisrow)) (num-min this)) (progn (setf (num-min this) (nth pos (row-cells thisrow)))))))))) (defun num-to-descr (x dlist &optional (n 0)) ;dlist is output from discretzer function (let ((nthn (nth n dlist))) (if (<= x nthn) (cond ((= n (- (length dlist) 1)) (intern (concatenate 'string "more-than-" (write-to-string (nth (- n 1) dlist))))) ((> n 0) (intern (concatenate 'string "less-than-" (write-to-string nthn) "-and-more-than-" (write-to-string (nth (- n 1) dlist))))) (t (intern (concatenate 'string "less-than-" (write-to-string nthn))))) (num-to-descr x dlist (+ n 1))))) (deftest !tester3will1 () (data "../data/discrete-lisp/weather.lisp") (test (table-cols (thetable)) (table-cols (discretizetbl (thetable))))) (deftest !tester3will2 () (data "../data/numeric-lisp/weather.lisp") (test (discretizetbl (thetable)) "#S(TABLE :NAME $WEATHER :ROWS (#S(ROW :CELLS (SUNNY less-than-76.6-and-more-than-74.5 less-than-71.2-and-more-than-68.1 TRUE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.4869120755548817d0) #S(ROW :CELLS (OVERCAST less-than-66.1 less-than-68.1 TRUE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.4617063527177772d0) #S(ROW :CELLS (RAINY less-than-76.6-and-more-than-74.5 less-than-80.5-and-more-than-77.4 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.4508161515756934d0) #S(ROW :CELLS (OVERCAST less-than-82.9-and-more-than-80.8 less-than-77.4-and-more-than-74.3 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.266554799861022d0) #S(ROW :CELLS (RAINY less-than-70.3-and-more-than-68.2 less-than-96.0-and-more-than-92.9 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.2627522398599997d0) #S(ROW :CELLS (RAINY less-than-68.2-and-more-than-66.1 less-than-80.5-and-more-than-77.4 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.1968093818857513d0) #S(ROW :CELLS (SUNNY less-than-70.3-and-more-than-68.2 less-than-71.2-and-more-than-68.1 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.1004932973769972d0) #S(ROW :CELLS (OVERCAST less-than-85.0-and-more-than-82.9 less-than-86.7-and-more-than-83.6 FALSE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.0607153431365122d0) #S(ROW :CELLS (OVERCAST less-than-72.4-and-more-than-70.3 less-than-92.9-and-more-than-89.8 TRUE YES) :CLASS YES :UTILITY 0 :SORTKEY 1.0410945777495766d0) #S(ROW :CELLS (SUNNY less-than-85.0-and-more-than-82.9 less-than-86.7-and-more-than-83.6 FALSE NO) :CLASS NO :UTILITY 0 :SORTKEY 0.45160094544602414d0) #S(ROW :CELLS (SUNNY less-than-80.8-and-more-than-78.7 less-than-92.9-and-more-than-89.8 TRUE NO) :CLASS NO :UTILITY 0 :SORTKEY 0.44694239671216807d0) #S(ROW :CELLS (RAINY less-than-72.4-and-more-than-70.3 less-than-92.9-and-more-than-89.8 TRUE NO) :CLASS NO :UTILITY 0 :SORTKEY 0.40643407928930564d0) #S(ROW :CELLS (RAINY less-than-66.1 less-than-71.2-and-more-than-68.1 TRUE NO) :CLASS NO :UTILITY 0 :SORTKEY 0.27521698080383394d0) #S(ROW :CELLS (SUNNY less-than-72.4-and-more-than-70.3 less-than-96.0-and-more-than-92.9 FALSE NO) :CLASS NO :UTILITY 0 :SORTKEY 0.2585191038174379d0)) :KLASSES (#S(KLASS :NAME NO :N 5) #S(KLASS :NAME YES :N 9)) :COLS (#S(SYM :NAME FORECAST :GOALP NIL :COUNTS {hash of 0 items}) #S(SYM :NAME $TEMPERATURE :GOALP NIL :COUNTS {hash of 0 items}) #S(SYM :NAME $HUMIDITY :GOALP NIL :COUNTS {hash of 0 items}) #S(SYM :NAME WINDY :GOALP NIL :COUNTS {hash of 0 items}) #S(SYM :NAME !CLASS :GOALP ! :COUNTS {hash of 0 items})) :RESULTS NIL)")) (deftest !tester3will4 () (reset-seed) (data "../data/numeric-lisp/weather.lisp") (test (which2 (discretizetbl (thetable) 3) t 3) nil)) (deftest !testingposition3will (&aux (col1 (make-sym :name 'apple)) (col2 (make-sym :name 'banana)) (col3 (make-sym :name 'cat))) (test (position col1 (list col1 col2 col3)) 0)) (deftest !3b1 () (data "../data/proj3/iris.lisp") (discretizetbl (thetable))) (deftest !disctabletest2 () (data "../data/numeric-lisp/weather.lisp") (discretizetbl (thetable) 3) (print (thetable))) (deftest !3a1 () (data "../data/proj3/iris.lisp") (print (fss (discretizetbl (thetable) 3))))