Mercurial > octave
changeset 25779:672ee8a65472
maint: remove dead code used in older betainc and gammainc implementations
* lo-slatec-proto.h: Delete prototypes for already deleted functions.
* lo-specfun.h: Likewise.
* gammainc.cc: Delete.
author | Mike Miller <mtmiller@octave.org> |
---|---|
date | Mon, 13 Aug 2018 10:44:16 -0700 |
parents | 4e658452f6c7 |
children | 7c5956c45a29 |
files | libinterp/corefcn/gammainc.cc liboctave/numeric/lo-slatec-proto.h liboctave/numeric/lo-specfun.h |
diffstat | 3 files changed, 0 insertions(+), 265 deletions(-) [+] |
line wrap: on
line diff
--- a/libinterp/corefcn/gammainc.cc Mon Aug 13 11:16:34 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,213 +0,0 @@ -/* - -Copyright (C) 1997-2018 John W. Eaton - -This file is part of Octave. - -Octave is free software: you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -Octave is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -<https://www.gnu.org/licenses/>. - -*/ - -#if defined (HAVE_CONFIG_H) -# include "config.h" -#endif - -#include "lo-specfun.h" - -#include "defun.h" -#include "error.h" -#include "errwarn.h" -#include "ovl.h" -#include "utils.h" - -DEFUN (gammainc, args, , - doc: /* -*- texinfo -*- -@deftypefn {} {} gammainc (@var{x}, @var{a}) -@deftypefnx {} {} gammainc (@var{x}, @var{a}, "lower") -@deftypefnx {} {} gammainc (@var{x}, @var{a}, "upper") -Compute the normalized incomplete gamma function. - -This is defined as -@tex -$$ - \gamma (x, a) = {1 \over {\Gamma (a)}}\displaystyle{\int_0^x t^{a-1} e^{-t} dt} -$$ -@end tex -@ifnottex - -@example -@group - x - 1 / -gammainc (x, a) = --------- | exp (-t) t^(a-1) dt - gamma (a) / - t=0 -@end group -@end example - -@end ifnottex -with the limiting value of 1 as @var{x} approaches infinity. -The standard notation is @math{P(a,x)}, e.g., @nospell{Abramowitz} and -@nospell{Stegun} (6.5.1). - -If @var{a} is scalar, then @code{gammainc (@var{x}, @var{a})} is returned -for each element of @var{x} and vice versa. - -If neither @var{x} nor @var{a} is scalar, the sizes of @var{x} and -@var{a} must agree, and @code{gammainc} is applied element-by-element. - -By default the incomplete gamma function integrated from 0 to @var{x} is -computed. If @qcode{"upper"} is given then the complementary function -integrated from @var{x} to infinity is calculated. It should be noted that - -@example -gammainc (@var{x}, @var{a}) @equiv{} 1 - gammainc (@var{x}, @var{a}, "upper") -@end example -@seealso{gamma, gammaln} -@end deftypefn */) -{ - int nargin = args.length (); - - if (nargin < 2 || nargin > 3) - print_usage (); - - bool lower = true; - if (nargin == 3) - { - std::string s = args(2).xstring_value (R"(gammainc: third argument must be "lower" or "upper")"); - - std::transform (s.begin (), s.end (), s.begin (), tolower); - - if (s == "upper") - lower = false; - else if (s == "lower") - lower = true; - else - error (R"(gammainc: third argument must be "lower" or "upper")"); - } - - octave_value retval; - - octave_value x_arg = args(0); - octave_value a_arg = args(1); - - // FIXME: Can we make a template version of the duplicated code below - if (x_arg.is_single_type () || a_arg.is_single_type ()) - { - if (x_arg.is_scalar_type ()) - { - float x = x_arg.float_value (); - - if (a_arg.is_scalar_type ()) - { - float a = a_arg.float_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0f - octave::math::gammainc (x, a)); - } - else - { - FloatNDArray a = a_arg.float_array_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0f - octave::math::gammainc (x, a)); - } - } - else - { - FloatNDArray x = x_arg.float_array_value (); - - if (a_arg.is_scalar_type ()) - { - float a = a_arg.float_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0f - octave::math::gammainc (x, a)); - } - else - { - FloatNDArray a = a_arg.float_array_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0f - octave::math::gammainc (x, a)); - } - } - } - else - { - if (x_arg.is_scalar_type ()) - { - double x = x_arg.double_value (); - - if (a_arg.is_scalar_type ()) - { - double a = a_arg.double_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0 - octave::math::gammainc (x, a)); - } - else - { - NDArray a = a_arg.array_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0 - octave::math::gammainc (x, a)); - } - } - else - { - NDArray x = x_arg.array_value (); - - if (a_arg.is_scalar_type ()) - { - double a = a_arg.double_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0 - octave::math::gammainc (x, a)); - } - else - { - NDArray a = a_arg.array_value (); - - retval = (lower ? octave::math::gammainc (x, a) - : 1.0 - octave::math::gammainc (x, a)); - } - } - } - - return retval; -} - -/* -%!test -%! a = [.5 .5 .5 .5 .5]; -%! x = [0 1 2 3 4]; -%! v1 = sqrt (pi)*erf (x)./gamma (a); -%! v3 = gammainc (x.*x, a); -%! assert (v1, v3, sqrt (eps)); - -%!assert (gammainc (0:4,0.5, "upper"), 1-gammainc (0:4,0.5), 1e-10) - -%!test -%! a = single ([.5 .5 .5 .5 .5]); -%! x = single ([0 1 2 3 4]); -%! v1 = sqrt (pi ("single"))*erf (x)./gamma (a); -%! v3 = gammainc (x.*x, a); -%! assert (v1, v3, sqrt (eps ("single"))); - -%!assert (gammainc (single (0:4), single (0.5), "upper"), -%! single (1)-gammainc (single (0:4), single (0.5)), -%! single (1e-7)) -*/
--- a/liboctave/numeric/lo-slatec-proto.h Mon Aug 13 11:16:34 2018 -0400 +++ b/liboctave/numeric/lo-slatec-proto.h Mon Aug 13 10:44:16 2018 -0700 @@ -29,26 +29,6 @@ extern "C" { - // BETAI - - F77_RET_T - F77_FUNC (xbetai, XBETAI) (const F77_REAL&, const F77_REAL&, - const F77_REAL&, F77_REAL&); - - F77_RET_T - F77_FUNC (xdbetai, XDBETAI) (const F77_DBLE&, const F77_DBLE&, - const F77_DBLE&, F77_DBLE&); - - // GAMMAINC - - F77_RET_T - F77_FUNC (xgammainc, XGAMMAINC) (const F77_DBLE&, const F77_DBLE&, - F77_DBLE&); - - F77_RET_T - F77_FUNC (xsgammainc, XSGAMMAINC) (const F77_REAL&, const F77_REAL&, - F77_REAL&); - // PCHIM F77_RET_T
--- a/liboctave/numeric/lo-specfun.h Mon Aug 13 11:16:34 2018 -0400 +++ b/liboctave/numeric/lo-specfun.h Mon Aug 13 10:44:16 2018 -0700 @@ -342,38 +342,6 @@ extern OCTAVE_API double gamma (double x); extern OCTAVE_API float gamma (float x); - extern OCTAVE_API double gammainc (double x, double a, bool& err); - inline double gammainc (double x, double a) - { - bool err; - return gammainc (x, a, err); - } - - extern OCTAVE_API Matrix gammainc (double x, const Matrix& a); - extern OCTAVE_API Matrix gammainc (const Matrix& x, double a); - extern OCTAVE_API Matrix gammainc (const Matrix& x, const Matrix& a); - - extern OCTAVE_API NDArray gammainc (double x, const NDArray& a); - extern OCTAVE_API NDArray gammainc (const NDArray& x, double a); - extern OCTAVE_API NDArray gammainc (const NDArray& x, const NDArray& a); - - extern OCTAVE_API float gammainc (float x, float a, bool& err); - inline float gammainc (float x, float a) - { - bool err; - return gammainc (x, a, err); - } - - extern OCTAVE_API FloatMatrix gammainc (float x, const FloatMatrix& a); - extern OCTAVE_API FloatMatrix gammainc (const FloatMatrix& x, float a); - extern OCTAVE_API FloatMatrix gammainc (const FloatMatrix& x, - const FloatMatrix& a); - - extern OCTAVE_API FloatNDArray gammainc (float x, const FloatNDArray& a); - extern OCTAVE_API FloatNDArray gammainc (const FloatNDArray& x, float a); - extern OCTAVE_API FloatNDArray gammainc (const FloatNDArray& x, - const FloatNDArray& a); - inline double lgamma (double x) { return std::lgamma (x); } inline float lgamma (float x) { return std::lgammaf (x); }