[lisplab-cvs] r67 - in src: core matrix
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Fri Jul 31 18:53:13 UTC 2009
Author: jivestgarden
Date: Fri Jul 31 14:53:10 2009
New Revision: 67
Log:
cleaned functions. Not tested
Modified:
src/core/level0-functions.lisp
src/core/level0-interface.lisp
src/matrix/level2-generic.lisp
src/matrix/level2-matrix-dge.lisp
src/matrix/level2-matrix-zge.lisp
Modified: src/core/level0-functions.lisp
==============================================================================
--- src/core/level0-functions.lisp (original)
+++ src/core/level0-functions.lisp Fri Jul 31 14:53:10 2009
@@ -1,4 +1,5 @@
;;; Lisplab, level0-functions.lisp
+;;; Contains ordinary functions and lisplab wrappers for common lisp functions.
;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
@@ -56,12 +57,6 @@
"Generlized expt. Reduces the arguments with .expt."
(reduce #'.expt args))
-(defmethod .max ((a number) (b number))
- (max a b))
-
-(defmethod .min ((a number) (b number))
- (min a b))
-
(defmethod .abs ((a number))
(abs a))
@@ -71,8 +66,11 @@
(defmethod .imagpart ((a number))
(imagpart a))
-(defmethod .conj ((a number))
- (conjugate a))
+(defmethod .max ((a number) (b number))
+ (max a b))
+
+(defmethod .min ((a number) (b number))
+ (min a b))
(defmethod .= ((a number) (b number) &optional (accuracy))
(if accuracy
@@ -94,6 +92,53 @@
(defmethod .>= ((a number) (b number))
(>= a b))
+(defmacro expand-on-numbers-lisplab-two-argument-functions-alist ()
+ ;; TODO: optimize? why?
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(defmethod ,(car name) ((a number) (b number))
+ (,(cdr name) a b)))
+ +lisplab-two-argument-functions-alist+)))
+
+(expand-on-numbers-lisplab-two-argument-functions-alist)
+
+#+why-did-I-do-this?(defmethod .expt ((a real) (b real))
+ (expt (to-df a) b))
+
+(defmacro expand-on-numbers-lisplab-one-argument-functions-alist ()
+ ;; TODO: optimize? why?
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(progn
+ (defmethod ,(car name) ((a number))
+ (,(cdr name) a))
+ (defmethod ,(car name) ((a real))
+ (,(cdr name) (to-df a)))))
+ +lisplab-one-argument-functions-alist+)))
+
+(expand-on-numbers-lisplab-one-argument-functions-alist)
+
+(defmethod .log ((x number) &optional (base nil))
+ (if base
+ (log x base)
+ (log x)))
+
+(defmethod .log ((x real) &optional (base nil))
+ (if base
+ (log (to-df x) base)
+ (log (to-df x))))
+
+(defmethod .sqr ((x number))
+ (* x x))
+
+(defmethod .sqr ((x real))
+ (let ((x (to-df x)))
+ (* x x)))
+
+
+#|
+
+
(defmethod .add ((a number) (b number))
(+ a b))
@@ -109,9 +154,12 @@
(defmethod .expt ((a number) (b number))
(expt a b))
+
(defmethod .expt ((a real) (b real))
(expt (to-df a) b))
+|#
+#|
(defmethod .sin ((x number))
(sin x))
@@ -145,28 +193,12 @@
(defmethod .atan ((x real))
(atan (to-df x)))
-(defmethod .log ((x number) &optional (base nil))
- (if base
- (log x base)
- (log x)))
-
-(defmethod .log ((x real) &optional (base nil))
- (if base
- (log (to-df x) base)
- (log (to-df x))))
-
(defmethod .exp ((x number))
(exp x))
(defmethod .exp ((x real))
(exp (to-df x)))
-(defmethod .sqr ((x number))
- (* x x))
-
-(defmethod .sqr ((x real))
- (let ((x (to-df x)))
- (* x x)))
(defmethod .sqrt ((x number))
(sqrt x))
@@ -210,6 +242,6 @@
(defmethod .atanh ((x real))
(atanh (to-df x)))
-
+|#
Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp (original)
+++ src/core/level0-interface.lisp Fri Jul 31 14:53:10 2009
@@ -43,6 +43,33 @@
.erf .erfc
.gamma))
+(define-constant +lisplab-one-argument-functions+
+ '(.sin .cos .tan .asin .acos .atan
+ .sinh .cosh .tanh .asinh .acosh .atanh
+ .exp .sqr .sqrt .conj)
+ ;; List of "nice" functions that output real to real, have one argument.
+ ;; Not part of the list: .log, .conj, .realpart, .imagpart and most special functions
+ "Functions functions that takes exactly one argument and preserve type.")
+
+(define-constant +lisplab-one-argument-functions-alist+
+ '((.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) (.sqrt . sqrt) (.conj . conjugate))
+ ;; List of "nice" functions that output real to real, have one argument,
+ ;; and a analogy in the Common Lisp package.
+ ;; Note part of the list: .log, .sq, and all special functions
+ "A map between lisplab and common lisp functions that take exactly one argument.")
+
+(define-constant +lisplab-two-argument-functions+
+ '(.add .sub .mul .div .expt)
+ "Functions functions that takes exactly one argument and preserve type.")
+
+(define-constant +lisplab-two-argument-functions-alist+
+ '((.add . +) (.sub . -) (.mul . *) (.div . /) (.expt . expt))
+ "A map between lisplab and common lisp functions that take exactly two arguments.")
+
(defgeneric scalar? (x)
(:documentation "A scalar is a object with ignored internal structure."))
Modified: src/matrix/level2-generic.lisp
==============================================================================
--- src/matrix/level2-generic.lisp (original)
+++ src/matrix/level2-generic.lisp Fri Jul 31 14:53:10 2009
@@ -255,6 +255,15 @@
(setf (vref ,a ,i) (,op (vref ,a ,i) (vref ,b ,i))))
,a)))))
+(defmacro expand-on-matrix-ge-lisplab-two-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(def-binary-op-matrix-ge ,(car name)))
+ +lisplab-two-argument-functions-alist+)))
+
+(expand-on-matrix-ge-lisplab-two-argument-functions-alist)
+
+#|
(def-binary-op-matrix-ge .add)
(def-binary-op-matrix-ge .mul)
@@ -264,6 +273,7 @@
(def-binary-op-matrix-ge .div)
(def-binary-op-matrix-ge .expt)
+|#
(defmacro each-element-function-matrix-ge (x form)
"Applies a form on each element of an matrix-ge."
@@ -276,6 +286,15 @@
,form)))
,y)))
+(defmacro expand-on-matrix-ge-lisplab-one-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(defmethod ,(car name) ((x matrix-ge))
+ (each-element-function-matrix-ge x (,(car name) x))))
+ +lisplab-one-argument-functions-alist+)))
+
+(expand-on-matrix-ge-lisplab-one-argument-functions-alist)
+
(defmethod .imagpart ((x matrix-ge))
@@ -287,6 +306,39 @@
(defmethod .abs ((x matrix-ge))
(each-element-function-matrix-ge x (.abs x)))
+
+(defmethod .log ((x matrix-ge) &optional base)
+ (each-element-function-matrix-ge x (.log x base)))
+
+(defmethod .sqr ((x matrix-ge))
+ (each-element-function-matrix-ge x (.sqr x)))
+
+
+;;; Bessel functions
+
+(defmethod .besj (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besj n x)))
+
+(defmethod .besy (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besy n x)))
+
+(defmethod .besi (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besi n x)))
+
+(defmethod .besk (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besk n x)))
+
+(defmethod .besh1 (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besh1 n x)))
+
+(defmethod .besh2 (n (x matrix-ge))
+ (each-element-function-matrix-ge x (.besh2 n x)))
+
+
+;;; TRASH
+
+#|
+
(defmethod .conj ((x matrix-ge))
(each-element-function-matrix-ge x (.conj x)))
@@ -314,39 +366,11 @@
;;; Logarithms and exponents
-(defmethod .log ((x matrix-ge) &optional base)
- (each-element-function-matrix-ge x (.log x base)))
-
(defmethod .exp ((x matrix-ge))
(each-element-function-matrix-ge x (.exp x)))
-(defmethod .sqr ((x matrix-ge))
- (each-element-function-matrix-ge x (.sqr x)))
(defmethod .sqrt ((x matrix-ge))
(each-element-function-matrix-ge x (.sqrt x)))
-
-;;; Bessel functions
-
-(defmethod .besj (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besj n x)))
-
-(defmethod .besy (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besy n x)))
-
-(defmethod .besi (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besi n x)))
-
-(defmethod .besk (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besk n x)))
-
-(defmethod .besh1 (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besh1 n x)))
-
-(defmethod .besh2 (n (x matrix-ge))
- (each-element-function-matrix-ge x (.besh2 n x)))
-
-
-;;; TRASH
-
+|#
Modified: src/matrix/level2-matrix-dge.lisp
==============================================================================
--- src/matrix/level2-matrix-dge.lisp (original)
+++ src/matrix/level2-matrix-dge.lisp Fri Jul 31 14:53:10 2009
@@ -61,9 +61,6 @@
(copy-contents a b #'abs)
b))
-(defmethod .conj ((a matrix-base-dge))
- (copy a))
-
(defmethod .some (pred (a matrix-base-dge) &rest args)
(let ((stores (mapcar #'matrix-store (cons a args))))
(apply #'some pred stores)))
@@ -114,19 +111,13 @@
(setf (aref ,store ,i) (,old (aref ,store ,i) (aref ,store2 ,i))))
,a)))))
-(def-binary-op-matrix-base-dge .add +)
-
-(def-binary-op-matrix-base-dge .mul *)
-
-(def-binary-op-matrix-base-dge .sub -)
+(defmacro expand-on-matrix-dge-lisplab-two-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(def-binary-op-matrix-base-dge ,(car name) ,(cdr name)))
+ +lisplab-two-argument-functions-alist+)))
-(def-binary-op-matrix-base-dge .div /)
-
-(def-binary-op-matrix-base-dge .expt expt)
-
-(def-binary-op-matrix-base-dge .max max)
-
-(def-binary-op-matrix-base-dge .min min)
+(expand-on-matrix-dge-lisplab-two-argument-functions-alist)
(defmacro each-matrix-element-df-to-df (x form)
"Applies a form on each element of an matrix-dge. The form must
@@ -144,6 +135,48 @@
,form)))
,x)))
+(defmacro expand-on-matrix-dge-lisplab-one-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(defmethod ,(car name) ((x matrix-base-dge))
+ (each-matrix-element-df-to-df x (,(cdr name) x))))
+ +lisplab-one-argument-functions-alist+)))
+
+(expand-on-matrix-dge-lisplab-one-argument-functions-alist)
+
+(defmethod .log ((x matrix-base-dge) &optional base)
+ (if base
+ (each-matrix-element-df-to-df x (log x base))
+ (each-matrix-element-df-to-df x (log x))))
+
+(defmethod .sqr ((x matrix-base-dge))
+ (each-matrix-element-df-to-df x (* x x)))
+
+;;; Other spacial functions
+
+(defmethod .erf ((x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.erf x)))
+
+(defmethod .erfc ((x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.erfc x)))
+
+(defmethod .gamma ((x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.gamma x)))
+
+;;; Bessel functions
+
+(defmethod .besj (n (x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.besj n x)))
+
+(defmethod .besy (n (x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.besy n x)))
+
+(defmethod .besi (n (x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.besi n x)))
+
+(defmethod .besk (n (x matrix-base-dge))
+ (each-matrix-element-df-to-df x (.besk n x)))
+
(defmacro each-matrix-element-df-to-complex-df (x form)
"Applies a form on each element of an matrix-dge. The form must
make complex output for real arguments. TODO optimize? Probably no need. The
@@ -158,8 +191,36 @@
(setf (vref ,b ,i) ,form)))
,b)))
-;;; Trignometric functions
+(defmethod .besh1 (n (x matrix-base-dge))
+ (each-matrix-element-df-to-complex-df x (.besh1 n x)))
+
+(defmethod .besh2 (n (x matrix-base-dge))
+ (each-matrix-element-df-to-complex-df x (.besh2 n x)))
+
+;;;;;;;;;;;;;;; TRASH
+
+#|
+(def-binary-op-matrix-base-dge .add +)
+
+(def-binary-op-matrix-base-dge .mul *)
+
+(def-binary-op-matrix-base-dge .sub -)
+
+(def-binary-op-matrix-base-dge .div /)
+
+(def-binary-op-matrix-base-dge .expt expt)
+
+(def-binary-op-matrix-base-dge .max max)
+
+(def-binary-op-matrix-base-dge .min min)
+
+|#
+
+
+
+#|
+;;; Trignometric functions
(defmethod .sin ((x matrix-base-dge))
(each-matrix-element-df-to-df x (sin x)))
@@ -198,50 +259,11 @@
(defmethod .atanh ((x matrix-base-dge))
(each-matrix-element-df-to-df x (atanh x)))
-;;; Logarithm and exponent
-
-(defmethod .log ((x matrix-base-dge) &optional base)
- (if base
- (each-matrix-element-df-to-df x (log x base))
- (each-matrix-element-df-to-df x (log x))))
-
(defmethod .exp ((x matrix-base-dge))
(each-matrix-element-df-to-df x (exp x)))
-(defmethod .sqr ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (* x x)))
-
(defmethod .sqrt ((x matrix-base-dge))
(each-matrix-element-df-to-df x (sqrt x)))
-;;; Bessel functions
-
-(defmethod .besj (n (x matrix-base-dge))
- (each-matrix-element-df-to-df x (.besj n x)))
-
-(defmethod .besy (n (x matrix-base-dge))
- (each-matrix-element-df-to-df x (.besy n x)))
-
-(defmethod .besi (n (x matrix-base-dge))
- (each-matrix-element-df-to-df x (.besi n x)))
-
-(defmethod .besk (n (x matrix-base-dge))
- (each-matrix-element-df-to-df x (.besk n x)))
-
-(defmethod .besh1 (n (x matrix-base-dge))
- (each-matrix-element-df-to-complex-df x (.besh1 n x)))
-
-(defmethod .besh2 (n (x matrix-base-dge))
- (each-matrix-element-df-to-complex-df x (.besh2 n x)))
-
-;;; Other spacial functions
-
-(defmethod .erf ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.erf x)))
-
-(defmethod .erfc ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.erfc x)))
-
-(defmethod .gamma ((x matrix-base-dge))
- (each-matrix-element-df-to-df x (.gamma x)))
+|#
Modified: src/matrix/level2-matrix-zge.lisp
==============================================================================
--- src/matrix/level2-matrix-zge.lisp (original)
+++ src/matrix/level2-matrix-zge.lisp Fri Jul 31 14:53:10 2009
@@ -61,7 +61,7 @@
(copy-contents a b #'abs)
b))
-(defmacro def-binary-op-blas-complex (new old)
+(defmacro def-binary-op-matrix-base-zge (new old)
;;; TODO speed up for real numbers. Is it worth the work?
(let ((a (gensym "a"))
(b (gensym "b"))
@@ -135,15 +135,13 @@
(ref-blas-complex-store ,store2 ,i 0 ,len))))
,b)))))
-(def-binary-op-blas-complex .add +)
-
-(def-binary-op-blas-complex .mul *)
-
-(def-binary-op-blas-complex .sub -)
-
-(def-binary-op-blas-complex .div /)
+(defmacro expand-on-matrix-zge-lisplab-two-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(def-binary-op-matrix-base-zge ,(car name) ,(cdr name)))
+ +lisplab-two-argument-functions-alist+)))
-(def-binary-op-blas-complex .expt expt)
+(expand-on-matrix-zge-lisplab-two-argument-functions-alist)
(defmacro each-element-function-matrix-base-zge (x form)
"Applies a form on each element of an matrix-base-zge."
@@ -158,6 +156,70 @@
,form)))
,y)))
+(defmacro expand-on-matrix-zge-lisplab-one-argument-functions-alist ()
+ (cons 'progn
+ (mapcar (lambda (name)
+ `(defmethod ,(car name) ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (,(cdr name) x))))
+ +lisplab-one-argument-functions-alist+)))
+
+(expand-on-matrix-zge-lisplab-one-argument-functions-alist)
+
+(defmethod .log ((x matrix-base-zge) &optional base)
+ (if base
+ (each-element-function-matrix-base-zge x (log x base))
+ (each-element-function-matrix-base-zge x (log x))))
+
+(defmethod .sqr ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (* x x)))
+
+;;; Bessel functions
+
+(defmethod .besj (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besj n x)))
+
+(defmethod .besy (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besy n x)))
+
+(defmethod .besi (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besi n x)))
+
+(defmethod .besk (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besk n x)))
+
+(defmethod .besh1 (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besh1 n x)))
+
+(defmethod .besh2 (n (x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (.besh2 n x)))
+
+
+
+;;; TRASH
+
+
+#|
+(def-binary-op-blas-complex .add +)
+
+(def-binary-op-blas-complex .mul *)
+
+(def-binary-op-blas-complex .sub -)
+
+(def-binary-op-blas-complex .div /)
+
+(def-binary-op-blas-complex .expt expt)
+|#
+
+
+#|
+(defmethod .exp ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (exp x)))
+
+(defmethod .sqrt ((x matrix-base-zge))
+ (each-element-function-matrix-base-zge x (sqrt x)))
+
+
+
(defmethod .conj ((x matrix-base-zge))
(each-element-function-matrix-base-zge x (conjugate x)))
@@ -202,37 +264,4 @@
(each-element-function-matrix-base-zge x (atanh x)))
;;; Logarithm and exponent
-
-(defmethod .log ((x matrix-base-zge) &optional base)
- (if base
- (each-element-function-matrix-base-zge x (log x base))
- (each-element-function-matrix-base-zge x (log x))))
-
-(defmethod .exp ((x matrix-base-zge))
- (each-element-function-matrix-base-zge x (exp x)))
-
-(defmethod .sqr ((x matrix-base-zge))
- (each-element-function-matrix-base-zge x (* x x)))
-
-(defmethod .sqrt ((x matrix-base-zge))
- (each-element-function-matrix-base-zge x (sqrt x)))
-
-;;; Bessel functions
-
-(defmethod .besj (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besj n x)))
-
-(defmethod .besy (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besy n x)))
-
-(defmethod .besi (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besi n x)))
-
-(defmethod .besk (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besk n x)))
-
-(defmethod .besh1 (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besh1 n x)))
-
-(defmethod .besh2 (n (x matrix-base-zge))
- (each-element-function-matrix-base-zge x (.besh2 n x)))
+|#
\ No newline at end of file
More information about the lisplab-cvs
mailing list