From jivestgarden at common-lisp.net  Sun Mar 18 15:14:21 2012
From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net)
Date: Sun, 18 Mar 2012 08:14:21 -0700
Subject: [lisplab-cvs] r208 - trunk/src/linalg
Message-ID: <E1S9HoL-00052j-SD@common-lisp.net>

Author: jivestgarden
Date: Sun Mar 18 08:14:21 2012
New Revision: 208

Log:
Implemented mtp and optimized m*

Modified:
   trunk/src/linalg/level3-linalg-dge.lisp

Modified: trunk/src/linalg/level3-linalg-dge.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-dge.lisp	Sun Oct  9 08:06:36 2011	(r207)
+++ trunk/src/linalg/level3-linalg-dge.lisp	Sun Mar 18 08:14:21 2012	(r208)
@@ -25,27 +25,35 @@
       (setf ans (.+ ans (mref matrix i i))))
     ans))
 
-#+todo (defmethod mtp (a)
-  (let ((b (mcreate a 0 (list (cols a) (rows a)))))
-    (dotimes (i (rows b))
-      (dotimes (j (cols b))
-	(setf (mref b i j) (mref a j i))))
-    b))
+(defmethod mtp ((a matrix-base-dge))
+  (let* ((N (rows a))
+	 (M (cols a))
+	 (c (mcreate a 0 (list M N)))
+	 (a2 (vector-store a))
+	 (c2 (vector-store c)))
+    (declare (type-blas-store a2 c2)
+             (type-blas-idx M N))
+    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,i ,j N))
+	       (refc (i j) `(ref-blas-real-store C2 ,i ,j M)))
+      (dotimes (i M)
+	(dotimes (j N)
+	  (setf (refc i j) (refa j i)))))
+    c))
 
 (defmethod mct ((a matrix-base-dge))
   (mtp a))
 
-(defmethod m* ((a matrix-base-dge) (b matrix-base-dge))
+(defmethod 2m* ((a matrix-base-dge) (b matrix-base-dge))
   (let* ((N (rows a))
 	 (M (cols b))
 	 (S (rows b))
 	 (c (mcreate a 0 (list N M)))
-	 (a2 (vector-store a))
+	 (a2 (vector-store (mtp a))) ; optimization. consideres the transpose
 	 (b2 (vector-store b))
 	 (c2 (vector-store c)))
     (declare (type-blas-store a2 b2 c2)
              (type-blas-idx N M S))
-    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,i ,j N))
+    (macrolet ((refa (i j) `(ref-blas-real-store A2 ,j ,i N))
 	       (refb (i j) `(ref-blas-real-store B2 ,i ,j S))
 	       (refc (i j) `(ref-blas-real-store C2 ,i ,j N)))
       (dotimes (i N)



From jivestgarden at common-lisp.net  Sun Mar 18 15:40:45 2012
From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net)
Date: Sun, 18 Mar 2012 08:40:45 -0700
Subject: [lisplab-cvs] r209 - trunk/src/linalg
Message-ID: <E1S9IDt-0006V4-QQ@common-lisp.net>

Author: jivestgarden
Date: Sun Mar 18 08:40:45 2012
New Revision: 209

Log:
Fix. Wrong name in last ci with 2m* for m*

Modified:
   trunk/src/linalg/level3-linalg-dge.lisp

Modified: trunk/src/linalg/level3-linalg-dge.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-dge.lisp	Sun Mar 18 08:14:21 2012	(r208)
+++ trunk/src/linalg/level3-linalg-dge.lisp	Sun Mar 18 08:40:45 2012	(r209)
@@ -43,7 +43,7 @@
 (defmethod mct ((a matrix-base-dge))
   (mtp a))
 
-(defmethod 2m* ((a matrix-base-dge) (b matrix-base-dge))
+(defmethod m* ((a matrix-base-dge) (b matrix-base-dge))
   (let* ((N (rows a))
 	 (M (cols b))
 	 (S (rows b))



From jivestgarden at common-lisp.net  Fri Mar 23 19:19:58 2012
From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net)
Date: Fri, 23 Mar 2012 12:19:58 -0700
Subject: [lisplab-cvs] r210 - in trunk/src: linalg matrix2
Message-ID: <E1SBA1m-0008OJ-Ep@common-lisp.net>

Author: jivestgarden
Date: Fri Mar 23 12:19:57 2012
New Revision: 210

Log:
Added level2 column operations

Modified:
   trunk/src/linalg/level3-linalg-generic.lisp
   trunk/src/matrix2/matrix2-dge.lisp
   trunk/src/matrix2/matrix2-generic.lisp
   trunk/src/matrix2/matrix2-interface.lisp

Modified: trunk/src/linalg/level3-linalg-generic.lisp
==============================================================================
--- trunk/src/linalg/level3-linalg-generic.lisp	Sun Mar 18 08:40:45 2012	(r209)
+++ trunk/src/linalg/level3-linalg-generic.lisp	Fri Mar 23 12:19:57 2012	(r210)
@@ -38,7 +38,7 @@
 (defmethod mct ((a matrix-base))
   (.conj (mtp a)))
 
-(defmethod m* ((a matrix-base) (b matrix-base))
+#+old (defmethod m* ((a matrix-base) (b matrix-base))
   (let ((c (mcreate a 0 (list (rows a) (cols b)))))
     (dotimes (i (rows c))
       (dotimes (j (cols c))
@@ -47,6 +47,15 @@
 				 (.* (mref a i k) (mref b k j)))))))
     c))
 
+(defmethod m* ((a matrix-base) (b matrix-base))
+  (let ((c (mcreate a 0 (list (rows a) (cols b))))
+	(a (mtp a)))
+    (dotimes (i (rows c))
+      (dotimes (j (cols c))
+	(setf (mref c i j) 
+	      (col-col-mul-sum A i b j))))
+    c))
+
 (defmethod m/ ((a matrix-base) (b matrix-base))
   (m* a (minv b)))
 
@@ -64,27 +73,6 @@
 	  (setf (vref col i) 1)
 	  (LU-solve! LU col))))
     A))
-      
-#+nil (defmethod minv! ((a matrix-base))
-  ;; Flawed. Does not work on when pivoting is needed
-  "Brute force O(n^3) implementation of matrix inverse.
-Think I'll keep this for the general case since it works also 
-when the elements cannot be ordered, unlike the LU-based version"
-  (let* ((size (rows a))
-	 (temp 0))
-    (dotimes (i size a)
-      (setf temp (mref a i i))
-      (dotimes (j size)
-	(setf (mref a i j) (if (= i j)
-			       (./ (mref a i j))
-			       (./ (mref a i j) temp))))
-      (dotimes (j size)
-	(unless (= i j)
-	  (setf temp (mref a j i)
-		(mref a j i) 0)
-	  (dotimes (k size)
-	    (setf (mref a j k)
-		  (.- (mref a j k) (.* temp (mref a i k))))))))))
 
 (defmethod LU-factor! ((A matrix-base) p)
   ;; Translation from GSL. 
@@ -182,8 +170,26 @@
 
     
 
-  
-
-
+;;; Alternative code
       
 
+#+nil (defmethod minv! ((a matrix-base))
+  ;; Flawed. Does not work on when pivoting is needed
+  "Brute force O(n^3) implementation of matrix inverse.
+Think I'll keep this for the general case since it works also 
+when the elements cannot be ordered, unlike the LU-based version"
+  (let* ((size (rows a))
+	 (temp 0))
+    (dotimes (i size a)
+      (setf temp (mref a i i))
+      (dotimes (j size)
+	(setf (mref a i j) (if (= i j)
+			       (./ (mref a i j))
+			       (./ (mref a i j) temp))))
+      (dotimes (j size)
+	(unless (= i j)
+	  (setf temp (mref a j i)
+		(mref a j i) 0)
+	  (dotimes (k size)
+	    (setf (mref a j k)
+		  (.- (mref a j k) (.* temp (mref a i k))))))))))

Modified: trunk/src/matrix2/matrix2-dge.lisp
==============================================================================
--- trunk/src/matrix2/matrix2-dge.lisp	Sun Mar 18 08:40:45 2012	(r209)
+++ trunk/src/matrix2/matrix2-dge.lisp	Fri Mar 23 12:19:57 2012	(r210)
@@ -58,3 +58,62 @@
 					    (- j dc) 
 					    rows)))))
       B))
+
+;;;; The column operations
+
+(defmethod col-smul! ((A matrix-dge) i num)
+  (let* ((num (coerce num 'double-float))
+	 (A-store (vector-store A))
+	 (r (rows A))
+	 (start (* r i))
+	 (end (* r (1+ i))))
+    (declare (type type-blas-store A-store)
+	     (type type-blas-idx start end))
+    (loop for k from start below end do
+	 (setf (aref A-store k)
+	       (* (aref A-store k) num))))
+  A)
+
+(defmethod col-swap! ((A matrix-dge) i j)
+  (let* ((A-store (vector-store A))
+	 (r (rows A))
+	 (tmp 0d0)
+	 (ii (* i r))
+	 (jj (* j r)))
+    (declare (type type-blas-store A-store)
+	     (type type-blas-idx r ii jj)
+	     (type double-float tmp))
+    (dotimes (k r)
+      (setf tmp (aref A-store ii)
+	    (aref A-store ii) (aref A-store jj)
+	    (aref A-store jj) tmp)
+      (incf ii)
+      (incf jj))
+    A))
+
+(defmethod col-sum ((A matrix-dge) i)
+  (let* ((A-store (vector-store A))
+	 (r (rows A))
+	 (start (* r i))
+	 (end (* r (1+ i)))
+	 (sum 0d0))
+    (declare (type type-blas-store A-store)
+	     (type type-blas-idx i r start end)
+	     (type double-float sum))
+    (loop for k from start below end do
+	 (incf sum (aref A-store k)))
+    sum))
+
+(defmethod col-col-mul-sum ((A matrix-dge) i
+			    (B matrix-dge) j)
+  (let ((A-store (vector-store A))
+	(B-store (vector-store B))
+	(r (rows A))
+	(sum 0d0))
+    (declare (type type-blas-store A-store B-store)
+	     (type type-blas-idx i j r)
+	     (type double-float sum))
+    (dotimes (k r)
+      (incf sum (* (aref A-store (column-major-idx k i r))
+		   (aref B-store (column-major-idx k j r)))))
+    sum))

Modified: trunk/src/matrix2/matrix2-generic.lisp
==============================================================================
--- trunk/src/matrix2/matrix2-generic.lisp	Sun Mar 18 08:40:45 2012	(r209)
+++ trunk/src/matrix2/matrix2-generic.lisp	Fri Mar 23 12:19:57 2012	(r210)
@@ -141,19 +141,44 @@
   (reshape a (list rows (/ (size a) rows) 1)))
 
 
-(defmethod row-swap! (A i j)
+(defmethod row-swap! ((A matrix-base) i j)
   (dotimes (c (cols A))
     (psetf (mref A i c) (mref A j c)
 	   (mref A j c) (mref A i c)))
   A)
 
-(defmethod row-mul! (A i num)
+(defmethod row-mul! ((A matrix-base) i num)
   (dotimes (c (cols A))
     (setf (mref A i c) (.* num (mref A i c))))
   A)
 
-(defmethod row-add! (A i j num)
+(defmethod row-add! ((A matrix-base) i j num)
   (dotimes (c (cols A))
     (setf (mref A i c) (.+ (mref A i c) (.* num (mref A j c)))))
   A)
 
+;;; The column operations 
+
+(defmethod col-swap! ((A matrix-base) i j)
+  (dotimes (r (rows A))
+    (psetf (mref A r i) (mref A r j)
+	   (mref A r j) (mref A r i)))
+  A)
+
+(defmethod col-smul! ((A matrix-base) i num)
+  (dotimes (r (rows A))
+    (setf (mref A r i) (.* num (mref A r i))))
+  A)
+  
+(defmethod col-sum ((A matrix-base) i)
+  (let ((sum 0))
+    (dotimes (r (rows A))
+      (setf sum (.+ sum (mref A r i))))
+    sum))
+
+(defmethod col-col-mul-sum ((A matrix-base) i (B matrix-base) j)
+  (let ((sum 0))
+    (dotimes (r (rows A))
+      (setf sum (.+ sum (.* (mref A r i)
+			    (mref B r j)))))
+    sum))

Modified: trunk/src/matrix2/matrix2-interface.lisp
==============================================================================
--- trunk/src/matrix2/matrix2-interface.lisp	Sun Mar 18 08:40:45 2012	(r209)
+++ trunk/src/matrix2/matrix2-interface.lisp	Fri Mar 23 12:19:57 2012	(r210)
@@ -65,7 +65,7 @@
 (defgeneric get-col (matrix col)
   (:documentation "Gets rows. Destructive"))
 
-;;; Row operations 
+;;; Row operations. TODO remove these
 
 (defgeneric row-swap! (matrix i j)
   (:documentation "Swaps row i and j of matrix. Destructive."))
@@ -76,6 +76,21 @@
 (defgeneric row-add! (matrix i j number)
   (:documentation "Adds a multiplicum of row j to row i. A_ic=A_ic+number*A_jc. Destructive.")) 
 
+;;; Column operations. 
+
+(defgeneric col-swap! (matrix i j)
+  (:documentation "Swaps row i and j of matrix. Destructive."))
+
+(defgeneric col-smul! (matrix i number)
+  (:documentation "Multiplies row i with a scalar. Destructive."))
+
+(defgeneric col-sum (matrix i)
+  (:documentation "Multiplies row i with a scalar. Destructive."))
+
+(defgeneric col-col-mul-sum (a i b j)
+  (:documentation "The dot product of column i of a and column j of b."))
+
+
 
 ;;;; Views
 



From jivestgarden at common-lisp.net  Sat Mar 24 19:32:21 2012
From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net)
Date: Sat, 24 Mar 2012 12:32:21 -0700
Subject: [lisplab-cvs] r211 - in trunk/src: core matrix2
Message-ID: <E1SBWhJ-0007bW-2s@common-lisp.net>

Author: jivestgarden
Date: Sat Mar 24 12:32:20 2012
New Revision: 211

Log:
the ordinary functions now outputs double float when input integer

Modified:
   trunk/src/core/level0-functions.lisp
   trunk/src/matrix2/matrix2-constructors.lisp

Modified: trunk/src/core/level0-functions.lisp
==============================================================================
--- trunk/src/core/level0-functions.lisp	Fri Mar 23 12:19:57 2012	(r210)
+++ trunk/src/core/level0-functions.lisp	Sat Mar 24 12:32:20 2012	(r211)
@@ -121,13 +121,7 @@
 
 
 (define-constant +ordinary-functions-number-to-number-map+ 
-  '((.sin . sin) (.cos . cos) (.tan . tan)
-    (.asin . asin) (.acos . acos) (.atan . atan)
-    (.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
-    (.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
-    (.exp . exp) (.ln . log) 
-    (.sqrt . sqrt) (.sqr . sqr)
-    (.re . realpart)(.im . imagpart) (.abs . abs)
+  '((.re . realpart)(.im . imagpart) (.abs . abs)
     (.conj . conjugate)))
 
 (defmacro expand-num-num ()
@@ -141,6 +135,28 @@
 
 (expand-num-num)
 
+(define-constant +ordinary-functions-number-to-real-map+ 
+  '((.sin . sin) (.cos . cos) (.tan . tan)
+    (.asin . asin) (.acos . acos) (.atan . atan)
+    (.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
+    (.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
+    (.exp . exp) (.ln . log) 
+    (.sqrt . sqrt) (.sqr . sqr)))
+
+(defmacro expand-num-real ()
+  ;; TODO: optimize? why?
+  (cons 'progn
+      (mapcar (lambda (name)
+		`(progn 
+		   (defmethod ,(car name) ((a number))
+		     (,(cdr name) 
+		       (if (integerp a) 
+			   (coerce a 'double-float)
+			   a)))))
+	      +ordinary-functions-number-to-real-map+ )))
+
+(expand-num-real)
+
 
 
 

Modified: trunk/src/matrix2/matrix2-constructors.lisp
==============================================================================
--- trunk/src/matrix2/matrix2-constructors.lisp	Fri Mar 23 12:19:57 2012	(r210)
+++ trunk/src/matrix2/matrix2-constructors.lisp	Sat Mar 24 12:32:20 2012	(r211)
@@ -216,7 +216,7 @@
 			   (funcall fun i j))
 		   :vref (lambda (self i)
 			   (declare (ignore self))
-			   (multiple-value-bind (c r)			       
+			   (multiple-value-bind (c r)
 			       (floor i rows)
 			     (funcall fun r c))))))
 



From jivestgarden at common-lisp.net  Fri Mar 30 17:52:31 2012
From: jivestgarden at common-lisp.net (jivestgarden at common-lisp.net)
Date: Fri, 30 Mar 2012 10:52:31 -0700
Subject: [lisplab-cvs] r212 - in trunk: . src/core src/matrix1 src/util
	src/vector1 src/vector2
Message-ID: <E1SDfzz-0004J9-8C@common-lisp.net>

Author: jivestgarden
Date: Fri Mar 30 10:52:30 2012
New Revision: 212

Log:
prepear for integer type matrices

Added:
   trunk/src/vector1/level1-element.lisp
Modified:
   trunk/lisplab.asd
   trunk/src/core/level0-functions.lisp
   trunk/src/core/level0-interface.lisp
   trunk/src/matrix1/level1-classes.lisp
   trunk/src/util/level1-util.lisp
   trunk/src/util/ref.lisp
   trunk/src/util/type.lisp
   trunk/src/vector1/level1-vector.lisp
   trunk/src/vector2/vector2-function.lisp
   trunk/src/vector2/vector2-operator.lisp

Modified: trunk/lisplab.asd
==============================================================================
--- trunk/lisplab.asd	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/lisplab.asd	Fri Mar 30 10:52:30 2012	(r212)
@@ -79,7 +79,8 @@
     :depends-on (:src/core)
     :serial t
     :components 
-    ((:file "level1-interface")    
+    ((:file "level1-interface")
+     (:file "level1-element")
      (:file "level1-vector")
      ))
 

Modified: trunk/src/core/level0-functions.lisp
==============================================================================
--- trunk/src/core/level0-functions.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/core/level0-functions.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -119,10 +119,30 @@
 (defmethod .expt ((a number) (b number))
   (expt a b))
 
+;;;; logiclas operators
+
+(defmethod .and ((a integer) (b integer))
+  (logand a b))
+
+(defmethod .nand ((a integer) (b integer))
+  (lognand a b))
+
+(defmethod .or ((a integer) (b integer))
+  (logior a b))
+
+(defmethod .nor ((a integer) (b integer))
+  (lognor a b))
+
+(defmethod .xor ((a integer) (b integer))
+  (logxor a b))
+
+;;; The one input argument functions
 
 (define-constant +ordinary-functions-number-to-number-map+ 
   '((.re . realpart)(.im . imagpart) (.abs . abs)
-    (.conj . conjugate)))
+    (.conj . conjugate)
+    (.not . lognot)))
+    
 
 (defmacro expand-num-num ()
   ;; TODO: optimize? why?
@@ -151,7 +171,9 @@
 		   (defmethod ,(car name) ((a number))
 		     (,(cdr name) 
 		       (if (integerp a) 
-			   (coerce a 'double-float)
+			   ;; Coerce input to double float to prevent integer input 
+			   ;; from becoming single-float
+			   (coerce a 'double-float) 
 			   a)))))
 	      +ordinary-functions-number-to-real-map+ )))
 

Modified: trunk/src/core/level0-interface.lisp
==============================================================================
--- trunk/src/core/level0-interface.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/core/level0-interface.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -195,3 +195,22 @@
 (defgeneric .gamma (x)
   (:documentation "The gamma function : gamma(x)"))
 
+;;; logical operations
+
+(defgeneric .not (a)
+  (:documentation "The logical .not operation."))
+
+(defgeneric .and (a b)
+  (:documentation "The logical and operation."))
+
+(defgeneric .nand (a b)
+  (:documentation "The logical nand operation."))
+
+(defgeneric .or (a b)
+  (:documentation "The logical or operation."))
+
+(defgeneric .nor (a b)
+  (:documentation "The logical nor operation."))
+
+(defgeneric .xor (a b)
+  (:documentation "The logical xor operation."))
\ No newline at end of file

Modified: trunk/src/matrix1/level1-classes.lisp
==============================================================================
--- trunk/src/matrix1/level1-classes.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/matrix1/level1-classes.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -65,76 +65,9 @@
 		     (find-structure-class structure)
 		     (find-implementation-class implementation)))
 
-;;; The matrix element tells the element type of the matrix
-
-(defgeneric find-element-mixin (spec))
 
-(defclass element-base () 
-  ((element-type :allocation :class 
-		 :initform t 
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-base
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :any
-		      :reader element-type-spec)))
-   
-
-(defclass element-number (element-base) 
-  ((element-type :allocation :class 
-		 :initform 'number 
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-number
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :number
-		      :reader element-type-spec)))
-
-(defclass element-complex (element-number) 
-  ((element-type :allocation :class 
-		 :initform 'complex 
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-complex
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :complex
-		      :reader element-type-spec)))
-
-(defclass element-complex-double-float (element-complex) 
-  ((element-type :allocation :class 
-		 :initform '(complex double-float) 
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-complex-double-float
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :z
-		      :reader element-type-spec)))
-
-(defclass element-real (element-number) 
-  ((element-type :allocation :class
-		 :initform 'real
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-real
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :real
-		      :reader element-type-spec)))
-
-(defclass element-double-float (element-real) 
-  ((element-type :allocation :class
-		 :initform 'double-float
-		 :reader element-type)
-   (element-type-class-name :allocation :class 
-			    :initform 'element-double-float
-			    :reader element-type-class-name)
-   (element-type-spec :allocation :class 
-		      :initform :d
-		      :reader element-type-spec)))
+;;; The matrix element tells the element type of the matrix
+;; TOOD remove (defgeneric find-element-mixin (spec))
 
 ;;; The implementation is a mixin intended to solve conflicts 
 ;;; when there is one foreign and one native implementation
@@ -241,6 +174,14 @@
 (defmethod find-element-type-class ((spec (eql :z)))
   (find-class 'element-complex-double-float))
 
+(defmethod find-element-type-class ((spec (eql :ub8)))
+  (find-class 'element-ub8))
+
+(defmethod find-element-type-class ((spec (eql :sb8)))
+  (find-class 'element-sb8))
+
+
+
 (defmethod find-structure-class ((spec (eql :ge)))
   (find-class 'structure-general))
 

Modified: trunk/src/util/level1-util.lisp
==============================================================================
--- trunk/src/util/level1-util.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/util/level1-util.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -82,4 +82,18 @@
 	   (setf (aref store i) rv)))
     store))
 
+;;; The unsigend-byte 8 store
 
+(defun allocate-ub8-store (size &optional (initial-element 0))
+  (let ((x (coerce initial-element '(unsigned-byte 8))))
+    (declare (type (unsigned-byte 8) x)
+	     (type type-blas-idx size))
+    ;; Stupid efficiency hack for SBCL. Allocations of arrays with zeros 
+    ;; is significantly faster than others!
+    (if (= x 0) 	
+	(make-array size
+		    :element-type '(unsigned-byte 8)
+		    :initial-element 0)	
+	(make-array size
+		    :element-type '(unsigned-byte 8)
+		    :initial-element x))))
\ No newline at end of file

Modified: trunk/src/util/ref.lisp
==============================================================================
--- trunk/src/util/ref.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/util/ref.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -89,6 +89,8 @@
 	value)
   value)
 
+;;; The complex store
+
 (declaim (inline ref-blas-complex-store (setf ref-blas-complex-store)))
 
 (declaim (ftype (function 
@@ -209,3 +211,167 @@
     (setf (aref store idx) (realpart value)
 	  (aref store (1+ idx)) (imagpart value))
     value))
+
+
+;;;; The idx store
+
+(declaim (inline ref-idx-store (setf ref-idx-store)))
+
+(declaim 
+ (ftype (function (type-idx-store type-blas-idx type-blas-idx type-blas-idx)
+		  type-blas-idx)
+	ref-idx-store))
+
+(defun ref-idx-store (store row col rows)
+  "Matrix accessor for the UB1 store"
+  (aref (truly-the type-idx-store store)
+	(truly-the type-blas-idx 
+		   (column-major-idx (truly-the type-blas-idx row) 
+				     (truly-the type-blas-idx col)
+				     rows))))
+
+(declaim 
+ (ftype (function 
+	 (type-blas-idx type-idx-store type-blas-idx type-blas-idx type-blas-idx)
+	 type-blas-idx)
+	(setf ref-idx-store)))
+
+(defun (setf ref-idx-store) (value store row col rows)
+  (setf (aref (truly-the type-idx-store store)
+	      (truly-the type-blas-idx 
+			 (column-major-idx (truly-the type-blas-idx row) 
+					   (truly-the type-blas-idx col)
+					   rows)))
+	value)
+  value)
+
+
+;;;; The UB1 store
+
+(declaim (inline ref-ub1-store (setf ref-ub1-store)))
+
+(declaim 
+ (ftype (function (type-ub1-store type-blas-idx type-blas-idx type-blas-idx)
+		  (unsigned-byte 1))
+	ref-ub1-store))
+
+(defun ref-ub1-store (store row col rows)
+  "Matrix accessor for the UB1 store"
+  (aref (truly-the type-ub1-store store)
+	(truly-the type-blas-idx 
+		   (column-major-idx (truly-the type-blas-idx row) 
+				     (truly-the type-blas-idx col)
+				     rows))))
+
+(declaim 
+ (ftype (function 
+	 ((unsigned-byte 1) type-ub1-store type-blas-idx type-blas-idx type-blas-idx)
+	 (unsigned-byte 1))
+	(setf ref-ub1-store)))
+
+(defun (setf ref-ub1-store) (value store row col rows)
+  (setf (aref (truly-the type-ub1-store store)
+	      (truly-the type-blas-idx 
+			 (column-major-idx (truly-the type-blas-idx row) 
+					   (truly-the type-blas-idx col)
+					   rows)))
+	value)
+  value)
+
+
+;;;; The UB8 store
+
+(declaim (inline ref-ub8-store (setf ref-ub8-store)))
+
+(declaim 
+ (ftype (function (type-ub8-store type-blas-idx type-blas-idx type-blas-idx)
+		  (unsigned-byte 8))
+	ref-ub8-store))
+
+(defun ref-ub8-store (store row col rows)
+  "Matrix accessor for the UB8 store"
+  (aref (truly-the type-ub8-store store)
+	(truly-the type-blas-idx 
+		   (column-major-idx (truly-the type-blas-idx row) 
+				     (truly-the type-blas-idx col)
+				     rows))))
+
+(declaim 
+ (ftype (function 
+	 ((unsigned-byte 8) type-ub8-store type-blas-idx type-blas-idx type-blas-idx)
+	 (unsigned-byte 8))
+	(setf ref-ub8-store)))
+
+(defun (setf ref-ub8-store) (value store row col rows)
+  (setf (aref (truly-the type-ub8-store store)
+	      (truly-the type-blas-idx 
+			 (column-major-idx (truly-the type-blas-idx row) 
+					   (truly-the type-blas-idx col)
+					   rows)))
+	value)
+  value)
+
+;;;; The UB16 store
+
+(declaim (inline ref-ub16-store (setf ref-ub16-store)))
+
+(declaim 
+ (ftype (function (type-ub16-store type-blas-idx type-blas-idx type-blas-idx)
+		  (unsigned-byte 16))
+	ref-ub16-store))
+
+(defun ref-ub16-store (store row col rows)
+  "Matrix accessor for the UB16 store"
+  (aref (truly-the type-ub16-store store)
+	(truly-the type-blas-idx 
+		   (column-major-idx (truly-the type-blas-idx row) 
+				     (truly-the type-blas-idx col)
+				     rows))))
+
+(declaim 
+ (ftype (function 
+	 ((unsigned-byte 16) type-ub16-store type-blas-idx type-blas-idx type-blas-idx)
+	 (unsigned-byte 16))
+	(setf ref-ub16-store)))
+
+(defun (setf ref-ub16-store) (value store row col rows)
+  (setf (aref (truly-the type-ub16-store store)
+	      (truly-the type-blas-idx 
+			 (column-major-idx (truly-the type-blas-idx row) 
+					   (truly-the type-blas-idx col)
+					   rows)))
+	value)
+  value)
+
+;;;; The UB32 store
+
+(declaim (inline ref-ub32-store (setf ref-ub32-store)))
+
+(declaim 
+ (ftype (function (type-ub32-store type-blas-idx type-blas-idx type-blas-idx)
+		  (unsigned-byte 32))
+	ref-ub32-store))
+
+(defun ref-ub32-store (store row col rows)
+  "Matrix accessor for the UB32 store"
+  (aref (truly-the type-ub32-store store)
+	(truly-the type-blas-idx 
+		   (column-major-idx (truly-the type-blas-idx row) 
+				     (truly-the type-blas-idx col)
+				     rows))))
+
+(declaim 
+ (ftype (function 
+	 ((unsigned-byte 32) type-ub32-store type-blas-idx type-blas-idx type-blas-idx)
+	 (unsigned-byte 32))
+	(setf ref-ub32-store)))
+
+(defun (setf ref-ub32-store) (value store row col rows)
+  (setf (aref (truly-the type-ub32-store store)
+	      (truly-the type-blas-idx 
+			 (column-major-idx (truly-the type-blas-idx row) 
+					   (truly-the type-blas-idx col)
+					   rows)))
+	value)
+  value)
+

Modified: trunk/src/util/type.lisp
==============================================================================
--- trunk/src/util/type.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/util/type.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -41,3 +41,30 @@
 			'(MOD #xFFFFFFFFFFFFFFD))
 #-:sbcl (deftype type-blas-idx ()
 			'fixnum)
+
+(deftype type-idx-store ()
+  '(simple-array type-blas-idx (*)))
+
+(deftype type-ub1-store ()
+  '(simple-array (unsigned-byte 1) (*)))
+
+(deftype type-ub8-store ()
+  '(simple-array (unsigned-byte 8) (*)))
+
+(deftype type-ub16-store ()
+  '(simple-array (unsigned-byte 16) (*)))
+
+(deftype type-ub32-store ()
+  '(simple-array (unsigned-byte 32) (*)))
+
+(deftype type-sb8-store ()
+  '(simple-array (signed-byte 8) (*)))
+
+(deftype type-sb16-store ()
+  '(simple-array (signed-byte 16) (*)))
+
+(deftype type-sb32-store ()
+  '(simple-array (signed-byte 32) (*)))
+
+
+

Added: trunk/src/vector1/level1-element.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/src/vector1/level1-element.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -0,0 +1,179 @@
+;;; Lisplab, level1-element.lisp
+;;; Classes to help denoting element types
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; This program 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+(in-package :lisplab)
+
+(defclass element-base () 
+  ((element-type :allocation :class 
+		 :initform t 
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-base
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :any
+		      :reader element-type-spec)))
+   
+
+(defclass element-number (element-base) 
+  ((element-type :allocation :class 
+		 :initform 'number 
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-number
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :number
+		      :reader element-type-spec)))
+
+(defclass element-complex (element-number) 
+  ((element-type :allocation :class 
+		 :initform 'complex 
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-complex
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :complex
+		      :reader element-type-spec)))
+
+(defclass element-complex-double-float (element-complex) 
+  ((element-type :allocation :class 
+		 :initform '(complex double-float) 
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-complex-double-float
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :z
+		      :reader element-type-spec)))
+
+(defclass element-real (element-number) 
+  ((element-type :allocation :class
+		 :initform 'real
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-real
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :real
+		      :reader element-type-spec)))
+
+(defclass element-double-float (element-real) 
+  ((element-type :allocation :class
+		 :initform 'double-float
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-double-float
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :d
+		      :reader element-type-spec)))
+
+;;;; Finite integer types 
+
+(defclass element-idx (element-base) 
+  ((element-type :allocation :class
+		 :initform 'type-blas-idx
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-idx
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :idx
+		      :reader element-type-spec)))
+
+(defclass element-ub1 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(unsigned-byte 1)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-ub1
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :ub1
+		      :reader element-type-spec)))
+
+(defclass element-ub8 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(unsigned-byte 8)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-ub8
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :ub8
+		      :reader element-type-spec)))
+
+(defclass element-sb8 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(signed-byte 8)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-sb8
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :sb8
+		      :reader element-type-spec)))
+
+(defclass element-ub16 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(unsigned-byte 16)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-ub16
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :ub16
+		      :reader element-type-spec)))
+
+(defclass element-sb16 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(signed-byte 16)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-sb16
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :sb16
+		      :reader element-type-spec)))
+
+(defclass element-ub32 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(unsigned-byte 32)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-ub32
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :ub32
+		      :reader element-type-spec)))
+
+(defclass element-sb32 (element-base) 
+  ((element-type :allocation :class
+		 :initform '(signed-byte 32)
+		 :reader element-type)
+   (element-type-class-name :allocation :class 
+			    :initform 'element-sb32
+			    :reader element-type-class-name)
+   (element-type-spec :allocation :class 
+		      :initform :sb32
+		      :reader element-type-spec)))
+
+

Modified: trunk/src/vector1/level1-vector.lisp
==============================================================================
--- trunk/src/vector1/level1-vector.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/vector1/level1-vector.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -97,4 +97,5 @@
     (declare (type (complex double-float) val2))
     (setf (ref-blas-complex-store (slot-value vector 'store) i 0 1)
 	  val2)
-    val2))
\ No newline at end of file
+    val2))
+

Modified: trunk/src/vector2/vector2-function.lisp
==============================================================================
--- trunk/src/vector2/vector2-function.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/vector2/vector2-function.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -30,7 +30,7 @@
       .sinh .cosh .tanh
       .asinh .acosh .atanh 
       .re .im .abs .sgn
-      .exp .ln .sqr .sqrt .conj ))
+      .exp .ln .sqr .sqrt .conj .not))
 
 (defmacro expand-each-element-ordinary-functions ()
   (cons 'progn

Modified: trunk/src/vector2/vector2-operator.lisp
==============================================================================
--- trunk/src/vector2/vector2-operator.lisp	Sat Mar 24 12:32:20 2012	(r211)
+++ trunk/src/vector2/vector2-operator.lisp	Fri Mar 30 10:52:30 2012	(r212)
@@ -134,3 +134,9 @@
 (def-each-element-operator .max)
 (def-each-element-operator .min)
 
+(def-each-element-operator .and)
+(def-each-element-operator .nand)
+(def-each-element-operator .or)
+(def-each-element-operator .nor)
+(def-each-element-operator .xor)
+