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