[lisplab-cvs] r8 - src

Jørn Inge Vestgården jivestgarden at common-lisp.net
Sun Mar 1 19:27:45 UTC 2009


Author: jivestgarden
Date: Sun Mar  1 19:27:44 2009
New Revision: 8

Log:
Bufix and example

Added:
   example.lisp
Modified:
   src/level1-blas-complex.lisp

Added: example.lisp
==============================================================================
--- (empty file)
+++ example.lisp	Sun Mar  1 19:27:44 2009
@@ -0,0 +1,57 @@
+;;; A simple demonstration of how to use lisplab
+
+(in-package :ll)
+
+;;; 19 ways to create a matrix
+(defparameter *test-matrices* 
+  (list 
+
+   ;; Setting of individual elements
+   #2a((1 4) (-2 3))
+   (rmat (0 4 -2) (1 3 -5) (-2 4 0))
+   (cmat (0 #C(0 2) -2) (1 3 -5) (-2 %i 0))  
+   (funmat 4 4 (i j) (if (= i j) 1 0))
+   (rrow 2 4 2)
+   (rcol 2 3 1)
+   (crow 2 %i 1)
+   (ccol 2 %i 1)
+
+   ;; Setting of structure
+   (make-array '(3 4) :element-type 'double-float)
+   (rnew 1 3 5)
+
+   ; (cnew %i 2 5)
+   (new 'array '(3 5) t 4)
+   (new 'blas-real '(3 5) t 4)
+   (new 'blas-complex '(3 5) t 4)
+
+   ;; From another matrix
+   (copy #2a((1 4) (-2 3)))
+   (create #2a((1 4) (-2 3)))
+   (convert '((3 2 4) (1 4 2)) 'array)
+   (convert (funmat 3 3 (i j) (random 1.0)) 'blas-real)
+   (mmap 'blas-real #'random (rnew 1 3 3))
+   (.+ 3 (rmat (2 3) (-2 9)))))
+
+(mapcar (lambda (x) (mref x 0 0)) *test-matrices*)
+
+(mapcar (lambda (x) (vref x 2)) *test-matrices*)
+
+;; Arithmetics 
+
+(let ((a (rmat (0 4 -2) (1 3 -5) (-2 4 0)))
+      (b (cmat (0 #C(0 2) -2) (1 3 -5) (-2 %i 0))))  
+  (.+ (.* 3 a) b))
+
+;; Infix arithmetics 
+
+(let ((a (rmat (0 4 -2) (1 3 -5) (-2 4 0)))
+      (b (cmat (0 #C(0 2) -2) (1 3 -5) (-2 %i 0))))  
+  (w/infix 3 .* a .+ b))
+
+
+;; Matrix inversion
+
+(minv #2a((0 4 -2) (1 3 -5) (-2 4 0)))
+
+(minv (rmat (0 4 -2) (1 3 -5) (-2 4 0)))

Modified: src/level1-blas-complex.lisp
==============================================================================
--- src/level1-blas-complex.lisp	(original)
+++ src/level1-blas-complex.lisp	Sun Mar  1 19:27:44 2009
@@ -68,13 +68,20 @@
   (declare (ignore type))
   (unless (consp dim) (setf dim (list dim 1)))
   (unless value (setf value 0.0))
-  (let ((rows (car dim))
-	(cols (if (cdr dim) (cadr dim) 1)))
+  (let* ((rows (car dim))
+	 (cols (if (cdr dim) (cadr dim) 1))
+	 (size (* rows cols))
+	 (2size (* 2 size))
+	 (rv (coerce (realpart value) 'double-float))
+	 (iv (coerce (imagpart value) 'double-float))
+	 (store (allocate-real-store 2size iv)))
+    (loop for i from 0 below 2size by 2 do
+	 (setf (aref store i) rv))
     (make-instance 'blas-complex
-		   :store (allocate-real-store (* 2 (* rows cols)) value)
+		   :store store
 		   :rows rows
 		   :cols cols
-		   :size (* rows cols))))
+		   :size size)))
 
 (defmethod mref ((matrix blas-complex) row col)
   (ref-blas-complex-store (store matrix) 




More information about the lisplab-cvs mailing list