;;;;compiled under:
;;;;slime 1:20070927-3
;;;;SBCL  1:1.0.11.0-1
;;;;Peter Santiago, July 15th, 2008
;;;;Program note: the input data array is assumed to be AxB,
;;;;where each row represents the B dimensions of one point
;;;;and there are A points
;;;;All unknown values should be of value "BLANK"

;(defun discrete-main (inputfile outputfile fastmap-dimensions clusters-sought)
 ; "throws everything together"
  ;(let* ((infile (load-item inputfile))
   ;      (minmaxmatrix (get-minmax infile))
    ;     (normalizedm (normalize infile minmaxmatrix))
     ;    (discretedist (discrete-distances normalizedm minmaxmatrix))
      ;   (fastmatrix (fastmap fastmap-dimensions normalizedm discretedist)))
    ;(make-plottable-initial outputfile fastmap-dimensions clusters-sought)
    ;(make-plottable fastmatrix outputfile)))

(defun discrete-main (inputfile outputfile fastmap-dimensions clusters-sought)
  "throws everything together"
  (let* ((infile (load-item inputfile))
         (minmaxmatrix 0)
         (normalizedm 0)
         (discretedist 0)
         (fastmatrix 0))
    (setf minmaxmatrix (get-minmax infile))
    (print 'done)
    (setf normalizedm (normalize infile minmaxmatrix))
    (print 'done)
    (setf discretedist (discrete-distances normalizedm minmaxmatrix))
    (print 'done)
    (setf fastmatrix (fastmap fastmap-dimensions normalizedm discretedist))
    (print 'done)
    (make-plottable-initial outputfile fastmap-dimensions clusters-sought)
    (make-plottable fastmatrix outputfile)
    (make-plottable-clusters
     (quicksort-array (k-means clusters-sought fastmatrix)) outputfile)))

(defun get-minmax (matrix)
  "For continuous values, finds the min and max per column.
   Note: Years are not continuous but are also obviously numbers.
   There is a terrible fix for it; a better programmer might
   come up with a better way."
  (labels ((digits (n) (ceiling (log (+ n .0000001) 10))))
                                        ;don't work with powers of 10
    (let* ((inf most-positive-fixnum)
           (ninf most-negative-fixnum)
           (minmax (make-array `(2 ,(array-dimension matrix 1))
                               :initial-contents
                               (list (make-array (array-dimension matrix 1)
                                                 :initial-element inf) 
                                     (make-array (array-dimension matrix 1)
                                                 :initial-element ninf)))))
      
      (dotimes (i (array-dimension matrix 0))
        (dotimes (j (array-dimension matrix 1))
          (cond ((not (numberp (aref matrix i j))))
                ((numberp (aref matrix i j))
                 (if (< (aref matrix i j) (aref minmax 0 j))
                     (setf (aref minmax 0 j) (aref matrix i j)))
                 (if (> (aref matrix i j) (aref minmax 1 j))
                     (setf (aref minmax 1 j) (aref matrix i j)))))))

      (dotimes (i (array-dimension minmax 0))
        (dotimes (j (array-dimension minmax 1))
          (cond ((or (= (aref minmax i j) inf)
                     (= (aref minmax i j) ninf)
                     (if (> (aref minmax i j) 0)
                         (= 4 (digits (aref minmax i j)))))
                 (setf (aref minmax i j) nil)))))
      minmax)))

(defun normalize (matrix minmax)
  "This function normalizes data that can be normalized."
  (dotimes (i (array-dimension matrix 0))
    (dotimes (j (array-dimension matrix 1))
      (if (numberp (aref minmax 0 j))
          (if (numberp (aref matrix i j))
              (setf (aref matrix i j)
                    (/ (- (aref matrix i j) (aref minmax 0 j))
                       (- (aref minmax 1 j) (aref minmax 0 j))))))))
  matrix)
          

(defun discrete-distances (matrix minmax)
  "This function determines the distances between data points.
   The resulting matrix is returned.
   (+ sum 0) is added in for clarity."
  (let ((distm (make-array (list (array-dimension matrix 0)
                                 (array-dimension matrix 0))
                                 :initial-element nil))
        (sum 0))
    
    (dotimes (i (array-dimension matrix 0) distm)
      (format t "Now on: ~a~%" i) 
      (dotimes (j (array-dimension matrix 0))
        (setf sum 0)
        (cond ((equalp (aref distm i j) nil)
               (dotimes (k (array-dimension matrix 1))
                 (cond ((or (equalp (aref matrix i k) 'BLANK)
                            (equalp (aref matrix j k) 'BLANK))
                        (setf sum (+ sum 0)))
                       
                       ((equalp (aref minmax 0 k) nil)
                        (if (equalp (aref matrix i k) (aref matrix j k))
                            (setf sum (+ sum 0))
                            (setf sum (+ sum 1))))
                       ((numberp (aref minmax 0 k))
                        (setf sum (+ sum (expt (- (aref matrix i k)
                                                  (aref matrix j k)) 2))))))
               ;(format t "Setting ~a:~a and ~a:~a~%" i j j i)
               (setf (aref distm i j) (sqrt sum))
               (setf (aref distm j i) (sqrt sum))))))))
  
(defun load-item (filename)
  "load-item: allows the file at filename to be parsed and stored"
  (let ((x 0))
  (with-open-file (in filename)
    (with-standard-io-syntax
      (setf x (read in))
      x)))) ;end load-item

(defun save-item (filename item)
  "save-item: allows the variable item to be stored in the file at filename as a lisp object"
 (with-open-file (out filename
                  :direction :output
                  :if-exists :supersede)
    (with-standard-io-syntax
      (print item out)
      'done))) ;end save-item