GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
__gammainc__.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2017-2018 Nir Krakauer
4 Copyright (C) 2018 Michele Ginesi
5 Copyright (C) 2018 Stefan Schlögl
6 
7 This file is part of Octave.
8 
9 Octave is free software: you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13 
14 Octave is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18 
19 You should have received a copy of the GNU General Public License
20 along with Octave; see the file COPYING. If not, see
21 <https://www.gnu.org/licenses/>.
22 
23 */
24 
25 #if defined (HAVE_CONFIG_H)
26 # include "config.h"
27 #endif
28 
29 #include "defun.h"
30 #include "fNDArray.h"
31 
32 DEFUN (__gammainc__, args, ,
33  doc: /* -*- texinfo -*-
34 @deftypefn {} {@var{y} =} __gammainc__ (@var{x}, @var{a})
35 Continued fraction for incomplete gamma function.
36 @end deftypefn */)
37 {
38  int nargin = args.length ();
39 
40  if (nargin != 2)
41  print_usage ();
42 
43  bool is_single = args(0).is_single_type () || args(1).is_single_type ();
44 
45  // Total number of scenarios: get maximum of length of all vectors
46  int numel_x = args(0).numel ();
47  int numel_a = args(1).numel ();
48  int len = std::max (numel_x, numel_a);
49 
51  // Initialize output dimension vector
52  dim_vector output_dv (len, 1);
53 
54  // Lentz's algorithm in two cases: single and double precision
55  if (is_single)
56  {
57  // Initialize output and inputs
58  FloatColumnVector output (output_dv);
59  FloatNDArray x, a;
60 
61  if (numel_x == 1)
62  x = FloatNDArray (output_dv, args(0).float_scalar_value ());
63  else
64  x = args(0).float_array_value ();
65 
66  if (numel_a == 1)
67  a = FloatNDArray (output_dv, args(1).float_scalar_value ());
68  else
69  a = args(1).float_array_value ();
70 
71  // Initialize variables used in algorithm
72  static const float tiny = octave::math::exp2 (-50.0f);
73  static const float eps = std::numeric_limits<float>::epsilon();
74  float y, Cj, Dj, bj, aj, Deltaj;
75  int j, maxit;
76  maxit = 200;
77 
78  // Loop over all elements
79  for (octave_idx_type i = 0; i < len; ++i)
80  {
81  // Catch Ctrl+C
83 
84  // Variable initialization for the current element
85  y = tiny;
86  Cj = y;
87  Dj = 0;
88  bj = x(i) - a(i) + 1;
89  aj = a(i);
90  Deltaj = 0;
91  j = 1;
92 
93  // Lentz's algorithm
94  while ((std::abs ((Deltaj - 1) / y) > eps) && (j < maxit))
95  {
96  Cj = bj + aj/Cj;
97  Dj = 1 / (bj + aj*Dj);
98  Deltaj = Cj * Dj;
99  y *= Deltaj;
100  bj += 2;
101  aj = j * (a(i) - j);
102  j++;
103  }
104 
105  output(i) = y;
106  }
107 
108  retval(0) = output;
109  }
110  else
111  {
112  // Initialize output and inputs
113  ColumnVector output (output_dv);
114  NDArray x, a;
115 
116  if (numel_x == 1)
117  x = NDArray (output_dv, args(0).scalar_value ());
118  else
119  x = args(0).array_value ();
120 
121  if (numel_a == 1)
122  a = NDArray (output_dv, args(1).scalar_value ());
123  else
124  a = args(1).array_value ();
125 
126  // Initialize variables used in algorithm
127  static const double tiny = octave::math::exp2 (-100.0);
128  static const double eps = std::numeric_limits<double>::epsilon();
129  double y, Cj, Dj, bj, aj, Deltaj;
130  int j, maxit;
131  maxit = 200;
132 
133  // Loop over all elements
134  for (octave_idx_type i = 0; i < len; ++i)
135  {
136  // Catch Ctrl+C
137  OCTAVE_QUIT;
138 
139  // Variable initialization for the current element
140  y = tiny;
141  Cj = y;
142  Dj = 0;
143  bj = x(i) - a(i) + 1;
144  aj = a(i);
145  Deltaj = 0;
146  j = 1;
147 
148  // Lentz's algorithm
149  while ((std::abs ((Deltaj - 1) / y) > eps) && (j < maxit))
150  {
151  Cj = bj + aj/Cj;
152  Dj = 1 / (bj + aj*Dj);
153  Deltaj = Cj * Dj;
154  y *= Deltaj;
155  bj += 2;
156  aj = j * (a(i) - j);
157  j++;
158  }
159 
160  output(i) = y;
161  }
162 
163  retval(0) = output;
164  }
165 
166  return retval;
167 }
OCTINTERP_API void print_usage(void)
Definition: defun.cc:54
F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE * f
#define DEFUN(name, args_name, nargout_name, doc)
Macro to define a builtin function.
Definition: defun.h:53
static T abs(T x)
Definition: pr-output.cc:1696
calling an anonymous function involves an overhead quite comparable to the overhead of an m file function Passing a handle to a built in function is because the interpreter is not involved in the internal loop For a
Definition: cellfun.cc:400
octave_value retval
Definition: data.cc:6246
#define eps(C)
double exp2(double x)
Definition: lo-mappers.h:107
charNDArray max(char d, const charNDArray &m)
Definition: chNDArray.cc:227
the element is set to zero In other the statement xample y
Definition: data.cc:5264
args.length() nargin
Definition: file-io.cc:589
for i
Definition: data.cc:5264
#define OCTAVE_QUIT
Definition: quit.h:193
Vector representing the dimensions (size) of an Array.
Definition: dim-vector.h:87
F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T const F77_DBLE * x