From ca2f3153f54f6b76a44d1e960b4b015ded595b87 Mon Sep 17 00:00:00 2001
From: AJ Rossini <blindglobe@gmail.com>
Date: Sat, 9 Jun 2007 22:56:53 +0200
Subject: [PATCH] clean up matrix and linalg packages

---
 linalg.lsp   | 45 +++++++++++++++++++++++++--------------------
 matrices.lsp | 35 +++++++++++++++++++++++++++--------
 2 files changed, 52 insertions(+), 28 deletions(-)

diff --git a/linalg.lsp b/linalg.lsp
index 3cbaf0d..bc00b7e 100644
--- a/linalg.lsp
+++ b/linalg.lsp
@@ -24,6 +24,7 @@
 
 (defpackage :lisp-stat-linalg
   (:use :common-lisp
+	:lisp-stat-types
 	:lisp-stat-matrix)
   (:export chol-decomp lu-decomp lu-solve determinant inverse sv-decomp
 	   qr-decomp rcondest make-rotation spline kernel-dens kernel-smooth
@@ -501,13 +502,17 @@ FIXME:kernel-smooth-Cport"
 	       (setf (aref ys i)
 		     (let ((wsum 0.0)
 			   (ysum 0.0))
-		       (dotimes (j (- n 1))   ) ;;remove for the following
-;;;			 (let* ;; FIXME!?
-;;;			     ((lwidth (if wds (* width (aref wds j)) width))
-;;;			      (lwt (* (kernel-Cport (aref xs i) (aref px j) lwidth ktype) ;; px?
-;;;				      (if wts (aref wts j) 1.0))))
-;;;			   (setf wsum (+ wsum lwt))
-;;;			   (setf ysum (if py (+ ysum (* lwt (aref py j))))))) ;; py? y?
+		       (dotimes (j (- n 1))   )
+;;;possible nasty errors...
+#|
+		       (let* 
+			     ((lwidth (if wds (* width (aref wds j)) width))
+			      (lwt (* (kernel-Cport (aref xs i) (aref px j) lwidth ktype) ;; px?
+				      (if wts (aref wts j) 1.0))))
+			   (setf wsum (+ wsum lwt))
+			   (setf ysum (if py (+ ysum (* lwt (aref py j)))))) ;; py? y?
+|#
+;;; end of errors
 		       (if py
 			   (if (> wsum 0.0) 
 			       (/ ysum wsum)
@@ -659,7 +664,7 @@ LVAL xssurface_contour()
 ;;; FFT
 ;;;
 ;;; FIXME:ajr
-;;; replace with matlisp:fft  and matlisp:ifft (the latter for inverse mapping)
+;;; ??replace with matlisp:fft  and matlisp:ifft (the latter for inverse mapping)
 ;;;
 (defun fft (x &optional inverse)
 "Args: (x &optional inverse)
@@ -847,17 +852,17 @@ is true."
       1)
      (t 0))))
 
-;;; FIXME: use matlisp
+;; FIXME: use matlisp
 (defun make-sweep-matrix (x y &optional w)
-"Args: (x y &optional weights)
-X is a matrix, Y and WEIGHTS are sequences. Returns the sweep matrix for the
-(possibly weighted) regression of Y on X."
-  (check-matrix x)
-  (check-sequence y)
-  (if w (check-sequence w))
-  (let ((n (num-rows x))
-	(p (num-cols x)))
-    (if (/= n (length y)) (error "dimensions do not match"))
+  "Args: (x y &optional weights)
+ X is matrix, Y and WEIGHTS are sequences. Returns the sweep matrix of the
+ (weighted) regression of Y on X"
+   (check-matrix x)
+   (check-sequence y)
+   (if w (check-sequence w))
+   (let ((n (num-rows x))
+      	(p (num-cols x)))
+      (if (/= n (length y)) (error "dimensions do not match"))
     (if (and w (/= n (length w))) (error "dimensions do not match"))
     (let ((mode (max (la-data-mode x) 
                      (la-data-mode x) 
@@ -865,12 +870,12 @@ X is a matrix, Y and WEIGHTS are sequences. Returns the sweep matrix for the
 	  (result (make-array (list (+ p 2) (+ p 2))))
 	  (x-mean (make-array p))
 	  (y (coerce y 'vector))
-	  (w (if w (coerce w 'vector)))
+ 	  (w (if w (coerce w 'vector)))
 	  (has-w (if w 1 0)))
       (make-sweep-front x y w n p mode has-w x-mean result)
       result)))
 
-(defun sweep-in-place (a k tol)
+ (defun sweep-in-place (a k tol)
   (check-matrix a)
   (check-one-fixnum k)
   (check-one-real tol)
diff --git a/matrices.lsp b/matrices.lsp
index 41f981d..305a201 100644
--- a/matrices.lsp
+++ b/matrices.lsp
@@ -10,8 +10,6 @@
 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
 ;;;; unrestricted use.
 
-;;(provide "matrices")
-
 ;;;;
 ;;;; Package Setup
 ;;;;
@@ -20,18 +18,39 @@
 
 (defpackage :lisp-stat-matrix
   (:use :common-lisp
+	:lisp-stat-compound-data
 	:lisp-stat-sequence)
-  (:export 
-
-;;(export '(
-   matrixp num-rows num-cols matmult identity-matrix diagonal
-   row-list column-list inner-product outer-product cross-product
-   transpose bind-columns bind-rows))
+  (:export matrixp num-rows num-cols matmult identity-matrix diagonal
+	   row-list column-list inner-product outer-product
+	   cross-product transpose bind-columns bind-rows
+	   array-data-vector vector-to-array))
 
 (in-package :lisp-stat-matrix)
 
 (deftype matrix () 'array)  ;; temp fix
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;;          Array to Row-Major Data Vector Conversion Functions
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun array-data-vector (a)
+"Args: (a)
+Displaces array A to a vector"
+  (make-array (array-total-size a)
+	      :displaced-to a
+	      :element-type (array-element-type a)))
+
+(defun vector-to-array (v dims)
+"Args: (v dims)
+Displaces vector V to array with dimensions DIMS"
+  (make-array dims
+	      :displaced-to v
+	      :element-type (array-element-type v)))
+
+;;;;
+
 (defun check-matrix (a)
   (if (not (and (arrayp a) (= (array-rank a) 2)))
       (error "not a matrix - ~s" a)
-- 
2.11.4.GIT