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