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