doc/examples/lanczos.cpp

   1 /*
   2  * This program can be used to find the coefficients needed to approximate
   3  * the gamma function using the Lanczos approximation.
   4  *
   5  * Usage: lanczos -n order -D digits
   6  *
   7  * The order defaults to 10. digits defaults to GiNaCs default.
   8  * It is recommended to run the program several times with an increasing
   9  * value for digits until numerically stablilty for the values has been
  10  * reached. The program will also print the number of digits for which
  11  * the approximation is still reliable. This will be lower then the
  12  * number of digits given at command line. It is determined by comparing
  13  * Gamma(1/2) to sqrt(Pi). Note that the program may crash if the number of
  14  * digits is unreasonably small for the given order. Another thing that
  15  * can happen if the number of digits is too small is that the program will
  16  * print "Forget it, this is waaaaaaay too inaccurate." at the top of the
  17  * output.
  18  *
  19  * The gamma function can be (for real_part(z) > -1/2) calculated using
  20  *
  21  *    Gamma(z+1) = sqrt(2*Pi)*power(z+g+ex(1)/2, z+ex(1)/2)*exp(-(z+g+ex(1)/2))
  22  *                  *A_g(z),
  23  * where,
  24  *
  25  *    A_g(z) = coeff[0] + coeff[1]/(z+1) + coeff[2]/(z+2) + ...
  26  *                + coeff[N-1]/(z+N-1).
  27  *
  28  * The value of g is taken to be equal to the order N.
  29  *
  30  * More details can be found at Wikipedia:
  31  * http://en.wikipedia.org/wiki/Lanczos_approximation.
  32  *
  33  * (C) 2006 Chris Dams
  34  *
  35  * This program is free software; you can redistribute it and/or modify
  36  * it under the terms of the GNU General Public License as published by
  37  * the Free Software Foundation; either version 2 of the License, or
  38  * (at your option) any later version.
  39  *
  40  * This program is distributed in the hope that it will be useful,
  41  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  42  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  43  * GNU General Public License for more details.
  44  *
  45  * You should have received a copy of the GNU General Public License
  46  * along with this program; if not, write to the Free Software
  47  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  48  * MA  02110-1301 USA
  49  */
  50
  51 #include <getopt.h>
  52 #include <vector>
  53 #include <cstddef> // for size_t
  54 #include <iostream>
  55 #include <cln/io.h>
  56 #include <cln/number.h>
  57 #include <cln/integer.h>
  58 #include <cln/rational.h>
  59 #include <cln/real.h>
  60 #include <cln/real_io.h>
  61 #include <cln/complex.h>
  62
  63 using namespace std;
  64 using namespace cln;
  65
  66 /*
  67  * Chebyshev polynomial coefficient matrix as far as is required for
  68  * the Lanczos approximation.
  69  */
  70 void calc_chebyshev(vector<vector<cl_I>>& C, const size_t size)
  71 {
  72         C.reserve(size);
  73         for (size_t i=0; i<size; ++i)
  74                 C.push_back(vector<cl_I>(size, 0));
  75         C[1][1] = cl_I(1);
  76         C[2][2] = cl_I(1);
  77         for (size_t i=3; i<size; i+=2)
  78                 C[i][1] = -C[i-2][1];
  79         for (size_t i=3; i<size; ++i)
  80                 C[i][i] = 2*C[i-1][i-1];
  81         for (size_t j=2; j<size; ++j)
  82                 for (size_t i=j+2; i<size; i+=2)
  83                         C[i][j] = 2*C[i-1][j-1] - C[i-2][j];
  84 }
  85
  86 /*
  87  * The coefficients p_n(g) that occur in the Lanczos approximation.
  88  */
  89 const cl_F p(const size_t k, const cl_F& g, const vector<vector<cln::cl_I>>& C)
  90 {
  91         const float_format_t prec = float_format(g);
  92         const cl_F sqrtPi = sqrt(pi(prec));
  93         cl_F result = cl_float(0, prec);
  94
  95         result = result +
  96                 (2*C[2*k+1][1])*recip(sqrtPi)*
  97                 recip(sqrt(2*g+1))*exp(g+cl_RA(1)/2);
  98
  99         for (size_t a=1; a <= k; ++a)
 100                 result = result +
 101                         (2*C[2*k+1][2*a+1]*doublefactorial(2*a-1))*recip(sqrtPi)*
 102                         recip(expt(2*cl_I(a)+2*g+1, a))*recip(sqrt(2*cl_I(a)+2*g+1))*
 103                         exp(cl_I(a)+g+cl_RA(1)/2);
 104         return result;
 105 }
 106
 107 /*
 108  * Calculate coefficients that occurs in the expression for the
 109  * Lanczos approximation of order n.
 110  */
 111 void calc_lanczos_coeffs(vector<cl_F>& lanc, const cln::cl_F& g)
 112 {
 113         const size_t n = lanc.size();
 114         vector<vector<cln::cl_I>> C;
 115         calc_chebyshev(C, 2*n+2);
 116
 117         // \Pi_{i=1}^n (z-i+1)/(z+i) = \Pi_{i=1}^n (1 - (2i-1)/(z+i))
 118         // Such a product can be rewritten as multivariate polynomial \in
 119         // Q[1/(z+1),...1/(z+n)] of degree 1. To store coefficients of this
 120         // polynomial we use vector<cl_I>, so the set of such polynomials is
 121         // stored as
 122         vector<vector<cln::cl_I>> fractions(n);
 123
 124         // xi = 1/(z+i)
 125         fractions[0] = vector<cl_I>(1);
 126         fractions[0][0] = cl_I(1);
 127         fractions[1] = fractions[0];
 128         fractions[1].push_back(cl_I(-1)); // 1 - 1/(z+1)
 129
 130         for (size_t i=2; i<n; ++i)
 131         {
 132                 // next = previous*(1 - (2*i-1)*xi) =
 133                 // previous - (2*i-1)*xi - (2i-1)*(previous-1)*xi
 134                 // Such representation is convenient since previous contains only
 135                 // only x1...x[i-1]
 136
 137                 fractions[i] = fractions[i-1];
 138                 fractions[i].push_back(-cl_I(2*i-1)); // - (2*i-1)*xi
 139                 // Now add -(2i+1)*(previous-1)*xi using formula
 140                 // 1/(z+j)*1/(z+i) = 1/(i-j)*(1/(z+j) - 1/(z+i)), that is
 141                 // xj*xi = 1/(i-j)(xj - xi)
 142                 for (size_t j=1; j < i; j++) {
 143                         cl_I curr = - exquo(cl_I(2*i-1)*fractions[i-1][j], cl_I(i-j));
 144                         fractions[i][j] = fractions[i][j] + curr;
 145                         fractions[i][i] = fractions[i][i] - curr;
 146                         // N.B. i-th polynomial has (i+1) non-zero coefficients
 147                 }
 148         }
 149
 150         vector<cl_F> p_cache(n);
 151         for (size_t i=0; i < n; i++)
 152                 p_cache[i] = p(i, g, C);
 153
 154         lanc[0] = p_cache[0]/2;
 155
 156         float_format_t prec = float_format(g);
 157         // A = p(i, g, C)*fraction[i] = p(i, g, C)*F[i][j]*xj,
 158         for (size_t j=1; j < n; ++j) {
 159                 lanc[j] = cl_float(0, prec);
 160                 lanc[0] = lanc[0] + p_cache[j];
 161                 for (size_t i=j; i < n; i++)
 162                         lanc[j] = lanc[j] + p_cache[i]*fractions[i][j];
 163         }
 164 }
 165
 166 /*
 167  * Calculate Gamma(z) using the Lanczos approximation with parameter g and
 168  * coefficients stored in the exvector coeffs.
 169  */
 170 const cl_N calc_gamma(const cl_N& z, const cl_F& g, const vector<cl_F>& lanc)
 171 {
 172         const cl_F thePi = pi(float_format(g));
 173         // XXX: need to check if z is floating-point and precision of z
 174         // matches one of g
 175         if (realpart(z) < 0.5)
 176                 return (thePi/sin(thePi*z))/calc_gamma(1-z, g, lanc);
 177         cl_N A = lanc[0];
 178         for (size_t i=1; i < lanc.size(); ++i)
 179                 A = A + lanc[i]/(z-1+i);
 180         cl_N result = sqrt(2*thePi)*expt(z+g-cl_RA(1)/2, z-cl_RA(1)/2)*
 181                             exp(-(z+g-cl_RA(1)/2))*A;
 182         return result;
 183 }
 184
 185 void usage(char *progname)
 186 {       cout << "Usage: " << progname << " -n order -D digits" << endl;
 187         exit(0);
 188 }
 189
 190 void read_options(int argc, char**argv, int &order, int& digits)
 191 {  int c;
 192    while((c=getopt(argc,argv,"n:D:"))!=-1)
 193    {  if(c=='n')
 194          order = atoi(optarg);
 195       else if (c=='D')
 196          digits = atoi(optarg);
 197       else
 198          usage(argv[0]);
 199    }
 200    if(optind!=argc)
 201       usage(argv[0]);
 202 }
 203
 204 int main(int argc, char *argv[])
 205 {
 206 /*
 207  * Handle command line options.
 208  */
 209         int order = 10;
 210         int digits_ini = 17;
 211         read_options(argc, argv, order, digits_ini);
 212         float_format_t prec = float_format(digits_ini);
 213         const cl_F thePi = pi(prec);
 214 /*
 215  * Calculate coefficients.
 216  */
 217         const cl_F g_val = cl_float(order, prec);
 218         vector<cl_F> coeffs(order);
 219         calc_lanczos_coeffs(coeffs, g_val);
 220 /*
 221  * Determine the accuracy by comparing Gamma(1/2) to sqrt(Pi).
 222  */
 223         cl_N gamma_half = calc_gamma(cl_float(cl_RA(1)/2, prec), g_val, coeffs);
 224         cl_F digits = (ln(thePi)/2 - ln(abs(gamma_half - sqrt(thePi))))/ln(cl_float(10, prec));
 225         int i_digits = cl_I_to_int(floor1(digits));
 226         if (digits < cl_I(1))
 227                 cout << "Forget it, this is waaaaaaay too inaccurate." << endl;
 228         else
 229                 cout << "Reliable digits: " << i_digits << endl;
 230 /*
 231  * Print the coefficients.
 232  */
 233         for (size_t i=0; i<coeffs.size(); ++i) {
 234                 cout << "coeffs_" << order << "[" << i << "] = \"";
 235                 cout << coeffs[i];
 236                 cout << "\";" << endl;
 237         }
 238         return 0;
 239 }