/[cl-gsl]/cl-gsl/test/test-poly.lisp
ViewVC logotype

Contents of /cl-gsl/test/test-poly.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sun Mar 13 00:52:02 2005 UTC (9 years, 1 month ago) by edenny
Branch: MAIN
CVS Tags: HEAD
Initial checkin.
1 ;;;; -*- Mode: Lisp; Synatx: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;;
3 ;;;; Copyright (C) 2005 Edgar Denny <edgardenny@comcast.net>
4 ;;;; This file is part of CL-GSL.
5 ;;;;
6 ;;;; This program is free software; you can redistribute it and/or modify
7 ;;;; it under the terms of the GNU General Public License as published by
8 ;;;; the Free Software Foundation; either version 2 of the License, or
9 ;;;; (at your option) any later version.
10 ;;;;
11 ;;;; This program is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;;; GNU General Public License for more details.
15 ;;;;
16 ;;;; You should have received a copy of the GNU General Public License
17 ;;;; along with this program; if not, write to the Free Software
18 ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
20 (in-package #:cl-gsl-test)
21
22 (defconstant +poly+ "poly")
23
24 (deftest "poly-eval" :category +poly+
25 :test-fn
26 #'(lambda ()
27 (tol< (gsl-poly:poly-eval (vector 1.0d0 0.5d0 0.3d0) 0.5d0)
28 (+ 1.0d0 (* 0.5d0 0.5d0) (* 0.3d0 0.5d0 0.5d0))
29 +tol+2+)))
30
31 (deftest "solve-quadratic-no-roots" :category +poly+
32 :test-fn
33 #'(lambda () (multiple-value-bind (r1 r2 n)
34 (gsl-poly:solve-quadratic 4.0d0 -20.0d0 26.0d0)
35 (declare (ignore r1 r2))
36 (= n 0))))
37
38 (deftest "solve-quadratic-one-root" :category +poly+
39 :test-fn #'(lambda ()
40 (multiple-value-bind (r1 r2 n)
41 (gsl-poly:solve-quadratic 4.0d0 -20.0d0 25.0d0)
42 (and (= n 2)
43 (tol< r1 2.5d0 1.0d-9)
44 (tol< r2 2.5d0 1.0d-9)))))
45
46 (deftest "solve-quadratic-two-roots" :category +poly+
47 :test-fn #'(lambda ()
48 (multiple-value-bind (r1 r2 n)
49 (gsl-poly:solve-quadratic 4.0d0 -20.0d0 21.0d0)
50 (and (= n 2)
51 (tol< r1 1.5d0 1.0d-9)
52 (tol< r2 3.5d0 1.0d-9)))))
53
54 (deftest "solve-cubic-one-root" :category +poly+
55 :test-fn #'(lambda ()
56 (multiple-value-bind (r1 r2 r3 n)
57 (gsl-poly:solve-cubic 0.0d0 0.0d0 27.0d0)
58 (declare (ignore r2 r3))
59 (and (= n 1)
60 (tol< r1 -3.0d0 1.0d-9)))))
61
62 (deftest "solve-cubic-three-roots" :category +poly+
63 :test-fn #'(lambda ()
64 (multiple-value-bind (r1 r2 r3 n)
65 (gsl-poly:solve-cubic -143.0d0 5087.0d0 -50065.0d0)
66 (and (= n 3)
67 (tol< r1 17.0d0 1.0d-9)
68 (tol< r2 31.0d0 1.0d-9)
69 (tol< r3 95.0d0 1.0d-9)))))
70
71 (deftest "complex-solve-quadratic-two-roots" :category +poly+
72 :test-fn
73 #'(lambda ()
74 (multiple-value-bind (r1 r2 n)
75 (gsl-poly:complex-solve-quadratic 4.0d0 -20.0d0 26.0d0)
76 (and (= n 2)
77 (tol< (realpart r1) 2.5d0 1.0d-7)
78 (tol< (imagpart r1) -0.5d0 1.0d-7)
79 (tol< (realpart r2) 2.5d0 1.0d-7)
80 (tol< (imagpart r2) 0.5d0 1.0d-7)))))
81
82 (deftest "complex-solve-quadratic-one-root" :category +poly+
83 :test-fn
84 #'(lambda ()
85 (multiple-value-bind (r1 r2 n)
86 (gsl-poly:complex-solve-quadratic 4.0d0 -20.0d0 25.0d0)
87 (and (= n 2)
88 (tol< (realpart r1) 2.5d0 1.0d-7)
89 (tol< (imagpart r1) 0.0d0 1.0d-7)
90 (tol< (realpart r2) 2.5d0 1.0d-7)
91 (tol< (imagpart r2) 0.0d0 1.0d-7)))))
92
93 (deftest "complex-solve-cubic-three-roots" :category +poly+
94 :test-fn
95 #'(lambda ()
96 (multiple-value-bind (r1 r2 r3 n)
97 (gsl-poly:complex-solve-cubic 0.0d0 0.0d0 -27.0d0)
98 (and (= n 3)
99 (tol< (realpart r1) -1.5d0 1.0d-7)
100 (tol< (imagpart r1) (* -1.5d0 (sqrt 3.0d0)) 1.0d-7)
101 (tol< (realpart r2) -1.5d0 1.0d-7)
102 (tol< (imagpart r2) (* 1.5d0 (sqrt 3.0d0)) 1.0d-7)
103 (tol< (realpart r3) 3.0d0 1.0d-7)
104 (tol< (imagpart r3) 0.0d0 1.0d-7)))))
105
106 (deftest "complex-solve" :category +poly+
107 :test-fn
108 #'(lambda ()
109 (multiple-value-bind (r status)
110 (gsl-poly:complex-solve (vector -120.0d0 274.0d0 -225.0d0
111 85.0d0 -15.0d0 1.0d0))
112 (and (= status 0)
113 (tol< (realpart (aref r 0)) 1.0d0 1.0d-9)
114 (tol< (imagpart (aref r 0)) 0.0d0 1.0d-9)
115 (tol< (realpart (aref r 1)) 2.0d0 1.0d-9)
116 (tol< (imagpart (aref r 1)) 0.0d0 1.0d-9)
117 (tol< (realpart (aref r 2)) 3.0d0 1.0d-9)
118 (tol< (imagpart (aref r 2)) 0.0d0 1.0d-9)
119 (tol< (realpart (aref r 3)) 4.0d0 1.0d-9)
120 (tol< (imagpart (aref r 3)) 0.0d0 1.0d-9)
121 (tol< (realpart (aref r 4)) 5.0d0 1.0d-9)
122 (tol< (imagpart (aref r 4)) 0.0d0 1.0d-9)))))
123
124
125 (deftest "dd-init" :category +poly+
126 :test-fn
127 #'(lambda ()
128 (multiple-value-bind (r status)
129 (gsl-poly::dd-init
130 (vector 0.16d0 0.97d0 1.94d0 2.74d0 3.58d0 3.73d0 4.70d0)
131 (vector 0.73d0 1.11d0 1.49d0 1.84d0 2.30d0 2.41d0 3.07d0))
132 (and (= status 0)
133 (tol< (aref r 0) 0.73d0 1.0d-9)
134 (tol< (aref r 1) 4.69135802469136d-01 1.0d-9)
135 (tol< (aref r 2) -4.34737219941284d-02 1.0d-9)
136 (tol< (aref r 3) 2.68681098870099d-02 1.0d-9)
137 (tol< (aref r 4) -3.22937056934996d-03 1.0d-9)
138 (tol< (aref r 5) 6.12763259971375d-03 1.0d-9)
139 (tol< (aref r 6) -6.45402453527083d-03 1.0d-9)))))
140
141 (deftest "dd-eval" :category +poly+
142 :test-fn
143 #'(lambda ()
144 (tol<
145 (gsl-poly::dd-eval
146 (vector 0.73d0 4.69135802469136d-01 -4.34737219941284d-02
147 2.68681098870099d-02 -3.22937056934996d-03
148 6.12763259971375d-03 -6.45402453527083d-03)
149 (vector 0.16d0 0.97d0 1.94d0 2.74d0 3.58d0 3.73d0 4.70d0) 0.16d0)
150 0.73d0 1.0d-9)))
151
152 (deftest "dd-taylor" :category +poly+
153 :test-fn
154 #'(lambda ()
155 (multiple-value-bind (r status)
156 (gsl-poly::dd-taylor
157 1.5d0
158 (vector 0.73d0 4.69135802469136d-01 -4.34737219941284d-02
159 2.68681098870099d-02 -3.22937056934996d-03
160 6.12763259971375d-03 -6.45402453527083d-03)
161 (vector 0.16d0 0.97d0 1.94d0 2.74d0 3.58d0 3.73d0 4.70d0))
162 (and
163 (= status 0)
164 (tol< (gsl-poly:poly-eval r (- 0.16d0 1.5d0)) 0.73d0 1.0d-9)))))

  ViewVC Help
Powered by ViewVC 1.1.5