oct-class.lisp 6.34 KB
Newer Older
Raymond Toy's avatar
Raymond Toy committed
1
2
;;;; -*- Mode: lisp -*-
;;;;
3
;;;; Copyright (c) 2007, 2008, 2011 Raymond Toy
Raymond Toy's avatar
Raymond Toy committed
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
;;;;
;;;; Permission is hereby granted, free of charge, to any person
;;;; obtaining a copy of this software and associated documentation
;;;; files (the "Software"), to deal in the Software without
;;;; restriction, including without limitation the rights to use,
;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;;;; copies of the Software, and to permit persons to whom the
;;;; Software is furnished to do so, subject to the following
;;;; conditions:
;;;;
;;;; The above copyright notice and this permission notice shall be
;;;; included in all copies or substantial portions of the Software.
;;;;
;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;;;; OTHER DEALINGS IN THE SOFTWARE.

Raymond Toy's avatar
Raymond Toy committed
26
(in-package #:oct)
toy's avatar
toy committed
27

28
29
30
31
(define-symbol-macro * cl:*)
(define-symbol-macro - cl:-)
(define-symbol-macro / cl:/)

toy's avatar
toy committed
32
(defclass qd-real ()
toy's avatar
toy committed
33
34
35
  ((qd :initform +qd-zero+
       :reader qd-value
       :initarg :value
Raymond Toy's avatar
Raymond Toy committed
36
37
       :type %quad-double))
  (:documentation "QUAD-DOUBLE real number"))
toy's avatar
toy committed
38

toy's avatar
toy committed
39
40
41
42
43
44
45
46
(defclass qd-complex ()
  ((real :initform +qd-zero+
	 :reader qd-real
	 :initarg :real
	 :type %quad-double)
   (imag :initform +qd-zero+
	 :reader qd-imag
	 :initarg :imag
Raymond Toy's avatar
Raymond Toy committed
47
48
	 :type %quad-double))
  (:documentation "Complex number consisting of QUAD-DOUBLE components"))
toy's avatar
toy committed
49
50

(defmethod print-object ((qd qd-real) stream)
51
  (format stream "~/octi::qd-format/" (qd-value qd)))
52

53
(defmethod make-qd ((x cl:float))
toy's avatar
toy committed
54
  (make-instance 'qd-real :value (make-qd-d (float x 1d0))))
toy's avatar
toy committed
55

toy's avatar
toy committed
56
57
(defmethod make-qd ((x qd-real))
  (make-instance 'qd-real :value (qd-value x)))
toy's avatar
toy committed
58

toy's avatar
toy committed
59
(defmethod print-object ((qd qd-complex) stream)
60
  (format stream "#q(~<~/octi::qd-format/ ~/octi::qd-format/~:@>)"
61
62
	  (list (qd-real qd)
		(qd-imag qd))))
63

64
#+(or)
toy's avatar
toy committed
65
66
67
68
69
70
71
(defmethod print-object ((qd qd-complex) stream)
  (write-string "#q(" stream)
  (print-qd (qd-real qd) stream)
  (write-char #\space stream)
  (print-qd (qd-imag qd) stream)
  (write-string ")" stream))

toy's avatar
toy committed
72
73
(defmethod qd-value ((x real))
  (make-qd-d (float x 1d0)))
toy's avatar
toy committed
74
75
76
77
78

(defmethod make-load-form ((qd qd-real) &optional environment)
  (declare (ignore environment))
  `(make-instance ',(class-of qd)
		  :value ',(qd-value qd)))
toy's avatar
toy committed
79
80
81
82
83
84

(defmethod make-load-form ((qd qd-complex) &optional environment)
  (declare (ignore environment))
  `(make-instance ',(class-of qd)
		  :real ',(qd-value (realpart qd))
		  :imag ',(qd-value (imagpart qd))))
85
86
87

(defmethod describe-object ((q qd-real) stream)
  (multiple-value-bind (q0 q1 q2 q3)
toy's avatar
toy committed
88
      (qd-parts (qd-value q))
89
    (format stream "~&~S is a QD-REAL with components ~
90
91
                    ~%  ~A, ~A, ~A, ~A~%"
	    q q0 q1 q2 q3)))
toy's avatar
toy committed
92

93
94
95
96
97
98
99
(defmethod describe-object ((q qd-complex) stream)
  (format stream "~&~S is a QD-COMPLEX" q)
  (format stream "~&It has components~&REAL: ")
  (describe (realpart q))
  (format stream "~&IMAG: ")
  (describe (imagpart q)))

toy's avatar
toy committed
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

(defgeneric add1 (a)
  (:documentation "Add 1"))

(defgeneric sub1 (a)
  (:documentation "Subtract 1"))


(defgeneric two-arg-+ (a b)
  (:documentation "A + B"))

(defgeneric two-arg-- (a b)
  (:documentation "A - B"))

(defgeneric two-arg-* (a b)
  (:documentation "A * B"))

(defgeneric two-arg-/ (a b)
  (:documentation "A / B"))

(defgeneric two-arg-< (a b)
  (:documentation "A < B"))

(defgeneric two-arg-> (a b)
  (:documentation "A > B"))

(defgeneric two-arg-<= (a b)
  (:documentation "A <= B"))

(defgeneric two-arg->= (a b)
  (:documentation "A >= B"))

(defgeneric two-arg-= (a b)
  (:documentation "A = B?"))


(defgeneric unary-minus (a)
  (:documentation "-A"))

(defgeneric unary-divide (a)
  (:documentation "1 / A"))

(defgeneric qzerop (a)
  (:documentation "A = 0?"))

(defgeneric qplusp (a)
  (:documentation "A > 0"))

(defgeneric qminusp (a)
  (:documentation "A < 0"))

(defgeneric qfloat (x ftype)
  (:documentation "Convert X to a float of the same type a FLOAT"))

(defgeneric qrealpart (x)
  (:documentation "The real part of X"))

(defgeneric qimagpart (x)
  (:documentation "The imaginary part of X"))

(defgeneric qconjugate (z)
  (:documentation "The complex conjugate of Z"))

(defgeneric qscale-float (x n)
  (:documentation "Multiply the float X by 2^N"))

Raymond Toy's avatar
Raymond Toy committed
166
(defgeneric abs (x)
toy's avatar
toy committed
167
168
  (:documentation "Absolute value of X"))

Raymond Toy's avatar
Raymond Toy committed
169
(defgeneric exp (x)
toy's avatar
toy committed
170
171
  (:documentation "Exponential of X"))

Raymond Toy's avatar
Raymond Toy committed
172
(defgeneric sin (x)
toy's avatar
toy committed
173
174
  (:documentation "Sine of X"))

Raymond Toy's avatar
Raymond Toy committed
175
(defgeneric cos (x)
toy's avatar
toy committed
176
177
  (:documentation "Cosine of X"))

Raymond Toy's avatar
Raymond Toy committed
178
(defgeneric tan (x)
toy's avatar
toy committed
179
180
  (:documentation "Tangent of X"))

Raymond Toy's avatar
Raymond Toy committed
181
(defgeneric sinh (x)
toy's avatar
toy committed
182
183
  (:documentation "Hyperbolic sine of X"))

Raymond Toy's avatar
Raymond Toy committed
184
(defgeneric cosh (x)
toy's avatar
toy committed
185
186
  (:documentation "Hyperbolic cosine of X"))

Raymond Toy's avatar
Raymond Toy committed
187
(defgeneric tanh (x)
toy's avatar
toy committed
188
189
  (:documentation "Hyperbolic tangent of X"))

Raymond Toy's avatar
Raymond Toy committed
190
(defgeneric sqrt (x)
toy's avatar
toy committed
191
192
  (:documentation "Square root of X"))

Raymond Toy's avatar
Raymond Toy committed
193
(defgeneric log (a &optional b)
toy's avatar
toy committed
194
195
196
197
198
  (:documentation "Log of A base B.  If B not given, then natural log"))

(defgeneric log1p (x)
  (:documentation "log(1+x)"))

Raymond Toy's avatar
Raymond Toy committed
199
(defgeneric atan (y &optional x)
toy's avatar
toy committed
200
201
202
203
204
205
  (:documentation "If X not given, atan(y).  If X is given, atan(y/x), taking
 the quadrant into account"))

(defgeneric qexpt (x y)
  (:documentation "X^Y"))

206
207
(defgeneric qcomplex (x y)
  (:documentation "Create a complex number with components X and Y."))
toy's avatar
toy committed
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

(defgeneric qinteger-decode-float (f)
  (:documentation "integer-decode-float"))

(defgeneric qdecode-float (f)
  (:documentation "decode-float"))

(defgeneric qfloor (x &optional y))

(defgeneric qffloor (x &optional y))

(defgeneric %unary-round (x))

(defgeneric qfloat-sign (a &optional b)
  (:documentation "Transfer sign of A to B.  If B not given, assume 1"))

Raymond Toy's avatar
Raymond Toy committed
224
(defgeneric asin (x)
toy's avatar
toy committed
225
226
  (:documentation "Inverse sine of X"))

Raymond Toy's avatar
Raymond Toy committed
227
(defgeneric acos (x)
toy's avatar
toy committed
228
229
  (:documentation "Inverse cosine of X"))

Raymond Toy's avatar
Raymond Toy committed
230
(defgeneric acosh (x)
toy's avatar
toy committed
231
232
  (:documentation "Inverse hyperbolic cosine of X"))

Raymond Toy's avatar
Raymond Toy committed
233
(defgeneric atanh (x)
toy's avatar
toy committed
234
235
  (:documentation "Inverse hyperbolic tangent of X"))

Raymond Toy's avatar
Raymond Toy committed
236
(defgeneric cis (x)
toy's avatar
toy committed
237
238
  (:documentation "(complex (cos x) (sin x))"))

Raymond Toy's avatar
Raymond Toy committed
239
(defgeneric phase (x)
toy's avatar
toy committed
240
  (:documentation "Phase of X"))
241
242
243
244
245
246
247

(defgeneric coerce (x type)
  (:documentation "COERCE"))

(defgeneric random (x &optional state)
  (:documentation "RANDOM"))