(defun quicksort-array (data) "quicksort--array performs a quicksort on the last element in each row, such that the matrix is eventually sorted by the class characteristic." (let ((pivotvector (make-array (array-dimension data 1) :initial-element nil)) (lesser (make-array (list (array-dimension data 0) (array-dimension data 1)) :initial-element nil)) (greater (make-array (list (array-dimension data 0) (array-dimension data 1)) :initial-element nil)) (rows.lesser 0) (rows.greater 0) (x (array-dimension data 0)) (y (array-dimension data 1))) (if (<= x 1) (return-from quicksort-array data)) ;(print x) ;;set pivot (dotimes (j y) (setf (aref pivotvector j) (aref data (- x 1) j))) (setf data (adjust-array data (list (- x 1) y))) (setf x (array-dimension data 0)) ;;iteration! (dotimes (i x) (cond ((<= (aref data i (- y 1)) (aref pivotvector (- y 1))) (dotimes (j y) (setf (aref lesser rows.lesser j) (aref data i j))) (setf rows.lesser (+ rows.lesser 1))) ((> (aref data i (- y 1)) (aref pivotvector (- y 1))) (dotimes (j y) (setf (aref greater rows.greater j) (aref data i j))) (setf rows.greater (+ rows.greater 1))))) ;;adjust matrices (setf lesser (adjust-array lesser (list rows.lesser y))) (setf greater (adjust-array greater (list rows.greater y))) ;;recursion (array-concat (quicksort-array greater) pivotvector (quicksort-array lesser)))) (defun array-concat (a1 vector a3) "array-append: returns a new array with all elements of a1 vector a3 in it. Note: the row size must be the same for all arrays" (let ((arr (make-array (list (+ (array-dimension a1 0) 1 (array-dimension a3 0)) (array-dimension a1 1)) :initial-element nil)) (currow -1)) (dotimes (i (array-dimension a1 0)) (setf currow (+ currow 1)) (dotimes (j (array-dimension a1 1)) (setf (aref arr currow j) (aref a1 i j)))) (setf currow (+ currow 1)) (dotimes (j (array-dimension vector 0)) (setf (aref arr currow j) (aref vector j))) (dotimes (i (array-dimension a3 0)) (setf currow (+ currow 1)) (dotimes (j (array-dimension a3 1)) (setf (aref arr currow j) (aref a3 i j)))) arr)) (defun make-usable (data) "make-usable: runs quicksort & cuts off the unneccessary class column" (adjust-array (quicksort-array data) (list (array-dimension data 0) (- (array-dimension data 1) 1)))) (defun set-distance-matrix(datarray) "set-distance-matrix: Creates and returns an array representing the distances between all objects" (let ((distancearray (make-array (list (array-dimension datarray 0) (array-dimension datarray 0)) :initial-element 0)) (sum 0)) (dotimes (i (array-dimension datarray 0) distancearray) (dotimes (j (array-dimension datarray 0)) (setf sum 0) (dotimes (k (array-dimension datarray 1)) (setf sum (+ sum (expt (- (aref datarray i k) (aref datarray j k)) 2)))) (setf (aref distancearray i j) (sqrt sum)))))) ;end set-distance-matrix (defun set-distance-matrix2 (data1 data2) "set-distance-matrix2: Creates and returns an array representing the distances between objects of two sets" (let ((distancearray (make-array (list (array-dimension data1 0) (array-dimension data2 0)) :initial-element 0)) (sum 0)) (dotimes (i (array-dimension distancearray 0) distancearray) (dotimes (j (array-dimension distancearray 1)) (setf sum 0) (dotimes (k (array-dimension data1 1)) (setf sum (+ sum (expt (- (aref data1 i k) (aref data2 j k)) 2)))) (setf (aref distancearray i j) (sqrt sum)))))) ;end set-distance-matrix2 (defun reduce-dist(oldist xmatrix column) "reduce-dist:reduces the distancematrix using another magic equation" (let ((reducedist (make-array (list (array-dimension oldist 0) (array-dimension oldist 1)) :initial-element 0))) (dotimes (i (array-dimension oldist 0) reducedist) (dotimes (j (array-dimension oldist 1)) (setf (aref reducedist i j) (expt (expt (- (expt (aref oldist i j) 2) (expt (- (aref xmatrix i column) (aref xmatrix j column)) 2)) 2) 1/4)))))) ;end reduce-dist (defun dist(distmatrix a) "returns the number of the object furthest from a, according to the distmatrix" (let ((b 0) (temp 0)) (dotimes (i (array-dimension distmatrix 0) b) (cond ((> (aref distmatrix a i) temp) (setf temp (aref distmatrix a i)) (setf b i)))))) ;end dist (defun choose-distance-objects (dist) "choose-distant-objects: chooses the two longest away object thingies through ancient magic" (let ((o.b 0) (o.a 0) (vlist 0)) (dotimes (i 5) ;5 is the number of iterations suggested by Faloutsos & Lin (setf o.a (dist dist o.b)) (setf o.b (dist dist o.a))) (setf vlist (list o.a o.b)))) ;end choose-distant-objects (defun stress (data1 data2) "stress: checks the difference between two nxn matrices. The primary purpose of this function is to ensure distance between the original and 'fastmapped' objects are relatively maintained" (let ((dist1 (set-distance-matrix data1)) (dist2 (set-distance-matrix data2)) (computed (make-array (list (array-dimension data1 0) (array-dimension data1 1)) :initial-element nil))) (dotimes (i (array-dimension computed 0) computed) (dotimes (j (array-dimension computed 1)) (setf (aref computed i j) (- (aref dist1 i j) (aref dist2 i j))))))) ;end stress (that seems unlikely) (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)))) ;end save-item (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 make-plottable-initial (filename dimensions clusters) (let ((command 0)) (cond ((= dimensions 2) (setf command "plot")) ((= dimensions 3) (setf command "splot"))) (with-open-file (out filename :direction :output :if-exists :supersede) (with-standard-io-syntax (format out "###COLOR BY VALUE###~%# ~a '~a' index 0, '~a' index 1, '~a' index 2~%" command filename filename filename) (format out "###COLOR BY CLUSTER###~%# ~a '~a' index 3" command filename) (dotimes (i (- clusters 1)) (format out ", '~a' index ~a" filename (+ i 4))) (format out "~%###COLOR BY VALUE, LINES BY CLUSTER###~%# ~a '~a' index 0, '~a' index 1,'~a' index 2, '~a' index 3:~a with lines~%" command filename filename filename filename (+ clusters 2)))))) ;end make-plottable-initial (defun make-plottable-clusters (matrix filename) "make-plottable-clusters: formats the given sorted data matrix and throws it into the specified file so that is is easily readable by gnuplot. Splits the data into as many classes as in the matrix." (let ((temp (aref matrix 0 (- (array-dimension matrix 1) 1))) (indexcount 4)) (with-open-file (out filename :direction :output :if-exists :append) (with-standard-io-syntax (format out "~%~%###cluster indices###~%###index 3###~%") (dotimes (i (array-dimension matrix 0)) (cond ((/= temp (aref matrix i (- (array-dimension matrix 1) 1))) (setf temp (aref matrix i (- (array-dimension matrix 1) 1))) (format out "~%~%###index ~a###~%" indexcount) (setf indexcount (+ indexcount 1)))) (dotimes (j (- (array-dimension matrix 1) 1)) (format out "~a " (aref matrix i j))) (format out "~%")))) 'done)) ;end make-plottable-clusters (defun make-plottable (matrix filename) "make-plottable: formats the given data matrix and throws it into the specified file so that it is easily readable by gnuplot. Splits the data into three classes: top 10%, middle, bottom 10%" (let ((partition 0)) (setf partition (ceiling (array-dimension matrix 0) 10)) (with-open-file (out filename :direction :output :if-exists :append) (with-standard-io-syntax (format out "###value indices###~%") (format out "###index 0###~%") (dotimes (i partition) (dotimes (j (array-dimension matrix 1)) (format out "~a " (aref matrix i j))) (format out "~%")) (format out "~%~%") (format out "###index 1###~%") (dotimes (i (- (array-dimension matrix 0) partition)) (dotimes (j (array-dimension matrix 1)) (format out "~a " (aref matrix (+ i partition) j))) (format out "~%")) (format out "~%~%") (format out "###index 2###~%") (dotimes (i partition) (dotimes (j (array-dimension matrix 1)) (format out "~a " (aref matrix (+ (- (array-dimension matrix 0) partition) i) j))) (format out "~%")))) 'done)) ;end make-plottable ;;;;;;;;;;;;;;;;;;;;TEST FUNCTIONS;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;newstuff (defun l2a (datalist) (let ((arr (make-array (list (length datalist) (length (car datalist))))) (count 0)) (dolist (row datalist) (dolist (item row) (setf (row-major-aref arr count) item) (setf count (+ count 1)))) arr)) (defun a2l (datarray) (let ((al '()) (templ '())) (dotimes (i (array-dimension datarray 0)) (setf templ '()) (dotimes (j (array-dimension datarray 1)) (setf templ (append templ (list (aref datarray i j))))) (setf al (append al (list templ)))) al)) (defun simple-plottable (arr filename) "writes the array t a simple gnuplottable file" (with-open-file (out filename :direction :output :if-exists :supersede) (dotimes (i (array-dimension arr 0)) (dotimes (j (array-dimension arr 1)) (format out "~A " (aref arr i j))) (format out "~%"))) 'done)