;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of AIslash.
;
; AIslash is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; AIslash is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with AIslash.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun data (l &key (n 1) (ranker "~20,10f") (4class   #'thing->bore)
		                             (4others  #'thing->ewd))
  (let* ((headers (list2headers (first l)))
         (data    (mapcar #'copy-list (rest l)))
         (rows    (length data))
         (cols    (length headers)))
    (when  (< 50 rows)
      (unless (= 1 n)
	(setf n 3)))
    (dolist (row data)
      (mapc #'sniff headers row))
    (mapc #'taste headers)
    (setf data 
          (symbolize-rows headers data 4class 4others))
    (setf (last1 headers) 
	  (discrete! (last1 headers)))
    (mapcar #'(lambda (f) 
		(table headers (fold-train f) (fold-test f)))
	    (folds data n))))

(defun table (headers train test)
  (let ((rows (length train))
        (cols (length headers))
        (klasses (discrete-cardinality (last1 headers))))
    (dolist (header headers)
      (index-init klasses header))
    (doitems (row i train)
      (index-row headers row i))
    (make-table :headers (make-array `(,cols) 
                                     :initial-contents headers)
                :egs     (make-array `(,rows ,cols)  
                                     :initial-contents train)
                :tests  test)))

(defmethod sniff ((n numeric) x)
  (push x (numeric-all n))
  (setf (numeric-max n) (max (numeric-max n) x)
        (numeric-min n) (min (numeric-min n) x))
  (incf (numeric-sum   n) x)
  (incf (numeric-sumsq n) (* x x))
  (incf (numeric-n n)))

(defmethod sniff ((d discrete) x)
  (unless (discrete-uniques d)
    (setf (discrete-uniques d) (make-hash-table)))
  (incf (gethash x (discrete-uniques d) 0)))

(defmethod taste ((n numeric))
  (let* ((best       (numeric-best n))
         (nums       (numeric-all  n))
         (sorted     (sort nums #'<))
         (best2      (if (< best 0) (* -1 best) (- 1  best)))
         (best-pos   (round (* (length sorted) best2)))
         (best-val   (nth best-pos sorted)))
    (setf (numeric-best-num n) best-val
          (numeric-all      n) sorted)))
   
(defmethod taste ((d discrete))
  (let ((data (keys2sorted-alist (discrete-uniques d)
                           (wm-t-num-sorter *w4t*))))
    (setf (discrete-cardinality d) (length data)
          (discrete-ranks d)       data)))
        
(defun index-row (headers row i)
  (let* ((class   (last1 row)))
    (mapc #'(lambda (cell header)
	      (index-cell (discrete-xindex header) cell class i))
	  row headers)))

(defmethod index-init (klasses header)
  (let ((range (discrete-cardinality header))
        (x     (discrete-xindex      header)))
    (setf (xindex-uniques   x) (make-array range)
          (xindex-location x) (make-array range 
                                           :initial-element nil)
          (xindex-counts    x) (make-array `(,klasses ,range)))))
  
(defun index-cell (x cell class i)
   (incf   (aref (xindex-uniques  x) cell))
   (incf   (aref (xindex-counts   x) class cell))
   (push i (aref (xindex-location x) cell)))