GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
__expint__.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2018 Michele Ginesi
4 
5 This file is part of Octave.
6 
7 Octave is free software: you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11 
12 Octave is distributed in the hope that it will be useful, but
13 WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <https://www.gnu.org/licenses/>.
20 
21 */
22 
23 #if defined (HAVE_CONFIG_H)
24 # include "config.h"
25 #endif
26 
27 #include "CNDArray.h"
28 #include "defun.h"
29 #include "fCNDArray.h"
30 
31 DEFUN (__expint__, args, ,
32  doc: /* -*- texinfo -*-
33 @deftypefn {} {@var{y} =} __expint__ (@var{x})
34 Continued fraction expansion for the exponential integral.
35 @end deftypefn */)
36 {
37  int nargin = args.length ();
38 
39  if (nargin != 1)
40  print_usage ();
41 
43 
44  bool is_single = args(0).is_single_type ();
45 
46  int numel_x = args(0).numel ();
47 
48  // Initialize output dimension vector
49  dim_vector output_dv (numel_x, 1);
50 
51  // Lentz's algorithm in two cases: single and double precision
52  if (is_single)
53  {
54  // Initialize output and inputs
55  FloatComplexColumnVector output (output_dv);
57 
58  if (numel_x == 1)
59  x = FloatComplexNDArray (output_dv, args(0).float_complex_value ());
60  else
61  x = args(0).float_complex_array_value ();
62 
63  // Initialize variables used in algorithm
64  static const FloatComplex tiny = octave::math::exp2 (-50.0f);
65  static const float eps = std::numeric_limits<float>::epsilon ();
66  const FloatComplex cone (1.0, 0.0);
67  const FloatComplex czero (0.0, 0.0);
68  const int maxit = 100;
69 
70  // Loop over all elements
71  for (octave_idx_type i = 0; i < numel_x; ++i)
72  {
73  // Catch Ctrl+C
75 
76  // Variable initialization for the current element
77  FloatComplex xj = x(i);
78  FloatComplex y = tiny;
79  FloatComplex Cj = y;
80  FloatComplex Dj = czero;
81  FloatComplex alpha_j = cone;
82  FloatComplex beta_j = xj;
83  FloatComplex Deltaj = czero;
84  int j = 1;
85 
86  // Lentz's algorithm
87  while ((std::abs (Deltaj - cone) > eps) && (j < maxit))
88  {
89  Dj = beta_j + alpha_j * Dj;
90  if (Dj == czero)
91  Dj = tiny;
92  Cj = beta_j + alpha_j / Cj;
93  if (Cj == czero)
94  Cj = tiny;
95  Dj = cone / Dj;
96  Deltaj = Cj * Dj;
97  y *= Deltaj;
98  alpha_j = (j + 1) / 2;
99  if ((j % 2) == 0)
100  beta_j = xj;
101  else
102  beta_j = cone;
103  j++;
104  }
105 
106  output(i) = y;
107  }
108  retval(0) = output;
109  }
110  else
111  {
112  // Initialize output and inputs
113  ComplexColumnVector output (output_dv);
115 
116  if (numel_x == 1)
117  x = ComplexNDArray (output_dv, args(0).complex_value ());
118  else
119  x = args(0).complex_array_value ();
120 
121  // Initialize variables used in algorithm
122  static const Complex tiny = octave::math::exp2 (-100.0);
123  static const double eps = std::numeric_limits<double>::epsilon ();
124  const Complex cone (1.0, 0.0);
125  const Complex czero (0.0, 0.0);
126  const int maxit = 200;
127 
128  // Loop over all scenarios
129  for (octave_idx_type i = 0; i < numel_x; ++i)
130  {
131  // Catch Ctrl+C
132  OCTAVE_QUIT;
133 
134  // Variable initialization for the current element
135  Complex xj = x(i);
136  Complex y = tiny;
137  Complex Cj = y;
138  Complex Dj = czero;
139  Complex alpha_j = cone;
140  Complex beta_j = xj;
141  Complex Deltaj = czero;
142  int j = 1;
143 
144  // Lentz's algorithm
145  while ((std::abs (Deltaj - cone) > eps) && (j < maxit))
146  {
147  Dj = beta_j + alpha_j * Dj;
148  if (Dj == czero)
149  Dj = tiny;
150  Cj = beta_j + alpha_j / Cj;
151  if (Cj == czero)
152  Cj = tiny;
153  Dj = cone / Dj;
154  Deltaj = Cj * Dj;
155  y *= Deltaj;
156  alpha_j = (j + 1) / 2;
157  if ((j % 2) == 0)
158  beta_j = xj;
159  else
160  beta_j = cone;
161  j++;
162  }
163 
164  output(i) = y;
165  }
166 
167  retval(0) = output;
168  }
169 
170  return retval;
171 }
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
bool is_single_type(void) const
Definition: ov.h:651
octave_value retval
Definition: data.cc:6246
#define eps(C)
double exp2(double x)
Definition: lo-mappers.h:107
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
std::complex< float > FloatComplex
Definition: oct-cmplx.h:32
std::complex< double > Complex
Definition: oct-cmplx.h:31
#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