GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
__betainc__.cc
Go to the documentation of this file.
1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 2018-2021 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 "dNDArray.h"
32 #include "fNDArray.h"
33 
34 DEFUN (__betainc__, args, ,
35  doc: /* -*- texinfo -*-
36 @deftypefn {} {@var{y} =} __betainc__ (@var{x}, @var{a}, @var{b})
37 Continued fraction for incomplete beta function.
38 @end deftypefn */)
39 {
40  int nargin = args.length ();
41 
42  if (nargin != 3)
43  print_usage ();
44 
45  bool is_single = (args(0).is_single_type () || args(1).is_single_type ()
46  || args(2).is_single_type ());
47 
48  // Total number of scenarios: get maximum of length of all vectors
49  int numel_x = args(0).numel ();
50  int numel_a = args(1).numel ();
51  int numel_b = args(2).numel ();
52  int len = std::max (std::max (numel_x, numel_a), numel_b);
53 
55  // Initialize output dimension vector
56  dim_vector output_dv (len, 1);
57 
58  // Lentz's algorithm in two cases: single and double precision
59  if (is_single)
60  {
61  // Initialize output and inputs
62  FloatColumnVector output (output_dv);
63  FloatNDArray x, a, b;
64 
65  if (numel_x == 1)
66  x = FloatNDArray (output_dv, args(0).float_scalar_value ());
67  else
68  x = args(0).float_array_value ();
69 
70 
71  if (numel_a == 1)
72  a = FloatNDArray (output_dv, args(1).float_scalar_value ());
73  else
74  a = args(1).float_array_value ();
75 
76  if (numel_b == 1)
77  b = FloatNDArray (output_dv, args(2).float_scalar_value ());
78  else
79  b = args(2).float_array_value ();
80 
81  // Initialize variables used in algorithm
82  static const float tiny = octave::math::exp2 (-50.0f);
83  static const float eps = std::numeric_limits<float>::epsilon ();
84  float xj, x2, y, Cj, Dj, aj, bj, Deltaj, alpha_j, beta_j;
85  int j, maxit;
86  maxit = 200;
87 
88  // Loop over all elements
89  for (octave_idx_type i = 0; i < len; ++i)
90  {
91  // Catch Ctrl+C
93 
94  // Variable initialization for the current element
95  xj = x(i);
96  y = tiny;
97  Cj = y;
98  Dj = 0;
99  aj = a(i);
100  bj = b(i);
101  Deltaj = 0;
102  alpha_j = 1;
103  beta_j = aj - (aj * (aj + bj)) / (aj + 1) * xj;
104  x2 = xj * xj;
105  j = 1;
106 
107  // Lentz's algorithm
108  while ((std::abs ((Deltaj - 1)) > eps) && (j < maxit))
109  {
110  Dj = beta_j + alpha_j * Dj;
111  if (Dj == 0)
112  Dj = tiny;
113  Cj = beta_j + alpha_j / Cj;
114  if (Cj == 0)
115  Cj = tiny;
116  Dj = 1 / Dj;
117  Deltaj = Cj * Dj;
118  y *= Deltaj;
119  alpha_j = ((aj + j - 1) * (aj + bj + j -1) * (bj - j) * j)
120  / ((aj + 2 * j - 1) * (aj + 2 * j - 1)) * x2;
121  beta_j = aj + 2 * j + ((j * (bj - j)) / (aj + 2 * j - 1)
122  - ((aj + j) * (aj + bj + j)) / (aj + 2 * j + 1)) * xj;
123  j++;
124  }
125 
126  output(i) = y;
127  }
128 
129  retval(0) = output;
130  }
131  else
132  {
133  // Initialize output and inputs
134  ColumnVector output (output_dv);
135  NDArray x, a, b;
136 
137  if (numel_x == 1)
138  x = NDArray (output_dv, args(0).scalar_value ());
139  else
140  x = args(0).array_value ();
141 
142  if (numel_a == 1)
143  a = NDArray (output_dv, args(1).scalar_value ());
144  else
145  a = args(1).array_value ();
146 
147  if (numel_b == 1)
148  b = NDArray (output_dv, args(2).scalar_value ());
149  else
150  b = args(2).array_value ();
151 
152  // Initialize variables used in algorithm
153  static const double tiny = octave::math::exp2 (-100.0);
154  static const double eps = std::numeric_limits<double>::epsilon ();
155  double xj, x2, y, Cj, Dj, aj, bj, Deltaj, alpha_j, beta_j;
156  int j, maxit;
157  maxit = 200;
158 
159  // Loop over all elements
160  for (octave_idx_type i = 0; i < len; ++i)
161  {
162  // Catch Ctrl+C
163  OCTAVE_QUIT;
164 
165  // Variable initialization for the current element
166  xj = x(i);
167  y = tiny;
168  Cj = y;
169  Dj = 0;
170  aj = a(i);
171  bj = b(i);
172  Deltaj = 0;
173  alpha_j = 1;
174  beta_j = aj - (aj * (aj + bj)) / (aj + 1) * xj;
175  x2 = xj * xj;
176  j = 1;
177 
178  // Lentz's algorithm
179  while ((std::abs ((Deltaj - 1)) > eps) && (j < maxit))
180  {
181  Dj = beta_j + alpha_j * Dj;
182  if (Dj == 0)
183  Dj = tiny;
184  Cj = beta_j + alpha_j / Cj;
185  if (Cj == 0)
186  Cj = tiny;
187  Dj = 1 / Dj;
188  Deltaj = Cj * Dj;
189  y *= Deltaj;
190  alpha_j = ((aj + j - 1) * (aj + bj + j - 1) * (bj - j) * j)
191  / ((aj + 2 * j - 1) * (aj + 2 * j - 1)) * x2;
192  beta_j = aj + 2 * j + ((j * (bj - j)) / (aj + 2 * j - 1)
193  - ((aj + j) * (aj + bj + j)) / (aj + 2 * j + 1)) * xj;
194  j++;
195  }
196 
197  output(i) = y;
198  }
199 
200  retval(0) = output;
201  }
202 
203  return retval;
204 }
charNDArray max(char d, const charNDArray &m)
Definition: chNDArray.cc:230
Vector representing the dimensions (size) of an Array.
Definition: dim-vector.h:95
T eps(const T &x)
Definition: data.cc:4578
OCTINTERP_API void print_usage(void)
Definition: defun.cc:53
#define DEFUN(name, args_name, nargout_name, doc)
Macro to define a builtin function.
Definition: defun.h:56
F77_RET_T const F77_DBLE * x
double exp2(double x)
Definition: lo-mappers.h:98
octave_value::octave_value(const Array< char > &chm, char type) return retval
Definition: ov.cc:811
static T abs(T x)
Definition: pr-output.cc:1678
#define OCTAVE_QUIT
Definition: quit.h:261
F77_RET_T len
Definition: xerbla.cc:61