[lisplab-cvs] r17 - shared/slatec src/core src/specfunc system
Jørn Inge Vestgården
jivestgarden at common-lisp.net
Sun May 10 18:59:06 UTC 2009
Author: jivestgarden
Date: Sun May 10 14:59:06 2009
New Revision: 17
Log:
added more functions for numbers
Added:
src/core/level0-functions.lisp
Modified:
shared/slatec/slatec.lisp
src/core/level0-generic.lisp
src/core/level0-interface.lisp
src/specfunc/level0-specfunc.lisp
system/lisplab.asd
Modified: shared/slatec/slatec.lisp
==============================================================================
--- shared/slatec/slatec.lisp (original)
+++ shared/slatec/slatec.lisp Sun May 10 14:59:06 2009
@@ -19,6 +19,9 @@
;; Bessel function: H
#:zbesh
+
+ ;; Gamma function
+ #:dgamma
;; Airy functions
#:dai #:zairy #:djairy #:dbi #:zbiry #:dyairy
Added: src/core/level0-functions.lisp
==============================================================================
--- (empty file)
+++ src/core/level0-functions.lisp Sun May 10 14:59:06 2009
@@ -0,0 +1,93 @@
+;;; Lisplab, level0-functions.lisp
+
+;;; 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)
+
+(defmethod .abs ((a number))
+ (abs a))
+
+(defmethod .realpart ((a number))
+ (realpart a))
+
+(defmethod .imagpart ((a number))
+ (imagpart a))
+
+(defmethod .= ((a number) (b number) &optional (accuracy))
+ (if accuracy
+ (< (abs (- a b)) accuracy)
+ (= a b)))
+
+(defmethod ./= ((a number) (b number) &optional (accuracy))
+ (apply '.= a b accuracy))
+
+(defmethod .< ((a number) (b number))
+ (< a b))
+
+(defmethod .<= ((a number) (b number))
+ (<= a b))
+
+(defmethod .> ((a number) (b number))
+ (> a b))
+
+(defmethod .>= ((a number) (b number))
+ (>= a b))
+
+(defmethod .add ((a number) (b number))
+ (+ a b))
+
+(defmethod .mul ((a number) (b number))
+ (* a b))
+
+(defmethod .div ((a number) (b number))
+ (/ a b))
+
+(defmethod .sub ((a number) (b number))
+ (- a b))
+
+(defmethod .expt ((a number) (b number))
+ (expt a b))
+
+(defmethod .sin ((x number))
+ (sin x))
+
+(defmethod .cos ((x number))
+ (cos x))
+
+(defmethod .tan ((x number))
+ (tan x))
+
+(defmethod .log ((x number) &optional (base nil))
+ (if base
+ (log x base)
+ (log x)))
+
+(defmethod .exp ((x number))
+ (exp x))
+
+(defmethod .sinh ((x number))
+ (sinh x))
+
+(defmethod .cosh ((x number))
+ (cosh x))
+
+(defmethod .tanh ((x number))
+ (tanh x))
+
+
+
+
Modified: src/core/level0-generic.lisp
==============================================================================
--- src/core/level0-generic.lisp (original)
+++ src/core/level0-generic.lisp Sun May 10 14:59:06 2009
@@ -50,51 +50,5 @@
;; Hm this is dagenrous if someone forgets to overload copy.
a)
-;; Todo move such things to another file
-
(defmethod scalar? ((a number))
- t)
-
-(defmethod .abs ((a number))
- (abs a))
-
-(defmethod .realpart ((a number))
- (realpart a))
-
-(defmethod .imagpart ((a number))
- (imagpart a))
-
-(defmethod .= ((a number) (b number) &optional (accuracy))
- (if accuracy
- (< (abs (- a b)) accuracy)
- (= a b)))
-
-(defmethod ./= ((a number) (b number) &optional (accuracy))
- (apply '.= a b accuracy))
-
-(defmethod .< ((a number) (b number))
- (< a b))
-
-(defmethod .<= ((a number) (b number))
- (<= a b))
-
-(defmethod .> ((a number) (b number))
- (> a b))
-
-(defmethod .>= ((a number) (b number))
- (>= a b))
-
-(defmethod .add ((a number) (b number))
- (+ a b))
-
-(defmethod .mul ((a number) (b number))
- (* a b))
-
-(defmethod .div ((a number) (b number))
- (/ a b))
-
-(defmethod .sub ((a number) (b number))
- (- a b))
-
-(defmethod .expt ((a number) (b number))
- (expt a b))
+ t) ;; Is this right?
Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp (original)
+++ src/core/level0-interface.lisp Sun May 10 14:59:06 2009
@@ -28,7 +28,15 @@
.mul mul!
.div .div!
.sub .sub!
- .expt .expt!))
+ .expt .expt!
+
+ .sin .cos .tan
+ .sinh .cosh .tanh
+ .log .exp
+ .Ai
+ .besj .besy .besi .besk .besh1 .besh2
+ .erf .erfc
+ .gamma))
(defgeneric copy (a)
(:documentation "Copies the elements and structure, but ignore
@@ -92,21 +100,63 @@
(defgeneric .expt! (a b))
-(defgeneric .Ai (x))
-(defgeneric .besj (n x))
+;;; Ordinary functions
+
+(defgeneric .sin (x)
+ (:documentation "Sine function : sin(x)."))
+
+(defgeneric .cos (x)
+ (:documentation "Cosine function : cos(x)."))
+
+(defgeneric .tan (x)
+ (:documentation "Tangent function : tan(x)."))
+
+(defgeneric .log (x &optional base)
+ (:documentation "Logarithm function"))
+
+(defgeneric .exp (x)
+ (:documentation "Exponential function : exp(x)."))
+
+(defgeneric .sinh (x)
+ (:documentation "Hyperbolic sine function : sinh(x)."))
+
+(defgeneric .cosh (x)
+ (:documentation "Hyperbolic cosine function : cosh(x)."))
+
+(defgeneric .tanh (x)
+ (:documentation "Hyperbolic tangent function : tanh(x)."))
+
+
+;;; Special functions
+
+(defgeneric .Ai (x) ;; TODO: implement this bastard
+ )
+
+(defgeneric .besj (n x)
+ (:documentation "Bessel functions of the first kind : J_n(x)."))
+
+(defgeneric .besy (n x)
+ (:documentation "The Neumann function. Bessel functions of the second kind : Y_n(x)."))
-(defgeneric .besy (n x))
+(defgeneric .besi (n x)
+ (:documentation "Modified Bessel functions : I_n(x)."))
-(defgeneric .besi (n x))
+(defgeneric .besk (n x)
+ (:documentation "Modified Bessel functions : K_n(x)."))
-(defgeneric .besk (n x))
+(defgeneric .besh1 (n x)
+ (:documentation "Hankel function 1. Bessel functions of the third kind : H^(1)_n(x)."))
-(defgeneric .besh (n x))
+(defgeneric .besh2 (n x)
+ (:documentation "Hankel function 2. Bessel functions of the third kind : H^(2)_n(x)."))
-(defgeneric .erf (x))
+(defgeneric .erf (x)
+ (:documentation "The error function : erf(x)"))
-(defgeneric .erfc (x))
+(defgeneric .erfc (x)
+ (:documentation "The complementary error function : erfc(x)"))
-(defgeneric .gamma (x))
+(defgeneric .gamma (x)
+ (:documentation "The gamma function : gamma(x)"))
Modified: src/specfunc/level0-specfunc.lisp
==============================================================================
--- src/specfunc/level0-specfunc.lisp (original)
+++ src/specfunc/level0-specfunc.lisp Sun May 10 14:59:06 2009
@@ -27,6 +27,7 @@
(make-array n :element-type 'double-float))
(defmethod .besj (n (x number))
+ "f2cl slatec based implementation"
;; Bessel J function, for n >=0, real and complex numbers.
;; TODO: what about negaive n and complex n?
(typecase x
@@ -45,6 +46,7 @@
(aref y 0))))))))
(defmethod .besy (n (x number))
+ "f2cl slatec based implementation"
;; Bessel Y function (Neumann function), for n >=0, x>0, real and complex numbers.
;; TODO: what about negaive n, negative x and complex n?
(typecase x
@@ -63,23 +65,88 @@
(t (let ((y (dvec 1)))
(slatec:dbesy x (to-df n) 1 y)
(aref y 0))))))))
-
-
+(defmethod .besi (n (x number))
+ "f2cl slatec based implementation"
+ ;; Bessel I function, for n >=0, x>0, real and complex numbers.
+ ;; TODO: what about negaive n, negative x and complex n?
+ (typecase x
+ (complex (let ((rx (to-df (realpart x)))
+ (cx (to-df (imagpart x)))
+ (ry (dvec 1))
+ (cy (dvec 1)))
+ (slatec:zbesi rx cx (to-df n) 1 1 ry cy 0 0)
+ (complex (aref ry 0) (aref cy 0))))
+ (t (let ((x (to-df x)))
+ (case n
+ (0 (slatec:dbesi0 x))
+ (1 (slatec:dbesi1 x))
+ (t (let ((y (dvec 1)))
+ (slatec:dbesi x (to-df n) 1 1 y 0)
+ (aref y 0))))))))
+(defmethod .besk (n (x number))
+ "f2cl slatec based implementation"
+ ;; Bessel K function, for n >=0, x>0, real and complex numbers.
+ ;; TODO: what about negaive n, negative x and complex n?
+ (typecase x
+ (complex (let ((rx (to-df (realpart x)))
+ (cx (to-df (imagpart x)))
+ (ry (dvec 1))
+ (cy (dvec 1)))
+ (slatec:zbesk rx cx (to-df n) 1 1 ry cy 0 0)
+ (complex (aref ry 0) (aref cy 0))))
+ (t (let ((x (to-df x)))
+ (case n
+ (0 (slatec:dbesk0 x))
+ (1 (slatec:dbesk1 x))
+ (t (let ((y (dvec 1)))
+ (slatec:dbesk x (to-df n) 1 1 y 0)
+ (aref y 0))))))))
-#|
+(defmethod .besh1 (n (x number))
+ "f2cl slatec based implementation"
+ ;; Bessel H1 function, for n >=0, x>0, real and complex numbers.
+ ;; TODO: what about negaive n, negative x and complex n?
+ (let ((rx (to-df (realpart x)))
+ (cx (to-df (imagpart x)))
+ (ry (dvec 1))
+ (cy (dvec 1)))
+ (slatec:zbesh rx cx (to-df n) 1 1 1 ry cy 0 0 )
+ (complex (aref ry 0) (aref cy 0))))
+
+(defmethod .besh2 (n (x number))
+ "f2cl slatec based implementation"
+ ;; Bessel H2 function, for n >=0, x>0, real and complex numbers.
+ ;; TODO: what about negaive n, negative x and complex n?
+ (let ((rx (to-df (realpart x)))
+ (cx (to-df (imagpart x)))
+ (ry (dvec 1))
+ (cy (dvec 1)))
+ (slatec:zbesh rx cx (to-df n) 1 2 1 ry cy 0 0 )
+ (complex (aref ry 0) (aref cy 0))))
+
+(defmethod .erf ((x number))
+ "f2cl slatec based implementation"
+ (let ((x (to-df x)))
+ (slatec:derf x)))
+
+(defmethod .erfc ((x number))
+ "f2cl slatec based implementation"
+ (let ((x (to-df x)))
+ (slatec:derfc x)))
+
+(defmethod .gamma ((x number))
+ "f2cl slatec based implementation"
+ (let ((x (to-df x)))
+ (slatec:dgamma x)))
-(defgeneric .besy (n x))
-(defgeneric .besi (n x))
+#|
-(defgeneric .besk (n x))
-(defgeneric .besh (n x))
-(defgeneric .erf (x))
(defgeneric .erfc (x))
Modified: system/lisplab.asd
==============================================================================
--- system/lisplab.asd (original)
+++ system/lisplab.asd Sun May 10 14:59:06 2009
@@ -18,6 +18,7 @@
(:file "level0-const")
(:file "level0-interface")
(:file "level0-generic")
+ (:file "level0-functions")
(:file "level0-permutation")
(:file "level0-infpre")))
More information about the lisplab-cvs
mailing list