Mercurial > octave-nkf
annotate liboctave/lo-specfun.cc @ 15217:d2220c3def3f
avoid C-style cast warning
* lo-specfun.cc (betain): Use C++ static cast.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Wed, 22 Aug 2012 19:50:20 -0400 |
parents | ea5e02b14853 |
children |
rev | line source |
---|---|
3146 | 1 /* |
2 | |
14138
72c96de7a403
maint: update copyright notices for 2012
John W. Eaton <jwe@octave.org>
parents:
11586
diff
changeset
|
3 Copyright (C) 1996-2012 John W. Eaton |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
4 Copyright (C) 2010 Jaroslav Hajek |
10521
4d1fc073fbb7
add some missing copyright stmts
Jaroslav Hajek <highegg@gmail.com>
parents:
10414
diff
changeset
|
5 Copyright (C) 2010 VZLU Prague |
3146 | 6 |
7 This file is part of Octave. | |
8 | |
9 Octave is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
7016 | 11 Free Software Foundation; either version 3 of the License, or (at your |
12 option) any later version. | |
3146 | 13 |
14 Octave is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
7016 | 20 along with Octave; see the file COPYING. If not, see |
21 <http://www.gnu.org/licenses/>. | |
3146 | 22 |
23 */ | |
24 | |
25 #ifdef HAVE_CONFIG_H | |
26 #include <config.h> | |
27 #endif | |
28 | |
29 #include "Range.h" | |
3220 | 30 #include "CColVector.h" |
31 #include "CMatrix.h" | |
32 #include "dRowVector.h" | |
3146 | 33 #include "dMatrix.h" |
4844 | 34 #include "dNDArray.h" |
35 #include "CNDArray.h" | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
36 #include "fCColVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
37 #include "fCMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
38 #include "fRowVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
39 #include "fMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
40 #include "fNDArray.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
41 #include "fCNDArray.h" |
3146 | 42 #include "f77-fcn.h" |
43 #include "lo-error.h" | |
3220 | 44 #include "lo-ieee.h" |
45 #include "lo-specfun.h" | |
3146 | 46 #include "mx-inlines.cc" |
5701 | 47 #include "lo-mappers.h" |
3146 | 48 |
4064 | 49 #ifndef M_PI |
50 #define M_PI 3.14159265358979323846 | |
51 #endif | |
52 | |
3146 | 53 extern "C" |
54 { | |
4552 | 55 F77_RET_T |
56 F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&, | |
11518 | 57 const octave_idx_type&, const octave_idx_type&, |
58 double*, double*, octave_idx_type&, | |
59 octave_idx_type&); | |
3146 | 60 |
4552 | 61 F77_RET_T |
62 F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&, | |
11518 | 63 const octave_idx_type&, const octave_idx_type&, |
64 double*, double*, octave_idx_type&, double*, | |
65 double*, octave_idx_type&); | |
3220 | 66 |
4552 | 67 F77_RET_T |
68 F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&, | |
11518 | 69 const octave_idx_type&, const octave_idx_type&, |
70 double*, double*, octave_idx_type&, | |
71 octave_idx_type&); | |
3146 | 72 |
4552 | 73 F77_RET_T |
74 F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&, | |
11518 | 75 const octave_idx_type&, const octave_idx_type&, |
76 double*, double*, octave_idx_type&, | |
77 octave_idx_type&); | |
3220 | 78 |
4552 | 79 F77_RET_T |
80 F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&, | |
11518 | 81 const octave_idx_type&, const octave_idx_type&, |
82 const octave_idx_type&, double*, double*, | |
83 octave_idx_type&, octave_idx_type&); | |
4552 | 84 |
85 F77_RET_T | |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
86 F77_FUNC (cbesj, cBESJ) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
87 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
88 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
89 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
90 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
91 F77_FUNC (cbesy, CBESY) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
92 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
93 FloatComplex*, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
94 FloatComplex*, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
95 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
96 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
97 F77_FUNC (cbesi, CBESI) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
98 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
99 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
100 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
101 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
102 F77_FUNC (cbesk, CBESK) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
103 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
104 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
105 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
106 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
107 F77_FUNC (cbesh, CBESH) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
108 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
109 const octave_idx_type&, FloatComplex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
110 octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
111 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
112 F77_RET_T |
11518 | 113 F77_FUNC (zairy, ZAIRY) (const double&, const double&, |
114 const octave_idx_type&, const octave_idx_type&, | |
115 double&, double&, octave_idx_type&, | |
116 octave_idx_type&); | |
3146 | 117 |
4552 | 118 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
119 F77_FUNC (cairy, CAIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 120 const octave_idx_type&, float&, float&, |
121 octave_idx_type&, octave_idx_type&); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
122 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
123 F77_RET_T |
11518 | 124 F77_FUNC (zbiry, ZBIRY) (const double&, const double&, |
125 const octave_idx_type&, const octave_idx_type&, | |
126 double&, double&, octave_idx_type&); | |
4552 | 127 |
128 F77_RET_T | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
129 F77_FUNC (cbiry, CBIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 130 const octave_idx_type&, float&, float&, |
131 octave_idx_type&); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
132 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
133 F77_RET_T |
4552 | 134 F77_FUNC (xdacosh, XDACOSH) (const double&, double&); |
3220 | 135 |
4552 | 136 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
137 F77_FUNC (xacosh, XACOSH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
138 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
139 F77_RET_T |
4552 | 140 F77_FUNC (xdasinh, XDASINH) (const double&, double&); |
3146 | 141 |
4552 | 142 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
143 F77_FUNC (xasinh, XASINH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
144 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
145 F77_RET_T |
4552 | 146 F77_FUNC (xdatanh, XDATANH) (const double&, double&); |
3146 | 147 |
4552 | 148 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
149 F77_FUNC (xatanh, XATANH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
150 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
151 F77_RET_T |
4552 | 152 F77_FUNC (xderf, XDERF) (const double&, double&); |
3146 | 153 |
4552 | 154 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
155 F77_FUNC (xerf, XERF) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
156 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
157 F77_RET_T |
4552 | 158 F77_FUNC (xderfc, XDERFC) (const double&, double&); |
3146 | 159 |
4552 | 160 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
161 F77_FUNC (xerfc, XERFC) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
162 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
163 F77_RET_T |
4552 | 164 F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
165 const double&, double&); |
3146 | 166 |
4552 | 167 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
168 F77_FUNC (xbetai, XBETAI) (const float&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
169 const float&, float&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
170 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
171 F77_RET_T |
4552 | 172 F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); |
3146 | 173 |
4552 | 174 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
175 F77_FUNC (xgamma, XGAMMA) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
176 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
177 F77_RET_T |
4552 | 178 F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&); |
3146 | 179 |
4552 | 180 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
181 F77_FUNC (xsgammainc, XSGAMMAINC) (const float&, const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
182 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
183 F77_RET_T |
4552 | 184 F77_FUNC (dlgams, DLGAMS) (const double&, double&, double&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
185 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
186 F77_RET_T |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
187 F77_FUNC (algams, ALGAMS) (const float&, float&, float&); |
3146 | 188 } |
189 | |
190 #if !defined (HAVE_ACOSH) | |
191 double | |
192 acosh (double x) | |
193 { | |
194 double retval; | |
5278 | 195 F77_XFCN (xdacosh, XDACOSH, (x, retval)); |
3146 | 196 return retval; |
197 } | |
198 #endif | |
199 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
200 #if !defined (HAVE_ACOSHF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
201 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
202 acoshf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
203 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
204 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
205 F77_XFCN (xacosh, XACOSH, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
206 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
207 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
208 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
209 |
3146 | 210 #if !defined (HAVE_ASINH) |
211 double | |
212 asinh (double x) | |
213 { | |
214 double retval; | |
5278 | 215 F77_XFCN (xdasinh, XDASINH, (x, retval)); |
3146 | 216 return retval; |
217 } | |
218 #endif | |
219 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
220 #if !defined (HAVE_ASINHF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
221 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
222 asinhf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
223 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
224 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
225 F77_XFCN (xasinh, XASINH, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
226 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
227 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
228 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
229 |
3146 | 230 #if !defined (HAVE_ATANH) |
231 double | |
232 atanh (double x) | |
233 { | |
234 double retval; | |
5278 | 235 F77_XFCN (xdatanh, XDATANH, (x, retval)); |
3146 | 236 return retval; |
237 } | |
238 #endif | |
239 | |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
240 #if !defined (HAVE_ATANHF) |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
241 float |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
242 atanhf (float x) |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
243 { |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
244 float retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
245 F77_XFCN (xatanh, XATANH, (x, retval)); |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
246 return retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
247 } |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
248 #endif |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
249 |
3146 | 250 #if !defined (HAVE_ERF) |
251 double | |
252 erf (double x) | |
253 { | |
254 double retval; | |
5278 | 255 F77_XFCN (xderf, XDERF, (x, retval)); |
3146 | 256 return retval; |
257 } | |
258 #endif | |
259 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
260 #if !defined (HAVE_ERFF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
261 float |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
262 erff (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
263 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
264 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
265 F77_XFCN (xerf, XERF, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
266 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
267 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
268 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
269 |
3146 | 270 #if !defined (HAVE_ERFC) |
271 double | |
272 erfc (double x) | |
273 { | |
274 double retval; | |
5278 | 275 F77_XFCN (xderfc, XDERFC, (x, retval)); |
3146 | 276 return retval; |
277 } | |
278 #endif | |
279 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
280 #if !defined (HAVE_ERFCF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
281 float |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
282 erfcf (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
283 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
284 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
285 F77_XFCN (xerfc, XERFC, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
286 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
287 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
288 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
289 |
3146 | 290 double |
3156 | 291 xgamma (double x) |
3146 | 292 { |
3156 | 293 double result; |
5701 | 294 |
295 if (xisnan (x)) | |
296 result = x; | |
297 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) | |
298 result = octave_Inf; | |
299 else | |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
300 #if defined (HAVE_TGAMMA) |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
301 result = tgamma (x); |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
302 #else |
5701 | 303 F77_XFCN (xdgamma, XDGAMMA, (x, result)); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
304 #endif |
6969 | 305 |
3156 | 306 return result; |
3146 | 307 } |
308 | |
309 double | |
3156 | 310 xlgamma (double x) |
3146 | 311 { |
6969 | 312 #if defined (HAVE_LGAMMA) |
313 return lgamma (x); | |
314 #else | |
3156 | 315 double result; |
3146 | 316 double sgngam; |
4497 | 317 |
5701 | 318 if (xisnan (x)) |
319 result = x; | |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
320 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
5701 | 321 result = octave_Inf; |
5700 | 322 else |
323 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam)); | |
4497 | 324 |
3156 | 325 return result; |
6969 | 326 #endif |
6961 | 327 } |
328 | |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
329 Complex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
330 rc_lgamma (double x) |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
331 { |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
332 double result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
333 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
334 #if defined (HAVE_LGAMMA_R) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
335 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
336 result = lgamma_r (x, &sgngam); |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
337 #else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
338 double sgngam; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
339 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
340 if (xisnan (x)) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
341 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
342 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
343 result = octave_Inf; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
344 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
345 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam)); |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
346 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
347 #endif |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
348 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
349 if (sgngam < 0) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
350 return result + Complex (0., M_PI); |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
351 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
352 return result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
353 } |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
354 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
355 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
356 xgamma (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
357 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
358 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
359 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
360 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
361 result = x; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
362 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
363 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
364 else |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
365 #if defined (HAVE_TGAMMAF) |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
366 result = tgammaf (x); |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
367 #else |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
368 F77_XFCN (xgamma, XGAMMA, (x, result)); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
369 #endif |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
370 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
371 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
372 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
373 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
374 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
375 xlgamma (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
376 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
377 #if defined (HAVE_LGAMMAF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
378 return lgammaf (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
379 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
380 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
381 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
382 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
383 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
384 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
385 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
386 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
387 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
388 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
389 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
390 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
391 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
392 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
393 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
394 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
395 rc_lgamma (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
396 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
397 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
398 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
399 #if defined (HAVE_LGAMMAF_R) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
400 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
401 result = lgammaf_r (x, &sgngam); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
402 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
403 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
404 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
405 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
406 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
407 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
408 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
409 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
410 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
411 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
412 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
413 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
414 if (sgngam < 0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
415 return result + FloatComplex (0., M_PI); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
416 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
417 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
418 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
419 |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
420 #if !defined (HAVE_EXPM1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
421 double |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
422 expm1 (double x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
423 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
424 double retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
425 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
426 double ax = fabs (x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
427 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
428 if (ax < 0.1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
429 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
430 ax /= 16; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
431 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
432 // use Taylor series to calculate exp(x)-1. |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
433 double t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
434 double s = 0; |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
435 for (int i = 2; i < 7; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
436 s += (t *= ax/i); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
437 s += ax; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
438 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
439 // use the identity (a+1)^2-1 = a*(a+2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
440 double e = s; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
441 for (int i = 0; i < 4; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
442 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
443 s *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
444 e *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
445 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
446 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
447 retval = (x > 0) ? s : -s / (1+s); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
448 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
449 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
450 retval = exp (x) - 1; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
451 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
452 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
453 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
454 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
455 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
456 Complex |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
457 expm1 (const Complex& x) |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
458 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
459 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
460 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
461 if (std:: abs (x) < 1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
462 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
463 double im = x.imag (); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
464 double u = expm1 (x.real ()); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
465 double v = sin (im/2); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
466 v = -2*v*v; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
467 retval = Complex (u*v + u + v, (u+1) * sin (im)); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
468 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
469 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
470 retval = std::exp (x) - Complex (1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
471 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
472 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
473 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
474 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
475 #if !defined (HAVE_EXPM1F) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
476 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
477 expm1f (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
478 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
479 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
480 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
481 float ax = fabs (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
482 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
483 if (ax < 0.1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
484 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
485 ax /= 16; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
486 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
487 // use Taylor series to calculate exp(x)-1. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
488 float t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
489 float s = 0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
490 for (int i = 2; i < 7; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
491 s += (t *= ax/i); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
492 s += ax; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
493 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
494 // use the identity (a+1)^2-1 = a*(a+2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
495 float e = s; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
496 for (int i = 0; i < 4; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
497 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
498 s *= e + 2; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
499 e *= e + 2; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
500 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
501 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
502 retval = (x > 0) ? s : -s / (1+s); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
503 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
504 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
505 retval = exp (x) - 1; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
506 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
507 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
508 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
509 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
510 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
511 FloatComplex |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
512 expm1 (const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
513 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
514 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
515 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
516 if (std:: abs (x) < 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
517 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
518 float im = x.imag (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
519 float u = expm1 (x.real ()); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
520 float v = sin (im/2); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
521 v = -2*v*v; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
522 retval = FloatComplex (u*v + u + v, (u+1) * sin (im)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
523 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
524 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
525 retval = std::exp (x) - FloatComplex (1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
526 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
527 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
528 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
529 |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
530 #if !defined (HAVE_LOG1P) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
531 double |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
532 log1p (double x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
533 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
534 double retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
535 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
536 double ax = fabs (x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
537 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
538 if (ax < 0.2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
539 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
540 // use approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
541 double u = x / (2 + x), t = 1, s = 0; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
542 for (int i = 2; i < 12; i += 2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
543 s += (t *= u*u) / (i+1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
544 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
545 retval = 2 * (s + 1) * u; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
546 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
547 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
548 retval = log (1 + x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
549 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
550 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
551 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
552 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
553 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
554 Complex |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
555 log1p (const Complex& x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
556 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
557 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
558 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
559 double r = x.real (), i = x.imag (); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
560 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
561 if (fabs (r) < 0.5 && fabs (i) < 0.5) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
562 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
563 double u = 2*r + r*r + i*i; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
564 retval = Complex (log1p (u / (1+sqrt (u+1))), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
565 atan2 (1 + r, i)); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
566 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
567 else |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
568 retval = std::log (Complex (1) + x); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
569 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
570 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
571 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
572 |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
573 #if !defined (HAVE_CBRT) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
574 double cbrt (double x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
575 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
576 static const double one_third = 0.3333333333333333333; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
577 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
578 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
579 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
580 double y = std::pow (std::abs (x), one_third) * signum (x); |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
581 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
582 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
583 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
584 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
585 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
586 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
587 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
588 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
589 #if !defined (HAVE_LOG1PF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
590 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
591 log1pf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
592 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
593 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
594 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
595 float ax = fabs (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
596 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
597 if (ax < 0.2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
598 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
599 // use approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
600 float u = x / (2 + x), t = 1, s = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
601 for (int i = 2; i < 12; i += 2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
602 s += (t *= u*u) / (i+1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
603 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
604 retval = 2 * (s + 1) * u; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
605 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
606 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
607 retval = log (1 + x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
608 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
609 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
610 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
611 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
612 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
613 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
614 log1p (const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
615 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
616 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
617 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
618 float r = x.real (), i = x.imag (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
619 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
620 if (fabs (r) < 0.5 && fabs (i) < 0.5) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
621 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
622 float u = 2*r + r*r + i*i; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
623 retval = FloatComplex (log1p (u / (1+sqrt (u+1))), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
624 atan2 (1 + r, i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
625 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
626 else |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
627 retval = std::log (FloatComplex (1) + x); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
628 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
629 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
630 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
631 |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
632 #if !defined (HAVE_CBRTF) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
633 float cbrtf (float x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
634 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
635 static const float one_third = 0.3333333333333333333f; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
636 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
637 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
638 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
639 float y = std::pow (std::abs (x), one_third) * signum (x); |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
640 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
641 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
642 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
643 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
644 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
645 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
646 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
647 |
3220 | 648 static inline Complex |
5275 | 649 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 650 |
651 static inline Complex | |
5275 | 652 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 653 |
654 static inline Complex | |
5275 | 655 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 656 |
657 static inline Complex | |
5275 | 658 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 659 |
660 static inline Complex | |
5275 | 661 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 662 |
663 static inline Complex | |
5275 | 664 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 665 |
666 static inline Complex | |
5275 | 667 bessel_return_value (const Complex& val, octave_idx_type ierr) |
3146 | 668 { |
3220 | 669 static const Complex inf_val = Complex (octave_Inf, octave_Inf); |
670 static const Complex nan_val = Complex (octave_NaN, octave_NaN); | |
671 | |
672 Complex retval; | |
673 | |
674 switch (ierr) | |
675 { | |
676 case 0: | |
677 case 3: | |
678 retval = val; | |
679 break; | |
680 | |
681 case 2: | |
682 retval = inf_val; | |
683 break; | |
684 | |
685 default: | |
686 retval = nan_val; | |
687 break; | |
688 } | |
689 | |
3146 | 690 return retval; |
691 } | |
692 | |
4911 | 693 static inline bool |
694 is_integer_value (double x) | |
695 { | |
696 return x == static_cast<double> (static_cast<long> (x)); | |
697 } | |
698 | |
3220 | 699 static inline Complex |
5275 | 700 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 701 { |
3220 | 702 Complex retval; |
703 | |
704 if (alpha >= 0.0) | |
705 { | |
706 double yr = 0.0; | |
707 double yi = 0.0; | |
708 | |
5275 | 709 octave_idx_type nz; |
3220 | 710 |
711 double zr = z.real (); | |
712 double zi = z.imag (); | |
713 | |
4506 | 714 F77_FUNC (zbesj, ZBESJ) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
715 | |
716 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
717 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
718 double expz = exp (std::abs (zi)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
719 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
720 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
721 } |
3220 | 722 |
4490 | 723 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
724 yi = 0.0; |
3220 | 725 |
726 retval = bessel_return_value (Complex (yr, yi), ierr); | |
727 } | |
4911 | 728 else if (is_integer_value (alpha)) |
729 { | |
730 // zbesy can overflow as z->0, and cause troubles for generic case below | |
731 alpha = -alpha; | |
732 Complex tmp = zbesj (z, alpha, kode, ierr); | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
733 if ((static_cast <long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
734 tmp = - tmp; |
4911 | 735 retval = bessel_return_value (tmp, ierr); |
736 } | |
3220 | 737 else |
738 { | |
739 alpha = -alpha; | |
740 | |
741 Complex tmp = cos (M_PI * alpha) * zbesj (z, alpha, kode, ierr); | |
742 | |
743 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
744 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
745 tmp -= sin (M_PI * alpha) * zbesy (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
746 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
747 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
748 } |
3220 | 749 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
750 retval = Complex (octave_NaN, octave_NaN); |
3220 | 751 } |
752 | |
3146 | 753 return retval; |
754 } | |
755 | |
3220 | 756 static inline Complex |
5275 | 757 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 758 { |
3220 | 759 Complex retval; |
3146 | 760 |
761 if (alpha >= 0.0) | |
762 { | |
3220 | 763 double yr = 0.0; |
764 double yi = 0.0; | |
765 | |
5275 | 766 octave_idx_type nz; |
3220 | 767 |
768 double wr, wi; | |
3146 | 769 |
3220 | 770 double zr = z.real (); |
771 double zi = z.imag (); | |
772 | |
773 ierr = 0; | |
774 | |
775 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
776 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
777 yr = -octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
778 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
779 } |
3220 | 780 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
781 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
782 F77_FUNC (zbesy, ZBESY) (zr, zi, alpha, 2, 1, &yr, &yi, nz, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
783 &wr, &wi, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
784 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
785 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
786 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
787 double expz = exp (std::abs (zi)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
788 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
789 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
790 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
791 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
792 if (zi == 0.0 && zr >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
793 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
794 } |
3146 | 795 |
3220 | 796 return bessel_return_value (Complex (yr, yi), ierr); |
797 } | |
4911 | 798 else if (is_integer_value (alpha - 0.5)) |
799 { | |
800 // zbesy can overflow as z->0, and cause troubles for generic case below | |
801 alpha = -alpha; | |
802 Complex tmp = zbesj (z, alpha, kode, ierr); | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
803 if ((static_cast <long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
804 tmp = - tmp; |
4911 | 805 retval = bessel_return_value (tmp, ierr); |
806 } | |
3220 | 807 else |
808 { | |
809 alpha = -alpha; | |
3146 | 810 |
3220 | 811 Complex tmp = cos (M_PI * alpha) * zbesy (z, alpha, kode, ierr); |
3146 | 812 |
3220 | 813 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
814 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
815 tmp += sin (M_PI * alpha) * zbesj (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
816 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
817 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
818 } |
3220 | 819 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
820 retval = Complex (octave_NaN, octave_NaN); |
3220 | 821 } |
822 | |
823 return retval; | |
824 } | |
825 | |
826 static inline Complex | |
5275 | 827 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 828 { |
829 Complex retval; | |
3146 | 830 |
3220 | 831 if (alpha >= 0.0) |
832 { | |
833 double yr = 0.0; | |
834 double yi = 0.0; | |
835 | |
5275 | 836 octave_idx_type nz; |
3146 | 837 |
3220 | 838 double zr = z.real (); |
839 double zi = z.imag (); | |
840 | |
4506 | 841 F77_FUNC (zbesi, ZBESI) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
842 | |
843 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
844 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
845 double expz = exp (std::abs (zr)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
846 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
847 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
848 } |
3146 | 849 |
4490 | 850 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
851 yi = 0.0; |
3220 | 852 |
853 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 854 } |
14196
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
855 else if (is_integer_value (alpha)) |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
856 { |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
857 // zbesi can overflow as z->0, and cause troubles for generic case below |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
858 alpha = -alpha; |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
859 Complex tmp = zbesi (z, alpha, kode, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
860 retval = bessel_return_value (tmp, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
861 } |
3146 | 862 else |
3220 | 863 { |
864 alpha = -alpha; | |
865 | |
866 Complex tmp = zbesi (z, alpha, kode, ierr); | |
867 | |
868 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
869 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
870 Complex tmp2 = (2.0 / M_PI) * sin (M_PI * alpha) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
871 * zbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
872 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
873 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
874 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
875 // Compensate for different scaling factor of besk. |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
876 tmp2 *= exp (-z - std::abs (z.real ())); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
877 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
878 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
879 tmp += tmp2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
880 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
881 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
882 } |
3220 | 883 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
884 retval = Complex (octave_NaN, octave_NaN); |
3220 | 885 } |
886 | |
887 return retval; | |
888 } | |
889 | |
890 static inline Complex | |
5275 | 891 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 892 { |
893 Complex retval; | |
894 | |
895 if (alpha >= 0.0) | |
896 { | |
897 double yr = 0.0; | |
898 double yi = 0.0; | |
899 | |
5275 | 900 octave_idx_type nz; |
3220 | 901 |
902 double zr = z.real (); | |
903 double zi = z.imag (); | |
904 | |
905 ierr = 0; | |
906 | |
907 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
908 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
909 yr = octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
910 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
911 } |
3220 | 912 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
913 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
914 F77_FUNC (zbesk, ZBESK) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
915 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
916 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
917 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
918 Complex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
919 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
920 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
921 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
922 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
923 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
924 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
925 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
926 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
927 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
928 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
929 if (zi == 0.0 && zr >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
930 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
931 } |
3220 | 932 |
933 retval = bessel_return_value (Complex (yr, yi), ierr); | |
934 } | |
935 else | |
936 { | |
937 Complex tmp = zbesk (z, -alpha, kode, ierr); | |
938 | |
939 retval = bessel_return_value (tmp, ierr); | |
940 } | |
3146 | 941 |
942 return retval; | |
943 } | |
944 | |
3220 | 945 static inline Complex |
5275 | 946 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 947 { |
3220 | 948 Complex retval; |
3146 | 949 |
3220 | 950 if (alpha >= 0.0) |
3146 | 951 { |
3220 | 952 double yr = 0.0; |
953 double yi = 0.0; | |
954 | |
5275 | 955 octave_idx_type nz; |
3220 | 956 |
957 double zr = z.real (); | |
958 double zi = z.imag (); | |
3146 | 959 |
4506 | 960 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 1, 1, &yr, &yi, nz, ierr); |
961 | |
962 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
963 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
964 Complex expz = exp (Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
965 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
966 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
967 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
968 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
969 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
970 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
971 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
972 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
973 } |
3146 | 974 |
3220 | 975 retval = bessel_return_value (Complex (yr, yi), ierr); |
976 } | |
977 else | |
978 { | |
979 alpha = -alpha; | |
980 | |
981 static const Complex eye = Complex (0.0, 1.0); | |
3146 | 982 |
3220 | 983 Complex tmp = exp (M_PI * alpha * eye) * zbesh1 (z, alpha, kode, ierr); |
3146 | 984 |
3220 | 985 retval = bessel_return_value (tmp, ierr); |
986 } | |
3146 | 987 |
3220 | 988 return retval; |
989 } | |
3146 | 990 |
3220 | 991 static inline Complex |
5275 | 992 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 993 { |
994 Complex retval; | |
3146 | 995 |
3220 | 996 if (alpha >= 0.0) |
997 { | |
998 double yr = 0.0; | |
999 double yi = 0.0; | |
1000 | |
5275 | 1001 octave_idx_type nz; |
3146 | 1002 |
3220 | 1003 double zr = z.real (); |
1004 double zi = z.imag (); | |
3146 | 1005 |
4506 | 1006 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 2, 1, &yr, &yi, nz, ierr); |
1007 | |
1008 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1009 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1010 Complex expz = exp (-Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1011 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1012 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1013 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1014 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1015 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1016 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1017 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1018 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1019 } |
3220 | 1020 |
1021 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 1022 } |
1023 else | |
3220 | 1024 { |
1025 alpha = -alpha; | |
1026 | |
1027 static const Complex eye = Complex (0.0, 1.0); | |
1028 | |
1029 Complex tmp = exp (-M_PI * alpha * eye) * zbesh2 (z, alpha, kode, ierr); | |
1030 | |
1031 retval = bessel_return_value (tmp, ierr); | |
1032 } | |
1033 | |
1034 return retval; | |
1035 } | |
1036 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1037 typedef Complex (*dptr) (const Complex&, double, int, octave_idx_type&); |
3220 | 1038 |
1039 static inline Complex | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1040 do_bessel (dptr f, const char *, double alpha, const Complex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1041 bool scaled, octave_idx_type& ierr) |
3220 | 1042 { |
1043 Complex retval; | |
1044 | |
1045 retval = f (x, alpha, (scaled ? 2 : 1), ierr); | |
1046 | |
1047 return retval; | |
1048 } | |
1049 | |
1050 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1051 do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x, |
10352 | 1052 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1053 { |
5275 | 1054 octave_idx_type nr = x.rows (); |
1055 octave_idx_type nc = x.cols (); | |
3220 | 1056 |
1057 ComplexMatrix retval (nr, nc); | |
1058 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1059 ierr.resize (dim_vector (nr, nc)); |
3220 | 1060 |
5275 | 1061 for (octave_idx_type j = 0; j < nc; j++) |
1062 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1063 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j)); |
1064 | |
1065 return retval; | |
1066 } | |
1067 | |
1068 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1069 do_bessel (dptr f, const char *, const Matrix& alpha, const Complex& x, |
10352 | 1070 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1071 { |
5275 | 1072 octave_idx_type nr = alpha.rows (); |
1073 octave_idx_type nc = alpha.cols (); | |
3220 | 1074 |
1075 ComplexMatrix retval (nr, nc); | |
1076 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1077 ierr.resize (dim_vector (nr, nc)); |
3220 | 1078 |
5275 | 1079 for (octave_idx_type j = 0; j < nc; j++) |
1080 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1081 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
3146 | 1082 |
1083 return retval; | |
1084 } | |
1085 | |
3220 | 1086 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1087 do_bessel (dptr f, const char *fn, const Matrix& alpha, |
10352 | 1088 const ComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1089 { |
3220 | 1090 ComplexMatrix retval; |
1091 | |
5275 | 1092 octave_idx_type x_nr = x.rows (); |
1093 octave_idx_type x_nc = x.cols (); | |
3220 | 1094 |
5275 | 1095 octave_idx_type alpha_nr = alpha.rows (); |
1096 octave_idx_type alpha_nc = alpha.cols (); | |
3220 | 1097 |
1098 if (x_nr == alpha_nr && x_nc == alpha_nc) | |
1099 { | |
5275 | 1100 octave_idx_type nr = x_nr; |
1101 octave_idx_type nc = x_nc; | |
3220 | 1102 |
1103 retval.resize (nr, nc); | |
1104 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1105 ierr.resize (dim_vector (nr, nc)); |
3220 | 1106 |
5275 | 1107 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1108 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1109 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
3220 | 1110 } |
1111 else | |
1112 (*current_liboctave_error_handler) | |
1113 ("%s: the sizes of alpha and x must conform", fn); | |
1114 | |
1115 return retval; | |
3146 | 1116 } |
1117 | |
4844 | 1118 static inline ComplexNDArray |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1119 do_bessel (dptr f, const char *, double alpha, const ComplexNDArray& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1120 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1121 { |
1122 dim_vector dv = x.dims (); | |
5275 | 1123 octave_idx_type nel = dv.numel (); |
4844 | 1124 ComplexNDArray retval (dv); |
1125 | |
1126 ierr.resize (dv); | |
1127 | |
5275 | 1128 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1129 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
1130 | |
1131 return retval; | |
1132 } | |
1133 | |
1134 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1135 do_bessel (dptr f, const char *, const NDArray& alpha, const Complex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1136 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1137 { |
1138 dim_vector dv = alpha.dims (); | |
5275 | 1139 octave_idx_type nel = dv.numel (); |
4844 | 1140 ComplexNDArray retval (dv); |
1141 | |
1142 ierr.resize (dv); | |
1143 | |
5275 | 1144 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1145 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i)); |
1146 | |
1147 return retval; | |
1148 } | |
1149 | |
1150 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1151 do_bessel (dptr f, const char *fn, const NDArray& alpha, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1152 const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1153 { |
1154 dim_vector dv = x.dims (); | |
1155 ComplexNDArray retval; | |
1156 | |
1157 if (dv == alpha.dims ()) | |
1158 { | |
5275 | 1159 octave_idx_type nel = dv.numel (); |
4844 | 1160 |
1161 retval.resize (dv); | |
1162 ierr.resize (dv); | |
1163 | |
5275 | 1164 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1165 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
4844 | 1166 } |
1167 else | |
1168 (*current_liboctave_error_handler) | |
1169 ("%s: the sizes of alpha and x must conform", fn); | |
1170 | |
1171 return retval; | |
1172 } | |
1173 | |
3220 | 1174 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1175 do_bessel (dptr f, const char *, const RowVector& alpha, |
10352 | 1176 const ComplexColumnVector& x, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1177 { |
5275 | 1178 octave_idx_type nr = x.length (); |
1179 octave_idx_type nc = alpha.length (); | |
3220 | 1180 |
1181 ComplexMatrix retval (nr, nc); | |
3146 | 1182 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1183 ierr.resize (dim_vector (nr, nc)); |
3220 | 1184 |
5275 | 1185 for (octave_idx_type j = 0; j < nc; j++) |
1186 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1187 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j)); |
1188 | |
1189 return retval; | |
3146 | 1190 } |
1191 | |
3220 | 1192 #define SS_BESSEL(name, fcn) \ |
1193 Complex \ | |
5275 | 1194 name (double alpha, const Complex& x, bool scaled, octave_idx_type& ierr) \ |
3220 | 1195 { \ |
1196 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1197 } | |
1198 | |
1199 #define SM_BESSEL(name, fcn) \ | |
1200 ComplexMatrix \ | |
1201 name (double alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1202 Array<octave_idx_type>& ierr) \ |
3220 | 1203 { \ |
1204 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1205 } | |
1206 | |
1207 #define MS_BESSEL(name, fcn) \ | |
1208 ComplexMatrix \ | |
1209 name (const Matrix& alpha, const Complex& x, bool scaled, \ | |
10352 | 1210 Array<octave_idx_type>& ierr) \ |
3220 | 1211 { \ |
1212 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1213 } | |
1214 | |
1215 #define MM_BESSEL(name, fcn) \ | |
1216 ComplexMatrix \ | |
1217 name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1218 Array<octave_idx_type>& ierr) \ |
3220 | 1219 { \ |
1220 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1221 } | |
1222 | |
4844 | 1223 #define SN_BESSEL(name, fcn) \ |
1224 ComplexNDArray \ | |
1225 name (double alpha, const ComplexNDArray& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1226 Array<octave_idx_type>& ierr) \ |
4844 | 1227 { \ |
1228 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1229 } | |
1230 | |
1231 #define NS_BESSEL(name, fcn) \ | |
1232 ComplexNDArray \ | |
1233 name (const NDArray& alpha, const Complex& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1234 Array<octave_idx_type>& ierr) \ |
4844 | 1235 { \ |
1236 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1237 } | |
1238 | |
1239 #define NN_BESSEL(name, fcn) \ | |
1240 ComplexNDArray \ | |
1241 name (const NDArray& alpha, const ComplexNDArray& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1242 Array<octave_idx_type>& ierr) \ |
4844 | 1243 { \ |
1244 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1245 } | |
1246 | |
3220 | 1247 #define RC_BESSEL(name, fcn) \ |
1248 ComplexMatrix \ | |
1249 name (const RowVector& alpha, const ComplexColumnVector& x, bool scaled, \ | |
10352 | 1250 Array<octave_idx_type>& ierr) \ |
3220 | 1251 { \ |
1252 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1253 } | |
1254 | |
1255 #define ALL_BESSEL(name, fcn) \ | |
1256 SS_BESSEL (name, fcn) \ | |
1257 SM_BESSEL (name, fcn) \ | |
1258 MS_BESSEL (name, fcn) \ | |
1259 MM_BESSEL (name, fcn) \ | |
4844 | 1260 SN_BESSEL (name, fcn) \ |
1261 NS_BESSEL (name, fcn) \ | |
1262 NN_BESSEL (name, fcn) \ | |
3220 | 1263 RC_BESSEL (name, fcn) |
1264 | |
1265 ALL_BESSEL (besselj, zbesj) | |
1266 ALL_BESSEL (bessely, zbesy) | |
1267 ALL_BESSEL (besseli, zbesi) | |
1268 ALL_BESSEL (besselk, zbesk) | |
1269 ALL_BESSEL (besselh1, zbesh1) | |
1270 ALL_BESSEL (besselh2, zbesh2) | |
1271 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1272 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1273 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1274 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1275 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1276 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1277 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1278 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1279 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1280 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1281 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1282 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1283 cbesj (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1284 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1285 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1286 cbesy (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1287 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1288 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1289 cbesi (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1290 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1291 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1292 cbesk (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1293 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1294 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1295 cbesh1 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1296 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1297 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1298 cbesh2 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1299 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1300 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1301 bessel_return_value (const FloatComplex& val, octave_idx_type ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1302 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1303 static const FloatComplex inf_val = FloatComplex (octave_Float_Inf, octave_Float_Inf); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1304 static const FloatComplex nan_val = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1305 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1306 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1307 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1308 switch (ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1309 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1310 case 0: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1311 case 3: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1312 retval = val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1313 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1314 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1315 case 2: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1316 retval = inf_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1317 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1318 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1319 default: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1320 retval = nan_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1321 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1322 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1323 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1324 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1325 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1326 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1327 static inline bool |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1328 is_integer_value (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1329 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1330 return x == static_cast<float> (static_cast<long> (x)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1331 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1332 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1333 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1334 cbesj (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1335 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1336 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1337 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1338 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1339 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1340 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1341 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1342 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1343 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1344 F77_FUNC (cbesj, CBESJ) (z, alpha, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1345 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1346 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1347 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1348 float expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1349 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1350 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1351 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1352 if (imag (z) == 0.0 && real (z) >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1353 y = FloatComplex (y.real (), 0.0); |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1354 |
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1355 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1356 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1357 else if (is_integer_value (alpha)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1358 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1359 // zbesy can overflow as z->0, and cause troubles for generic case below |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1360 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1361 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1362 if ((static_cast <long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1363 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1364 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1365 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1366 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1367 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1368 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1369 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1370 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1371 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1372 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1373 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1374 tmp -= sinf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1375 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1376 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1377 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1378 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1379 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1380 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1381 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1382 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1383 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1384 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1385 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1386 cbesy (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1387 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1388 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1389 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1390 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1391 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1392 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1393 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1394 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1395 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1396 FloatComplex w; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1397 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1398 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1399 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1400 if (real (z) == 0.0 && imag (z) == 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1401 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1402 y = FloatComplex (-octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1403 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1404 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1405 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1406 F77_FUNC (cbesy, CBESY) (z, alpha, 2, 1, &y, nz, &w, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1407 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1408 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1409 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1410 float expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1411 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1412 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1413 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1414 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1415 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1416 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1417 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1418 return bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1419 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1420 else if (is_integer_value (alpha - 0.5)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1421 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1422 // zbesy can overflow as z->0, and cause troubles for generic case below |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1423 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1424 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1425 if ((static_cast <long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1426 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1427 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1428 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1429 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1430 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1431 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1432 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1433 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1434 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1435 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1436 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1437 tmp += sinf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1438 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1439 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1440 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1441 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1442 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1443 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1444 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1445 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1446 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1447 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1448 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1449 cbesi (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1450 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1451 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1452 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1453 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1454 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1455 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1456 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1457 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1458 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1459 F77_FUNC (cbesi, CBESI) (z, alpha, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1460 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1461 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1462 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1463 float expz = exp (std::abs (real (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1464 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1465 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1466 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1467 if (imag (z) == 0.0 && real (z) >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1468 y = FloatComplex (y.real (), 0.0); |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1469 |
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1470 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1471 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1472 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1473 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1474 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1475 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1476 FloatComplex tmp = cbesi (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1477 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1478 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1479 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1480 FloatComplex tmp2 = static_cast<float> (2.0 / M_PI) * sinf (static_cast<float> (M_PI) * alpha) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1481 * cbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1482 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1483 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1484 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1485 // Compensate for different scaling factor of besk. |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
1486 tmp2 *= exp (-z - std::abs (z.real ())); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1487 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1488 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1489 tmp += tmp2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1490 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1491 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1492 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1493 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1494 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1495 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1496 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1497 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1498 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1499 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1500 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1501 cbesk (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1502 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1503 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1504 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1505 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1506 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1507 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1508 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1509 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1510 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1511 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1512 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1513 if (real (z) == 0.0 && imag (z) == 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1514 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1515 y = FloatComplex (octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1516 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1517 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1518 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1519 F77_FUNC (cbesk, CBESK) (z, alpha, 2, 1, &y, nz, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1520 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1521 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1522 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1523 FloatComplex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1524 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1525 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1526 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1527 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1528 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1529 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1530 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1531 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1532 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1533 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1534 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1535 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1536 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1537 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1538 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1539 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1540 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1541 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1542 FloatComplex tmp = cbesk (z, -alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1543 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1544 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1545 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1546 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1547 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1548 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1549 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1550 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1551 cbesh1 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1552 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1553 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1554 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1555 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1556 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1557 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1558 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1559 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1560 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1561 F77_FUNC (cbesh, CBESH) (z, alpha, 2, 1, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1562 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1563 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1564 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1565 FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1566 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1567 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1568 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1569 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1570 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1571 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1572 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1573 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1574 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1575 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1576 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1577 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1578 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1579 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1580 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1581 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1582 static const FloatComplex eye = FloatComplex (0.0, 1.0); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1583 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1584 FloatComplex tmp = exp (static_cast<float> (M_PI) * alpha * eye) * cbesh1 (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1585 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1586 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1587 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1588 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1589 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1590 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1591 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1592 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1593 cbesh2 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1594 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1595 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1596 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1597 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1598 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1599 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1600 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1601 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1602 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1603 F77_FUNC (cbesh, CBESH) (z, alpha, 2, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1604 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1605 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1606 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1607 FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1608 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1609 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1610 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1611 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1612 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1613 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1614 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1615 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1616 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1617 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1618 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1619 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1620 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1621 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1622 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1623 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1624 static const FloatComplex eye = FloatComplex (0.0, 1.0); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1625 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1626 FloatComplex tmp = exp (-static_cast<float> (M_PI) * alpha * eye) * cbesh2 (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1627 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1628 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1629 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1630 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1631 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1632 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1633 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1634 typedef FloatComplex (*fptr) (const FloatComplex&, float, int, octave_idx_type&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1635 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1636 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1637 do_bessel (fptr f, const char *, float alpha, const FloatComplex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1638 bool scaled, octave_idx_type& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1639 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1640 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1641 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1642 retval = f (x, alpha, (scaled ? 2 : 1), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1643 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1644 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1645 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1646 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1647 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1648 do_bessel (fptr f, const char *, float alpha, const FloatComplexMatrix& x, |
10352 | 1649 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1650 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1651 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1652 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1653 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1654 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1655 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1656 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1657 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1658 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1659 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1660 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1661 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1662 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1663 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1664 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1665 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1666 do_bessel (fptr f, const char *, const FloatMatrix& alpha, const FloatComplex& x, |
10352 | 1667 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1668 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1669 octave_idx_type nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1670 octave_idx_type nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1671 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1672 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1673 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1674 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1675 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1676 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1677 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1678 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1679 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1680 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1681 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1682 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1683 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1684 do_bessel (fptr f, const char *fn, const FloatMatrix& alpha, |
10352 | 1685 const FloatComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1686 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1687 FloatComplexMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1688 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1689 octave_idx_type x_nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1690 octave_idx_type x_nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1691 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1692 octave_idx_type alpha_nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1693 octave_idx_type alpha_nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1694 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1695 if (x_nr == alpha_nr && x_nc == alpha_nc) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1696 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1697 octave_idx_type nr = x_nr; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1698 octave_idx_type nc = x_nc; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1699 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1700 retval.resize (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1701 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1702 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1703 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1704 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1705 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1706 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1707 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1708 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1709 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1710 ("%s: the sizes of alpha and x must conform", fn); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1711 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1712 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1713 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1714 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1715 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1716 do_bessel (fptr f, const char *, float alpha, const FloatComplexNDArray& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1717 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1718 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1719 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1720 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1721 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1722 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1723 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1724 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1725 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1726 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1727 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1728 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1729 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1730 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1731 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1732 do_bessel (fptr f, const char *, const FloatNDArray& alpha, const FloatComplex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1733 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1734 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1735 dim_vector dv = alpha.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1736 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1737 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1738 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1739 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1740 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1741 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1742 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1743 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1744 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1745 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1746 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1747 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1748 do_bessel (fptr f, const char *fn, const FloatNDArray& alpha, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1749 const FloatComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1750 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1751 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1752 FloatComplexNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1753 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1754 if (dv == alpha.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1755 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1756 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1757 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1758 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1759 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1760 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1761 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1762 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1763 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1764 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1765 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1766 ("%s: the sizes of alpha and x must conform", fn); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1767 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1768 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1769 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1770 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1771 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1772 do_bessel (fptr f, const char *, const FloatRowVector& alpha, |
10352 | 1773 const FloatComplexColumnVector& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1774 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1775 octave_idx_type nr = x.length (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1776 octave_idx_type nc = alpha.length (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1777 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1778 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1779 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1780 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1781 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1782 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1783 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1784 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1785 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1786 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1787 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1788 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1789 #define SS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1790 FloatComplex \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1791 name (float alpha, const FloatComplex& x, bool scaled, octave_idx_type& ierr) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1792 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1793 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1794 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1795 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1796 #define SM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1797 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1798 name (float alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1799 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1800 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1801 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1802 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1803 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1804 #define MS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1805 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1806 name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \ |
10352 | 1807 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1808 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1809 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1810 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1811 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1812 #define MM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1813 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1814 name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1815 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1816 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1817 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1818 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1819 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1820 #define SN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1821 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1822 name (float alpha, const FloatComplexNDArray& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1823 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1824 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1825 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1826 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1827 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1828 #define NS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1829 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1830 name (const FloatNDArray& alpha, const FloatComplex& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1831 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1832 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1833 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1834 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1835 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1836 #define NN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1837 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1838 name (const FloatNDArray& alpha, const FloatComplexNDArray& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1839 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1840 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1841 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1842 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1843 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1844 #define RC_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1845 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1846 name (const FloatRowVector& alpha, const FloatComplexColumnVector& x, bool scaled, \ |
10352 | 1847 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1848 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1849 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1850 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1851 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1852 #define ALL_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1853 SS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1854 SM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1855 MS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1856 MM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1857 SN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1858 NS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1859 NN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1860 RC_BESSEL (name, fcn) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1861 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1862 ALL_BESSEL (besselj, cbesj) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1863 ALL_BESSEL (bessely, cbesy) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1864 ALL_BESSEL (besseli, cbesi) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1865 ALL_BESSEL (besselk, cbesk) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1866 ALL_BESSEL (besselh1, cbesh1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1867 ALL_BESSEL (besselh2, cbesh2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1868 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1869 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1870 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1871 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1872 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1873 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1874 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1875 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1876 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1877 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1878 |
3220 | 1879 Complex |
5275 | 1880 airy (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 1881 { |
3220 | 1882 double ar = 0.0; |
1883 double ai = 0.0; | |
1884 | |
5275 | 1885 octave_idx_type nz; |
3220 | 1886 |
1887 double zr = z.real (); | |
1888 double zi = z.imag (); | |
3146 | 1889 |
5275 | 1890 octave_idx_type id = deriv ? 1 : 0; |
3220 | 1891 |
4506 | 1892 F77_FUNC (zairy, ZAIRY) (zr, zi, id, 2, ar, ai, nz, ierr); |
1893 | |
1894 if (! scaled) | |
1895 { | |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
1896 Complex expz = exp (- 2.0 / 3.0 * z * sqrt (z)); |
3220 | 1897 |
4506 | 1898 double rexpz = real (expz); |
1899 double iexpz = imag (expz); | |
1900 | |
1901 double tmp = ar*rexpz - ai*iexpz; | |
1902 | |
1903 ai = ar*iexpz + ai*rexpz; | |
1904 ar = tmp; | |
1905 } | |
3220 | 1906 |
4490 | 1907 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 1908 ai = 0.0; |
1909 | |
3220 | 1910 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 1911 } |
1912 | |
3220 | 1913 Complex |
5275 | 1914 biry (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 1915 { |
3220 | 1916 double ar = 0.0; |
1917 double ai = 0.0; | |
1918 | |
1919 double zr = z.real (); | |
1920 double zi = z.imag (); | |
1921 | |
5275 | 1922 octave_idx_type id = deriv ? 1 : 0; |
3220 | 1923 |
4506 | 1924 F77_FUNC (zbiry, ZBIRY) (zr, zi, id, 2, ar, ai, ierr); |
1925 | |
1926 if (! scaled) | |
1927 { | |
1928 Complex expz = exp (std::abs (real (2.0 / 3.0 * z * sqrt (z)))); | |
3220 | 1929 |
4506 | 1930 double rexpz = real (expz); |
1931 double iexpz = imag (expz); | |
1932 | |
1933 double tmp = ar*rexpz - ai*iexpz; | |
1934 | |
1935 ai = ar*iexpz + ai*rexpz; | |
1936 ar = tmp; | |
1937 } | |
3220 | 1938 |
4490 | 1939 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 1940 ai = 0.0; |
1941 | |
3220 | 1942 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 1943 } |
1944 | |
3220 | 1945 ComplexMatrix |
10352 | 1946 airy (const ComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1947 { |
5275 | 1948 octave_idx_type nr = z.rows (); |
1949 octave_idx_type nc = z.cols (); | |
3220 | 1950 |
1951 ComplexMatrix retval (nr, nc); | |
1952 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1953 ierr.resize (dim_vector (nr, nc)); |
3220 | 1954 |
5275 | 1955 for (octave_idx_type j = 0; j < nc; j++) |
1956 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1957 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j)); |
1958 | |
1959 return retval; | |
3146 | 1960 } |
1961 | |
3220 | 1962 ComplexMatrix |
10352 | 1963 biry (const ComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1964 { |
5275 | 1965 octave_idx_type nr = z.rows (); |
1966 octave_idx_type nc = z.cols (); | |
3220 | 1967 |
1968 ComplexMatrix retval (nr, nc); | |
1969 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1970 ierr.resize (dim_vector (nr, nc)); |
3220 | 1971 |
5275 | 1972 for (octave_idx_type j = 0; j < nc; j++) |
1973 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1974 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j)); |
1975 | |
1976 return retval; | |
3146 | 1977 } |
1978 | |
4844 | 1979 ComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1980 airy (const ComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1981 { |
1982 dim_vector dv = z.dims (); | |
5275 | 1983 octave_idx_type nel = dv.numel (); |
4844 | 1984 ComplexNDArray retval (dv); |
1985 | |
1986 ierr.resize (dv); | |
1987 | |
5275 | 1988 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
1989 retval(i) = airy (z(i), deriv, scaled, ierr(i)); |
4844 | 1990 |
1991 return retval; | |
1992 } | |
1993 | |
1994 ComplexNDArray | |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1995 biry (const ComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1996 { |
1997 dim_vector dv = z.dims (); | |
5275 | 1998 octave_idx_type nel = dv.numel (); |
4844 | 1999 ComplexNDArray retval (dv); |
2000 | |
2001 ierr.resize (dv); | |
2002 | |
5275 | 2003 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2004 retval(i) = biry (z(i), deriv, scaled, ierr(i)); |
4844 | 2005 |
2006 return retval; | |
2007 } | |
2008 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2009 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2010 airy (const FloatComplex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2011 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2012 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2013 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2014 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2015 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2016 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2017 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2018 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2019 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2020 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2021 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2022 F77_FUNC (cairy, CAIRY) (zr, zi, id, 2, ar, ai, nz, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2023 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2024 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2025 { |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
2026 FloatComplex expz = exp (- static_cast<float> (2.0 / 3.0) * z * sqrt (z)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2027 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2028 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2029 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2030 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2031 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2032 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2033 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2034 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2035 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2036 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2037 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2038 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2039 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2040 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2041 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2042 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2043 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2044 biry (const FloatComplex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2045 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2046 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2047 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2048 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2049 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2050 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2051 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2052 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2053 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2054 F77_FUNC (cbiry, CBIRY) (zr, zi, id, 2, ar, ai, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2055 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2056 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2057 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2058 FloatComplex expz = exp (std::abs (real (static_cast<float> (2.0 / 3.0) * z * sqrt (z)))); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2059 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2060 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2061 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2062 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2063 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2064 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2065 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2066 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2067 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2068 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2069 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2070 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2071 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2072 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2073 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2074 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2075 FloatComplexMatrix |
10352 | 2076 airy (const FloatComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2077 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2078 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2079 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2080 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2081 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2082 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2083 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2084 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2085 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2086 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2087 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2088 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2089 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2090 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2091 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2092 FloatComplexMatrix |
10352 | 2093 biry (const FloatComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2094 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2095 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2096 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2097 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2098 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2099 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2100 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2101 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2102 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2103 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2104 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2105 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2106 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2107 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2108 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2109 FloatComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2110 airy (const FloatComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2111 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2112 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2113 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2114 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2115 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2116 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2117 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2118 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2119 retval(i) = airy (z(i), deriv, scaled, ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2120 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2121 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2122 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2123 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2124 FloatComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2125 biry (const FloatComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2126 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2127 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2128 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2129 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2130 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2131 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2132 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2133 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2134 retval(i) = biry (z(i), deriv, scaled, ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2135 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2136 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2137 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2138 |
3146 | 2139 static void |
4844 | 2140 gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2141 const dim_vector& d3) |
4844 | 2142 { |
2143 std::string d1_str = d1.str (); | |
2144 std::string d2_str = d2.str (); | |
2145 std::string d3_str = d3.str (); | |
2146 | |
2147 (*current_liboctave_error_handler) | |
2148 ("betainc: nonconformant arguments (x is %s, a is %s, b is %s)", | |
2149 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ()); | |
2150 } | |
2151 | |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2152 static void |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2153 gripe_betaincinv_nonconformant (const dim_vector& d1, const dim_vector& d2, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2154 const dim_vector& d3) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2155 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2156 std::string d1_str = d1.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2157 std::string d2_str = d2.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2158 std::string d3_str = d3.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2159 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2160 (*current_liboctave_error_handler) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2161 ("betaincinv: nonconformant arguments (x is %s, a is %s, b is %s)", |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2162 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ()); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2163 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2164 |
3146 | 2165 double |
2166 betainc (double x, double a, double b) | |
2167 { | |
2168 double retval; | |
5700 | 2169 F77_XFCN (xdbetai, XDBETAI, (x, a, b, retval)); |
3146 | 2170 return retval; |
2171 } | |
2172 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2173 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2174 betainc (double x, double a, const Array<double>& b) |
3146 | 2175 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2176 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2177 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2178 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2179 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2180 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2181 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2182 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2183 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2184 *pretval++ = betainc (x, a, b(i)); |
3146 | 2185 |
2186 return retval; | |
2187 } | |
2188 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2189 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2190 betainc (double x, const Array<double>& a, double b) |
3146 | 2191 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2192 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2193 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2194 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2195 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2196 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2197 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2198 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2199 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2200 *pretval++ = betainc (x, a(i), b); |
3146 | 2201 |
2202 return retval; | |
2203 } | |
2204 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2205 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2206 betainc (double x, const Array<double>& a, const Array<double>& b) |
4844 | 2207 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2208 Array<double> retval; |
4844 | 2209 dim_vector dv = a.dims (); |
2210 | |
2211 if (dv == b.dims ()) | |
2212 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2213 octave_idx_type nel = dv.numel (); |
4844 | 2214 |
2215 retval.resize (dv); | |
2216 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2217 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2218 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2219 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2220 *pretval++ = betainc (x, a(i), b(i)); |
4844 | 2221 } |
2222 else | |
10258 | 2223 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2224 |
4844 | 2225 return retval; |
2226 } | |
2227 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2228 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2229 betainc (const Array<double>& x, double a, double b) |
3146 | 2230 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2231 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2232 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2233 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2234 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2235 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2236 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2237 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2238 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2239 *pretval++ = betainc (x(i), a, b); |
3146 | 2240 |
2241 return retval; | |
2242 } | |
2243 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2244 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2245 betainc (const Array<double>& x, double a, const Array<double>& b) |
3146 | 2246 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2247 Array<double> retval; |
4844 | 2248 dim_vector dv = x.dims (); |
2249 | |
2250 if (dv == b.dims ()) | |
2251 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2252 octave_idx_type nel = dv.numel (); |
4844 | 2253 |
2254 retval.resize (dv); | |
2255 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2256 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2257 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2258 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2259 *pretval++ = betainc (x(i), a, b(i)); |
4844 | 2260 } |
2261 else | |
10258 | 2262 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2263 |
4844 | 2264 return retval; |
2265 } | |
2266 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2267 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2268 betainc (const Array<double>& x, const Array<double>& a, double b) |
4844 | 2269 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2270 Array<double> retval; |
4844 | 2271 dim_vector dv = x.dims (); |
2272 | |
2273 if (dv == a.dims ()) | |
2274 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2275 octave_idx_type nel = dv.numel (); |
4844 | 2276 |
2277 retval.resize (dv); | |
2278 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2279 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2280 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2281 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2282 *pretval++ = betainc (x(i), a(i), b); |
4844 | 2283 } |
2284 else | |
10258 | 2285 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2286 |
4844 | 2287 return retval; |
2288 } | |
2289 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2290 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2291 betainc (const Array<double>& x, const Array<double>& a, const Array<double>& b) |
4844 | 2292 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2293 Array<double> retval; |
4844 | 2294 dim_vector dv = x.dims (); |
2295 | |
2296 if (dv == a.dims () && dv == b.dims ()) | |
2297 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2298 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2299 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2300 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2301 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2302 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2303 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2304 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2305 *pretval++ = betainc (x(i), a(i), b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2306 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2307 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2308 gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2309 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2310 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2311 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2312 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2313 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2314 betainc (float x, float a, float b) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2315 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2316 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2317 F77_XFCN (xbetai, XBETAI, (x, a, b, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2318 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2319 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2320 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2321 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2322 betainc (float x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2323 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2324 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2325 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2326 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2327 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2328 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2329 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2330 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2331 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2332 *pretval++ = betainc (x, a, b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2333 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2334 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2335 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2336 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2337 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2338 betainc (float x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2339 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2340 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2341 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2342 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2343 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2344 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2345 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2346 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2347 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2348 *pretval++ = betainc (x, a(i), b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2349 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2350 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2351 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2352 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2353 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2354 betainc (float x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2355 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2356 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2357 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2358 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2359 if (dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2360 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2361 octave_idx_type nel = dv.numel (); |
4844 | 2362 |
2363 retval.resize (dv); | |
2364 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2365 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2366 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2367 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2368 *pretval++ = betainc (x, a(i), b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2369 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2370 else |
10258 | 2371 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2372 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2373 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2374 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2375 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2376 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2377 betainc (const Array<float>& x, float a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2378 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2379 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2380 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2381 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2382 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2383 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2384 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2385 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2386 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2387 *pretval++ = betainc (x(i), a, b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2388 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2389 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2390 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2391 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2392 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2393 betainc (const Array<float>& x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2394 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2395 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2396 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2397 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2398 if (dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2399 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2400 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2401 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2402 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2403 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2404 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2405 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2406 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2407 *pretval++ = betainc (x(i), a, b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2408 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2409 else |
10258 | 2410 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2411 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2412 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2413 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2414 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2415 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2416 betainc (const Array<float>& x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2417 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2418 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2419 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2420 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2421 if (dv == a.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2422 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2423 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2424 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2425 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2426 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2427 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2428 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2429 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2430 *pretval++ = betainc (x(i), a(i), b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2431 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2432 else |
10258 | 2433 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2434 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2435 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2436 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2437 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2438 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2439 betainc (const Array<float>& x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2440 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2441 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2442 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2443 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2444 if (dv == a.dims () && dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2445 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2446 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2447 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2448 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2449 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2450 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2451 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2452 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2453 *pretval++ = betainc (x(i), a(i), b(i)); |
4844 | 2454 } |
2455 else | |
2456 gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); | |
2457 | |
2458 return retval; | |
2459 } | |
2460 | |
5775 | 2461 // FIXME -- there is still room for improvement here... |
3164 | 2462 |
3146 | 2463 double |
4004 | 2464 gammainc (double x, double a, bool& err) |
3146 | 2465 { |
2466 double retval; | |
3164 | 2467 |
4004 | 2468 err = false; |
3164 | 2469 |
4004 | 2470 if (a < 0.0 || x < 0.0) |
2471 { | |
2472 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2473 ("gammainc: A and X must be non-negative"); |
4004 | 2474 |
2475 err = true; | |
2476 } | |
2477 else | |
5278 | 2478 F77_XFCN (xgammainc, XGAMMAINC, (a, x, retval)); |
3164 | 2479 |
3146 | 2480 return retval; |
2481 } | |
2482 | |
2483 Matrix | |
2484 gammainc (double x, const Matrix& a) | |
2485 { | |
5275 | 2486 octave_idx_type nr = a.rows (); |
2487 octave_idx_type nc = a.cols (); | |
3146 | 2488 |
4004 | 2489 Matrix result (nr, nc); |
2490 Matrix retval; | |
2491 | |
2492 bool err; | |
3146 | 2493 |
5275 | 2494 for (octave_idx_type j = 0; j < nc; j++) |
2495 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2496 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2497 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2498 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2499 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2500 goto done; |
4004 | 2501 } |
2502 | |
2503 retval = result; | |
2504 | |
2505 done: | |
3146 | 2506 |
2507 return retval; | |
2508 } | |
2509 | |
2510 Matrix | |
2511 gammainc (const Matrix& x, double a) | |
2512 { | |
5275 | 2513 octave_idx_type nr = x.rows (); |
2514 octave_idx_type nc = x.cols (); | |
3146 | 2515 |
4004 | 2516 Matrix result (nr, nc); |
2517 Matrix retval; | |
2518 | |
2519 bool err; | |
3146 | 2520 |
5275 | 2521 for (octave_idx_type j = 0; j < nc; j++) |
2522 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2523 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2524 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2525 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2526 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2527 goto done; |
4004 | 2528 } |
2529 | |
2530 retval = result; | |
2531 | |
2532 done: | |
3146 | 2533 |
2534 return retval; | |
2535 } | |
2536 | |
2537 Matrix | |
2538 gammainc (const Matrix& x, const Matrix& a) | |
2539 { | |
4004 | 2540 Matrix result; |
3146 | 2541 Matrix retval; |
2542 | |
5275 | 2543 octave_idx_type nr = x.rows (); |
2544 octave_idx_type nc = x.cols (); | |
3146 | 2545 |
5275 | 2546 octave_idx_type a_nr = a.rows (); |
2547 octave_idx_type a_nc = a.cols (); | |
3146 | 2548 |
2549 if (nr == a_nr && nc == a_nc) | |
2550 { | |
4004 | 2551 result.resize (nr, nc); |
2552 | |
2553 bool err; | |
3146 | 2554 |
5275 | 2555 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2556 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2557 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2558 result(i,j) = gammainc (x(i,j), a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2559 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2560 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2561 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2562 } |
4004 | 2563 |
2564 retval = result; | |
3146 | 2565 } |
2566 else | |
2567 (*current_liboctave_error_handler) | |
2568 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)", | |
2569 nr, nc, a_nr, a_nc); | |
2570 | |
4004 | 2571 done: |
2572 | |
3146 | 2573 return retval; |
2574 } | |
2575 | |
4844 | 2576 NDArray |
2577 gammainc (double x, const NDArray& a) | |
2578 { | |
2579 dim_vector dv = a.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2580 octave_idx_type nel = dv.numel (); |
4844 | 2581 |
2582 NDArray retval; | |
2583 NDArray result (dv); | |
2584 | |
2585 bool err; | |
2586 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2587 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2588 { |
2589 result (i) = gammainc (x, a(i), err); | |
2590 | |
2591 if (err) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2592 goto done; |
4844 | 2593 } |
2594 | |
2595 retval = result; | |
2596 | |
2597 done: | |
2598 | |
2599 return retval; | |
2600 } | |
2601 | |
2602 NDArray | |
2603 gammainc (const NDArray& x, double a) | |
2604 { | |
2605 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2606 octave_idx_type nel = dv.numel (); |
4844 | 2607 |
2608 NDArray retval; | |
2609 NDArray result (dv); | |
2610 | |
2611 bool err; | |
2612 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2613 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2614 { |
2615 result (i) = gammainc (x(i), a, err); | |
2616 | |
2617 if (err) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2618 goto done; |
4844 | 2619 } |
2620 | |
2621 retval = result; | |
2622 | |
2623 done: | |
2624 | |
2625 return retval; | |
2626 } | |
2627 | |
2628 NDArray | |
2629 gammainc (const NDArray& x, const NDArray& a) | |
2630 { | |
2631 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2632 octave_idx_type nel = dv.numel (); |
4844 | 2633 |
2634 NDArray retval; | |
2635 NDArray result; | |
2636 | |
2637 if (dv == a.dims ()) | |
2638 { | |
2639 result.resize (dv); | |
2640 | |
2641 bool err; | |
2642 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2643 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2644 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2645 result (i) = gammainc (x(i), a(i), err); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2646 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2647 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2648 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2649 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2650 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2651 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2652 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2653 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2654 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2655 std::string x_str = dv.str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2656 std::string a_str = a.dims ().str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2657 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2658 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2659 ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2660 x_str.c_str (), a_str. c_str ()); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2661 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2662 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2663 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2664 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2665 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2666 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2667 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2668 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2669 gammainc (float x, float a, bool& err) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2670 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2671 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2672 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2673 err = false; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2674 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2675 if (a < 0.0 || x < 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2676 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2677 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2678 ("gammainc: A and X must be non-negative"); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2679 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2680 err = true; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2681 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2682 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2683 F77_XFCN (xsgammainc, XSGAMMAINC, (a, x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2684 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2685 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2686 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2687 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2688 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2689 gammainc (float x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2690 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2691 octave_idx_type nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2692 octave_idx_type nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2693 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2694 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2695 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2696 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2697 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2698 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2699 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2700 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2701 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2702 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2703 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2704 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2705 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2706 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2707 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2708 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2709 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2710 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2711 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2712 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2713 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2714 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2715 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2716 gammainc (const FloatMatrix& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2717 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2718 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2719 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2720 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2721 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2722 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2723 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2724 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2725 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2726 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2727 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2728 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2729 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2730 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2731 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2732 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2733 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2734 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2735 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2736 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2737 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2738 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2739 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2740 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2741 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2742 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2743 gammainc (const FloatMatrix& x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2744 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2745 FloatMatrix result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2746 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2747 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2748 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2749 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2750 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2751 octave_idx_type a_nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2752 octave_idx_type a_nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2753 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2754 if (nr == a_nr && nc == a_nc) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2755 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2756 result.resize (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2757 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2758 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2759 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2760 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2761 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2762 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2763 result(i,j) = gammainc (x(i,j), a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2764 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2765 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2766 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2767 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2768 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2769 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2770 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2771 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2772 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2773 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)", |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2774 nr, nc, a_nr, a_nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2775 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2776 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2777 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2778 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2779 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2780 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2781 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2782 gammainc (float x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2783 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2784 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2785 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2786 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2787 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2788 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2789 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2790 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2791 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2792 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2793 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2794 result (i) = gammainc (x, a(i), err); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2795 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2796 if (err) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2797 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2798 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2799 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2800 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2801 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2802 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2803 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2804 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2805 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2806 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2807 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2808 gammainc (const FloatNDArray& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2809 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2810 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2811 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2812 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2813 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2814 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2815 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2816 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2817 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2818 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2819 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2820 result (i) = gammainc (x(i), a, err); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2821 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2822 if (err) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2823 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2824 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2825 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2826 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2827 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2828 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2829 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2830 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2831 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2832 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2833 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2834 gammainc (const FloatNDArray& x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2835 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2836 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2837 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2838 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2839 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2840 FloatNDArray result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2841 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2842 if (dv == a.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2843 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2844 result.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2845 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2846 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2847 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2848 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2849 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2850 result (i) = gammainc (x(i), a(i), err); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2851 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2852 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2853 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2854 } |
4844 | 2855 |
2856 retval = result; | |
2857 } | |
2858 else | |
2859 { | |
2860 std::string x_str = dv.str (); | |
2861 std::string a_str = a.dims ().str (); | |
2862 | |
2863 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2864 ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2865 x_str.c_str (), a_str.c_str ()); |
4844 | 2866 } |
2867 | |
2868 done: | |
2869 | |
2870 return retval; | |
2871 } | |
2872 | |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2873 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2874 Complex rc_log1p (double x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2875 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2876 const double pi = 3.14159265358979323846; |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2877 return x < -1.0 ? Complex (log (-(1.0 + x)), pi) : Complex (log1p (x)); |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2878 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2879 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2880 FloatComplex rc_log1p (float x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2881 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2882 const float pi = 3.14159265358979323846f; |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2883 return x < -1.0f ? FloatComplex (logf (-(1.0f + x)), pi) : FloatComplex (log1pf (x)); |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2884 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2885 |
9838 | 2886 // This algorithm is due to P. J. Acklam. |
9837
7c70084b125e
improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents:
9835
diff
changeset
|
2887 // See http://home.online.no/~pjacklam/notes/invnorm/ |
7c70084b125e
improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents:
9835
diff
changeset
|
2888 // The rational approximation has relative accuracy 1.15e-9 in the whole region. |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2889 // For doubles, it is refined by a single step of Halley's 3rd order method. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2890 // For single precision, the accuracy is already OK, so we skip it to get |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2891 // faster evaluation. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2892 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2893 static double do_erfinv (double x, bool refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2894 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2895 // Coefficients of rational approximation. |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2896 static const double a[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2897 { -2.806989788730439e+01, 1.562324844726888e+02, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2898 -1.951109208597547e+02, 9.783370457507161e+01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2899 -2.168328665628878e+01, 1.772453852905383e+00 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2900 static const double b[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2901 { -5.447609879822406e+01, 1.615858368580409e+02, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2902 -1.556989798598866e+02, 6.680131188771972e+01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2903 -1.328068155288572e+01 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2904 static const double c[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2905 { -5.504751339936943e-03, -2.279687217114118e-01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2906 -1.697592457770869e+00, -1.802933168781950e+00, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2907 3.093354679843505e+00, 2.077595676404383e+00 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2908 static const double d[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2909 { 7.784695709041462e-03, 3.224671290700398e-01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2910 2.445134137142996e+00, 3.754408661907416e+00 }; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2911 |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2912 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2913 static const double pbreak = 0.95150; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2914 double ax = fabs (x), y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2915 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2916 // Select case. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2917 if (ax <= pbreak) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2918 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2919 // Middle region. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2920 const double q = 0.5 * x, r = q*q; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2921 const double yn = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2922 const double yd = ((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2923 y = yn / yd; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2924 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2925 else if (ax < 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2926 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2927 // Tail region. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2928 const double q = sqrt (-2*log (0.5*(1-ax))); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2929 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2930 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2931 y = yn / yd * signum (-x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2932 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2933 else if (ax == 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2934 return octave_Inf * signum (x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2935 else |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2936 return octave_NaN; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2937 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2938 if (refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2939 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2940 // One iteration of Halley's method gives full precision. |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2941 double u = (erf (y) - x) * spi2 * exp (y*y); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2942 y -= u / (1 + y*u); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2943 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2944 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2945 return y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2946 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2947 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2948 double erfinv (double x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2949 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2950 return do_erfinv (x, true); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2951 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2952 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2953 float erfinv (float x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2954 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2955 return do_erfinv (x, false); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2956 } |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
2957 |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2958 // The algorthim for erfcinv is an adaptation of the erfinv algorithm above |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2959 // from P. J. Acklam. It has been modified to run over the different input |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2960 // domain of erfcinv. See the notes for erfinv for an explanation. |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2961 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2962 static double do_erfcinv (double x, bool refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2963 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2964 // Coefficients of rational approximation. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2965 static const double a[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2966 { -2.806989788730439e+01, 1.562324844726888e+02, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2967 -1.951109208597547e+02, 9.783370457507161e+01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2968 -2.168328665628878e+01, 1.772453852905383e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2969 static const double b[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2970 { -5.447609879822406e+01, 1.615858368580409e+02, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2971 -1.556989798598866e+02, 6.680131188771972e+01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2972 -1.328068155288572e+01 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2973 static const double c[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2974 { -5.504751339936943e-03, -2.279687217114118e-01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2975 -1.697592457770869e+00, -1.802933168781950e+00, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2976 3.093354679843505e+00, 2.077595676404383e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2977 static const double d[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2978 { 7.784695709041462e-03, 3.224671290700398e-01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2979 2.445134137142996e+00, 3.754408661907416e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2980 |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
2981 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2982 static const double pbreak_lo = 0.04850; // 1-pbreak |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2983 static const double pbreak_hi = 1.95150; // 1+pbreak |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2984 double y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2985 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2986 // Select case. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2987 if (x >= pbreak_lo && x <= pbreak_hi) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2988 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2989 // Middle region. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2990 const double q = 0.5*(1-x), r = q*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2991 const double yn = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2992 const double yd = ((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2993 y = yn / yd; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2994 } |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2995 else if (x > 0.0 && x < 2.0) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2996 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2997 // Tail region. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2998 const double q = x < 1 ? sqrt (-2*log (0.5*x)) : sqrt (-2*log (0.5*(2-x))); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2999 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3000 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3001 y = yn / yd; |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3002 if (x < pbreak_lo) |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3003 y = -y; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3004 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3005 else if (x == 0.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3006 return octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3007 else if (x == 2.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3008 return -octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3009 else |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3010 return octave_NaN; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3011 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3012 if (refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3013 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3014 // One iteration of Halley's method gives full precision. |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
3015 double u = (erf (y) - (1-x)) * spi2 * exp (y*y); |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3016 y -= u / (1 + y*u); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3017 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3018 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3019 return y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3020 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3021 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3022 double erfcinv (double x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3023 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3024 return do_erfcinv (x, true); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3025 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3026 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3027 float erfcinv (float x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3028 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3029 return do_erfcinv (x, false); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3030 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3031 |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3032 // Implementation based on the Fortran code by W.J.Cody |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3033 // see http://www.netlib.org/specfun/erf. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3034 // Templatized and simplified workflow. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3035 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3036 // FIXME: Maybe this should be globally visible. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3037 static inline float erfc (float x) { return erfcf (x); } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3038 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3039 template <class T> |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3040 static T |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3041 erfcx_impl (T x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3042 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3043 static const T c[] = |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3044 { |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3045 5.64188496988670089e-1,8.88314979438837594, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3046 6.61191906371416295e+1,2.98635138197400131e+2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3047 8.81952221241769090e+2,1.71204761263407058e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3048 2.05107837782607147e+3,1.23033935479799725e+3, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3049 2.15311535474403846e-8 |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3050 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3051 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3052 static const T d[] = |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3053 { |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3054 1.57449261107098347e+1,1.17693950891312499e+2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3055 5.37181101862009858e+2,1.62138957456669019e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3056 3.29079923573345963e+3,4.36261909014324716e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3057 3.43936767414372164e+3,1.23033935480374942e+3 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3058 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3059 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3060 static const T p[] = |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3061 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3062 3.05326634961232344e-1,3.60344899949804439e-1, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3063 1.25781726111229246e-1,1.60837851487422766e-2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3064 6.58749161529837803e-4,1.63153871373020978e-2 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3065 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3066 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3067 static const T q[] = |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3068 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3069 2.56852019228982242,1.87295284992346047, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3070 5.27905102951428412e-1,6.05183413124413191e-2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3071 2.33520497626869185e-3 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3072 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3073 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3074 static const T sqrpi = 5.6418958354775628695e-1; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3075 static const T xhuge = sqrt (1.0 / std::numeric_limits<T>::epsilon ()); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3076 static const T xneg = -sqrt (log (std::numeric_limits<T>::max ()/2.0)); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3077 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3078 double y = fabs (x), result; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3079 if (x < xneg) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3080 result = octave_Inf; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3081 else if (y <= 0.46875) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3082 result = std::exp (x*x) * erfc (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3083 else |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3084 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3085 if (y <= 4.0) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3086 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3087 double xnum = c[8]*y, xden = y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3088 for (int i = 0; i < 7; i++) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3089 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3090 xnum = (xnum + c[i]) * y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3091 xden = (xden + d[i]) * y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3092 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3093 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3094 result = (xnum + c[7]) / (xden + d[7]); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3095 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3096 else if (y <= xhuge) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3097 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3098 double y2 = 1/(y*y), xnum = p[5]*y2, xden = y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3099 for (int i = 0; i < 4; i++) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3100 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3101 xnum = (xnum + p[i]) * y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3102 xden = (xden + q[i]) * y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3103 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3104 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3105 result = y2 * (xnum + p[4]) / (xden + q[4]); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3106 result = (sqrpi - result) / y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3107 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3108 else |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3109 result = sqrpi / y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3110 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3111 // Fix up negative argument. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3112 if (x < 0) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3113 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3114 double y2 = ceil (x / 16.0) * 16.0, del = (x-y2)*(x+y2); |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
3115 result = 2*(std::exp (y2*y2) * std::exp (del)) - result; |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3116 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3117 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3118 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3119 return result; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3120 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3121 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3122 double erfcx (double x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3123 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3124 return erfcx_impl (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3125 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3126 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3127 float erfcx (float x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3128 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3129 return erfcx_impl (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3130 } |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3131 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3132 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3133 // Incomplete Beta function ratio |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3134 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3135 // Algorithm based on the one by John Burkardt. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3136 // See http://people.sc.fsu.edu/~jburkardt/cpp_src/asa109/asa109.html |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3137 // |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3138 // The original code is distributed under the GNU LGPL v3 license. |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3139 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3140 // Reference: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3141 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3142 // KL Majumder, GP Bhattacharjee, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3143 // Algorithm AS 63: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3144 // The incomplete Beta Integral, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3145 // Applied Statistics, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3146 // Volume 22, Number 3, 1973, pages 409-411. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3147 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3148 double |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3149 betain (double x, double p, double q, double beta, bool& err) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3150 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3151 double acu = 0.1E-14, ai, cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3152 bool indx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3153 int ns; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3154 double pp, psq, qq, rx, temp, term, value, xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3155 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3156 value = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3157 err = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3158 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3159 // Check the input arguments. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3160 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3161 if ((p <= 0.0 || q <= 0.0) || (x < 0.0 || 1.0 < x)) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3162 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3163 err = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3164 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3165 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3166 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3167 // Special cases. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3168 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3169 if (x == 0.0 || x == 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3170 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3171 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3172 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3173 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3174 // Change tail if necessary and determine S. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3175 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3176 psq = p + q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3177 cx = 1.0 - x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3178 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3179 if (p < psq * x) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3180 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3181 xx = cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3182 cx = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3183 pp = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3184 qq = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3185 indx = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3186 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3187 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3188 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3189 xx = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3190 pp = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3191 qq = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3192 indx = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3193 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3194 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3195 term = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3196 ai = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3197 value = 1.0; |
15217
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3198 ns = static_cast<int> (qq + cx * psq); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3199 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3200 // Use the Soper reduction formula. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3201 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3202 rx = xx / cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3203 temp = qq - ai; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3204 if (ns == 0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3205 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3206 rx = xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3207 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3208 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3209 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3210 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3211 term = term * temp * rx / (pp + ai); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3212 value = value + term; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3213 temp = fabs (term); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3214 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3215 if (temp <= acu && temp <= acu * value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3216 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3217 value = value * exp (pp * log (xx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3218 + (qq - 1.0) * log (cx) - beta) / pp; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3219 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3220 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3221 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3222 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3223 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3224 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3225 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3226 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3227 ai = ai + 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3228 ns = ns - 1; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3229 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3230 if (0 <= ns) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3231 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3232 temp = qq - ai; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3233 if (ns == 0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3234 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3235 rx = xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3236 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3237 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3238 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3239 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3240 temp = psq; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3241 psq = psq + 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3242 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3243 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3244 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3245 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3246 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3247 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3248 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3249 // Inverse of the incomplete Beta function |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3250 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3251 // Algorithm based on the one by John Burkardt. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3252 // See http://people.sc.fsu.edu/~jburkardt/cpp_src/asa109/asa109.html |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3253 // |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3254 // The original code is distributed under the GNU LGPL v3 license. |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3255 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3256 // Reference: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3257 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3258 // GW Cran, KJ Martin, GE Thomas, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3259 // Remark AS R19 and Algorithm AS 109: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3260 // A Remark on Algorithms AS 63: The Incomplete Beta Integral |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3261 // and AS 64: Inverse of the Incomplete Beta Integeral, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3262 // Applied Statistics, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3263 // Volume 26, Number 1, 1977, pages 111-114. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3264 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3265 double |
15217
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3266 betaincinv (double y, double p, double q) |
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3267 { |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3268 double a, acu, adj, fpu, g, h; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3269 int iex; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3270 bool indx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3271 double pp, prev, qq, r, s, sae = -37.0, sq, t, tx, value, w, xin, ycur, yprev; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3272 |
14847
bcf86cc2f1ee
Use xlgamma instead of lgamma in betaincinv for portability across systems.
Rik <octave@nomad.inbox5.com>
parents:
14846
diff
changeset
|
3273 double beta = xlgamma (p) + xlgamma (q) - xlgamma (p + q); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3274 bool err = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3275 fpu = pow (10.0, sae); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3276 value = y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3277 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3278 // Test for admissibility of parameters. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3279 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3280 if (p <= 0.0 || q <= 0.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3281 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3282 (*current_liboctave_error_handler) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3283 ("betaincinv: wrong parameters"); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3284 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3285 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3286 if (y < 0.0 || 1.0 < y) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3287 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3288 (*current_liboctave_error_handler) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3289 ("betaincinv: wrong parameter Y"); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3290 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3291 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3292 if (y == 0.0 || y == 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3293 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3294 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3295 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3296 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3297 // Change tail if necessary. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3298 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3299 if (0.5 < y) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3300 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3301 a = 1.0 - y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3302 pp = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3303 qq = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3304 indx = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3305 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3306 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3307 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3308 a = y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3309 pp = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3310 qq = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3311 indx = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3312 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3313 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3314 // Calculate the initial approximation. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3315 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3316 r = sqrt (- log (a * a)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3317 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3318 ycur = r - (2.30753 + 0.27061 * r) / (1.0 + (0.99229 + 0.04481 * r) * r); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3319 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3320 if (1.0 < pp && 1.0 < qq) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3321 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3322 r = (ycur * ycur - 3.0) / 6.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3323 s = 1.0 / (pp + pp - 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3324 t = 1.0 / (qq + qq - 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3325 h = 2.0 / (s + t); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3326 w = ycur * sqrt (h + r) / h - (t - s) * (r + 5.0 / 6.0 - 2.0 / (3.0 * h)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3327 value = pp / (pp + qq * exp (w + w)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3328 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3329 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3330 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3331 r = qq + qq; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3332 t = 1.0 / (9.0 * qq); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3333 t = r * pow (1.0 - t + ycur * sqrt (t), 3); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3334 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3335 if (t <= 0.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3336 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3337 value = 1.0 - exp ((log ((1.0 - a) * qq) + beta) / qq); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3338 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3339 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3340 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3341 t = (4.0 * pp + r - 2.0) / t; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3342 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3343 if (t <= 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3344 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3345 value = exp ((log (a * pp) + beta) / pp); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3346 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3347 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3348 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3349 value = 1.0 - 2.0 / (t + 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3350 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3351 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3352 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3353 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3354 // Solve for X by a modified Newton-Raphson method, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3355 // using the function BETAIN. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3356 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3357 r = 1.0 - pp; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3358 t = 1.0 - qq; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3359 yprev = 0.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3360 sq = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3361 prev = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3362 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3363 if (value < 0.0001) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3364 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3365 value = 0.0001; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3366 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3367 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3368 if (0.9999 < value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3369 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3370 value = 0.9999; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3371 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3372 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3373 iex = std::max (- 5.0 / pp / pp - 1.0 / pow (a, 0.2) - 13.0, sae); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3374 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3375 acu = pow (10.0, iex); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3376 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3377 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3378 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3379 ycur = betain (value, pp, qq, beta, err); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3380 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3381 if (err) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3382 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3383 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3384 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3385 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3386 xin = value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3387 ycur = (ycur - a) * exp (beta + r * log (xin) + t * log (1.0 - xin)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3388 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3389 if (ycur * yprev <= 0.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3390 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3391 prev = std::max (sq, fpu); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3392 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3393 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3394 g = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3395 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3396 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3397 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3398 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3399 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3400 adj = g * ycur; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3401 sq = adj * adj; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3402 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3403 if (sq < prev) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3404 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3405 tx = value - adj; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3406 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3407 if (0.0 <= tx && tx <= 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3408 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3409 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3410 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3411 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3412 g = g / 3.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3413 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3414 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3415 if (prev <= acu) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3416 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3417 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3418 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3419 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3420 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3421 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3422 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3423 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3424 if (ycur * ycur <= acu) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3425 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3426 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3427 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3428 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3429 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3430 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3431 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3432 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3433 if (tx != 0.0 && tx != 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3434 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3435 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3436 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3437 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3438 g = g / 3.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3439 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3440 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3441 if (tx == value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3442 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3443 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3444 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3445 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3446 value = tx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3447 yprev = ycur; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3448 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3449 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3450 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3451 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3452 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3453 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3454 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3455 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3456 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3457 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3458 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3459 betaincinv (double x, double a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3460 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3461 dim_vector dv = b.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3462 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3463 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3464 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3465 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3466 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3467 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3468 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3469 *pretval++ = betaincinv (x, a, b(i)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3470 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3471 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3472 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3473 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3474 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3475 betaincinv (double x, const Array<double>& a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3476 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3477 dim_vector dv = a.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3478 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3479 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3480 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3481 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3482 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3483 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3484 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3485 *pretval++ = betaincinv (x, a(i), b); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3486 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3487 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3488 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3489 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3490 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3491 betaincinv (double x, const Array<double>& a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3492 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3493 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3494 dim_vector dv = a.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3495 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3496 if (dv == b.dims ()) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3497 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3498 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3499 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3500 retval.resize (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3501 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3502 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3503 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3504 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3505 *pretval++ = betaincinv (x, a(i), b(i)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3506 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3507 else |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3508 gripe_betaincinv_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3509 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3510 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3511 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3512 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3513 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3514 betaincinv (const Array<double>& x, double a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3515 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3516 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3517 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3518 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3519 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3520 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3521 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3522 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3523 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3524 *pretval++ = betaincinv (x(i), a, b); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3525 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3526 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3527 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3528 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3529 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3530 betaincinv (const Array<double>& x, double a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3531 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3532 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3533 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3534 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3535 if (dv == b.dims ()) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3536 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3537 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3538 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3539 retval.resize (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3540 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3541 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3542 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3543 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3544 *pretval++ = betaincinv (x(i), a, b(i)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3545 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3546 else |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3547 gripe_betaincinv_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3548 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3549 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3550 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3551 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3552 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3553 betaincinv (const Array<double>& x, const Array<double>& a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3554 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3555 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3556 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3557 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3558 if (dv == a.dims ()) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3559 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3560 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3561 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3562 retval.resize (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3563 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3564 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3565 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3566 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3567 *pretval++ = betaincinv (x(i), a(i), b); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3568 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3569 else |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3570 gripe_betaincinv_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3571 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3572 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3573 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3574 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3575 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3576 betaincinv (const Array<double>& x, const Array<double>& a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3577 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3578 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3579 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3580 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3581 if (dv == a.dims () && dv == b.dims ()) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3582 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3583 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3584 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3585 retval.resize (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3586 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3587 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3588 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3589 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3590 *pretval++ = betaincinv (x(i), a(i), b(i)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3591 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3592 else |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3593 gripe_betaincinv_nonconformant (dv, a.dims (), b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3594 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3595 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3596 } |