apriori 0.2.1

data/ext/math/src/chi2.c

@@ -0,0 +1,151 @@
+/*----------------------------------------------------------------------
+  File    : chi2.c
+  Contents: chi^2 distribution function
+  Author  : Christian Borgelt
+  History : 2003.05.19 file created as quantile.c
+            2008.03.14 main programs added
+----------------------------------------------------------------------*/
+#if defined(CHI2PDF_MAIN) \
+ || defined(CHI2CDF_MAIN) \
+ || defined(CHI2QTL_MAIN)
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+#ifdef CHI2QTL_MAIN
+#ifndef CHI2QTL
+#define CHI2QTL
+#endif
+#ifndef GAMMAQTL
+#define GAMMAQTL
+#endif
+#endif
+#include <assert.h>
+#include <math.h>
+#include "gamma.h"
+#ifdef CHI2QTL
+#include "normal.h"
+#endif
+#include "chi2.h"
+
+/*----------------------------------------------------------------------
+  Functions
+----------------------------------------------------------------------*/
+
+double chi2pdf (double x, double df)
+{                               /* --- probability density function */
+  assert(df > 0);               /* check the function arguments */
+  if (x <=  0) return 0;        /* only non-zero for positive arg. */
+  if (df == 2) return 0.5 *exp(-0.5*x);
+  df *= 0.5;                    /* compute probability density */
+  return 0.5 *exp((df-1) *log(0.5*x) -0.5*x -logGamma(df));
+}  /* chi2pdf() */
+
+/*--------------------------------------------------------------------*/
+
+double chi2cdfP (double x, double df)
+{                               /* --- cumulative distribution fn. */
+  assert(df > 0);               /* check the function arguments */
+  return GammaP(0.5*df, 0.5*x); /* compute regularized Gamma function */
+}  /* chi2cdfP() */
+
+/*--------------------------------------------------------------------*/
+
+double chi2cdfQ (double x, double df)
+{                               /* --- cumulative distribution fn. */
+  assert(df > 0);               /* check the function arguments */
+  return GammaQ(0.5*df, 0.5*x); /* compute regularized Gamma function */
+}  /* chi2cdfQ() */
+
+/*--------------------------------------------------------------------*/
+#ifdef CHI2QTL
+
+double chi2qtlP (double prob, double df)
+{                               /* --- quantile of chi2 distribution */
+  return GammaqtlP(prob, 0.5*df, 2);
+}  /* chi2qtlP() */
+
+/*--------------------------------------------------------------------*/
+
+double chi2qtlQ (double prob, double df)
+{                               /* --- quantile of chi2 distribution */
+  return GammaqtlQ(prob, 0.5*df, 2);
+}  /* chi2qtlQ() */
+
+#endif
+/*----------------------------------------------------------------------
+  Main Functions
+----------------------------------------------------------------------*/
+#ifdef CHI2PDF_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double df = 1;                /* degrees of freedom */
+  double x;                     /* argument value */
+
+  if ((argc < 2) || (argc > 3)){/* if wrong number of arguments */
+    printf("usage: %s arg [df]\n", argv[0]);
+    printf("compute probability density function of the\n"
+           "chi^2 distribution with df degrees of freedom\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  x = atof(argv[1]);            /* get the argument value */
+  if (argc > 2) df = atof(argv[2]);
+  if (df <= 0) {                /* get the degrees of freedom */
+    printf("%s: invalid degrees of freedom\n", argv[0]); return -1; }
+  printf("chi^2: f(%.16g; %.16g) = %.16g\n", x, df, chi2pdf(x, df));
+  return 0;                     /* compute and print density */
+}  /* main() */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef CHI2CDF_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double df = 1;                /* degrees of freedom */
+  double x;                     /* argument value */
+
+  if ((argc < 2) || (argc > 3)){/* if wrong number of arguments */
+    printf("usage: %s arg [df]\n", argv[0]);
+    printf("compute cumulative distribution function of the\n"
+           "chi^2 distribution with df degrees of freedom\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  x = atof(argv[1]);            /* get the argument value */
+  if (argc > 2) df = atof(argv[2]);
+  if (df <= 0) {                /* get the degrees of freedom */
+    printf("%s: invalid degrees of freedom\n", argv[0]); return -1; }
+  printf("chi^2: F(%.16g; %.16g) = %.16g\n", x, df, chi2cdfP(x, df));
+  printf("   1 - F(%.16g; %.16g) = %.16g\n", x, df, chi2cdfQ(x, df));
+  return 0;                     /* compute and print probability */
+}  /* main() */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef CHI2QTL_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double df = 1;                /* degrees of freedom */
+  double prob;                  /* probability */
+
+  if ((argc < 2) || (argc > 3)){/* if wrong number of arguments */
+    printf("usage: %s prob [df]\n", argv[0]);
+    printf("compute quantile of the chi^2 distribution "
+           "with df degrees of freedom\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  prob = atof(argv[1]);         /* get the probability */
+  if ((prob < 0) || (prob > 1)) {
+    printf("%s: invalid probability\n", argv[0]); return -1; }
+  if (argc > 2) df = atof(argv[2]);
+  if (df <= 0) {                /* get the degrees of freedom */
+    printf("%s: invalid degrees of freedom\n", argv[0]); return -1; }
+  printf("chi^2: F(%.16g; %.16g) = %.16g\n",
+         chi2qtlP(prob, df), df, prob);
+  printf("   1 - F(%.16g; %.16g) = %.16g\n",
+         chi2qtlQ(prob, df), df, prob);
+  return 0;                     /* compute and print quantile */
+}  /* main() */
+
+#endif

data/ext/math/src/chi2.h

@@ -0,0 +1,27 @@
+/*----------------------------------------------------------------------
+  File    : chi2.h
+  Contents: chi^2 distribution functions
+  Author  : Christian Borgelt
+  History : 2003.05.19 file created as quantile.h
+----------------------------------------------------------------------*/
+#ifndef __CHI2__
+#define __CHI2__
+
+/*----------------------------------------------------------------------
+  Functions
+----------------------------------------------------------------------*/
+extern double chi2pdf  (double x,    double df);
+extern double chi2cdf  (double x,    double df);
+extern double chi2cdfP (double x,    double df);
+extern double chi2cdfQ (double x,    double df);
+extern double chi2qtl  (double prob, double df);
+extern double chi2qtlP (double prob, double df);
+extern double chi2qtlQ (double prob, double df);
+
+/*----------------------------------------------------------------------
+  Preprocessor Definitions
+----------------------------------------------------------------------*/
+#define chi2cdf(x,d)   chi2cdfP(x,d)
+#define chi2qtl(p,d)   chi2qtlP(p,d)
+
+#endif

data/ext/math/src/choose.c

@@ -0,0 +1,71 @@
+/*----------------------------------------------------------------------
+  File    : choose.c
+  Contents: compute n choose k
+  Author  : Christian Borgelt
+  History : 1996.04.29 file created
+            2003.05.17 (n-i+1) replaced by n--
+            2008.03.14 main function added
+----------------------------------------------------------------------*/
+#ifdef CHOOSE_MAIN
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+#include <limits.h>
+#include "choose.h"
+
+/*----------------------------------------------------------------------
+  Functions
+----------------------------------------------------------------------*/
+
+unsigned int choose (unsigned int n, unsigned int k)
+{                               /* --- compute n choose k */
+  unsigned int i, t;            /* loop variable, buffer */
+  unsigned int r = 1;           /* result */
+
+  if (k > n) return 0;          /* check range of k */
+  for (i = 1; i <= k; i++) {    /* calculation loop */
+    t = n--;                    /* calculate next factor in numerator */
+    if (UINT_MAX /t < r)        /* if result of multiplication */
+      return 0;                 /* is out of range, abort */
+    r = (r *t) /i;              /* calculate \prod_{i=1}^k (n-i+1)/i */
+  }
+  return r;                     /* return result */
+}  /* choose() */
+
+/*--------------------------------------------------------------------*/
+
+double dchoose (unsigned int n, unsigned int k)
+{                               /* --- compute n choose k */
+  unsigned int i;               /* loop variable, buffer */
+  double r = 1.0;               /* result */
+
+  if (k > n) return 0;          /* check range of k */
+  for (i = 1; i <= k; i++)      /* calculation loop */
+    r = (r *n--) /i;            /* calculate \prod_{i=1}^k (n-i+1)/i */
+  return r;                     /* return result */
+}  /* dchoose() */
+
+/*--------------------------------------------------------------------*/
+#ifdef CHOOSE_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  int          n, k;            /* arguments */
+  unsigned int r;               /* result */
+
+  if (argc != 3) {              /* if number of arguments is wrong */
+    printf("usage: %s <n> <k>\n", argv[0]);
+    printf("calculate n choose k, i.e. n!/(k!(n-k)!)\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  n = atoi(argv[1]);            /* get argument 1, i.e. n */
+  k = atoi(argv[2]);            /* get argument 2, i.e. k */
+  if ((n < 0) || (k < 0)) {     /* check range of n and k */
+    printf("%s: value out of range\n", argv[0]); return 1; }
+  r = choose(n, k);             /* calculate n choose k */
+  if (r > 0) printf("%d choose %d: %d\n",  n, k, r);
+  else       printf("%d choose %d: %.0f\n", n, k, dchoose(n, k));
+  return 0;                     /* print result and terminate program */
+}  /* main() */
+
+#endif

data/ext/math/src/choose.h

@@ -0,0 +1,16 @@
+/*----------------------------------------------------------------------
+  File    : choose.h
+  Contents: compute n choose k
+  Author  : Christian Borgelt
+  History : 29.04.1996 file created
+----------------------------------------------------------------------*/
+#ifndef __CHOOSE__
+#define __CHOOSE__
+
+/*----------------------------------------------------------------------
+  Functions
+----------------------------------------------------------------------*/
+extern unsigned int choose  (unsigned int n, unsigned int k);
+extern double       dchoose (unsigned int n, unsigned int k);
+
+#endif

data/ext/math/src/gamma.c

@@ -0,0 +1,446 @@
+/*----------------------------------------------------------------------
+  File    : gamma.c
+  Contents: computation of the (incomplete/regularized) gamma function
+  Author  : Christian Borgelt
+  History : 2002.07.04 file created
+            2003.05.19 incomplete Gamma function added
+            2008.03.14 more incomplete Gamma functions added
+            2008.03.15 table of factorials and logarithms added
+            2008.03.17 gamma distribution functions added
+----------------------------------------------------------------------*/
+#ifndef _ISOC99_SOURCE
+#define _ISOC99_SOURCE
+#endif                          /* needed for function log1p() */
+#if defined(GAMMA_MAIN) \
+ || defined(GAMMAPDF_MAIN) \
+ || defined(GAMMACDF_MAIN) \
+ || defined(GAMMAQTL_MAIN)
+#include <stdio.h>
+#include <stdlib.h>
+#endif
+#if defined(GAMMAQTL_MAIN) && !defined(GAMMAQTL)
+#define GAMMAQTL
+#endif
+#include <assert.h>
+#include <float.h>
+#include <math.h>
+#ifdef GAMMAQTL
+#include "normal.h"
+#endif
+#include "gamma.h"
+
+/*----------------------------------------------------------------------
+  Preprocessor Definitions
+----------------------------------------------------------------------*/
+#define LN_BASE      2.71828182845904523536028747135  /* e */
+#define SQRT_PI      1.77245385090551602729816748334  /* \sqrt(\pi) */
+#define LN_PI        1.14472988584940017414342735135  /* \ln(\pi) */
+#define LN_SQRT_2PI  0.918938533204672741780329736406
+                                                  /* \ln(\sqrt(2\pi)) */
+#define EPSILON      2.2204460492503131e-16
+#define EPS_QTL      1.4901161193847656e-08
+#define MAXFACT      170
+#define MAXITER      1024
+#define TINY         (EPSILON *EPSILON *EPSILON)
+
+/*----------------------------------------------------------------------
+  Table of Factorials/Gamma Values
+----------------------------------------------------------------------*/
+static double _facts[MAXFACT+1] = { 0 };
+static double _logfs[MAXFACT+1];
+static double _halfs[MAXFACT+1];
+static double _loghs[MAXFACT+1];
+
+/*----------------------------------------------------------------------
+  Functions
+----------------------------------------------------------------------*/
+
+static void _init (void)
+{                               /* --- init. factorial tables */
+  int    i;                     /* loop variable */
+  double x = 1;                 /* factorial */
+
+  _facts[0] = _facts[1] = 1;    /* store factorials for 0 and 1 */
+  _logfs[0] = _logfs[1] = 0;    /* and their logarithms */
+  for (i = 1; ++i <= MAXFACT; ) {
+    _facts[i] = x *= i;         /* initialize the factorial table */
+    _logfs[i] = log(x);         /* and the table of their logarithms */
+  }
+  _halfs[0] = x = SQRT_PI;      /* store Gamma(0.5) */
+  _loghs[0] = 0.5*LN_PI;        /* and its logarithm */
+  for (i = 0; ++i < MAXFACT; ) {
+    _halfs[i] = x *= i-0.5;     /* initialize the table for */
+    _loghs[i] = log(x);         /* the Gamma function of half numbers */
+  }                             /* and the table of their logarithms */
+}  /* _init() */
+
+/*--------------------------------------------------------------------*/
+#if 0
+
+double logGamma (double n)
+{                               /* --- compute ln(Gamma(n))         */
+  double s;                     /*           = ln((n-1)!), n \in IN */
+
+  assert(n > 0);                /* check the function argument */
+  if (_facts[0] <= 0) _init();  /* initialize the tables */
+  if (n < MAXFACT +1 +4 *EPSILON) {
+    if (fabs(  n -floor(  n)) < 4 *EPSILON)
+      return _logfs[(int)floor(n)-1];
+    if (fabs(2*n -floor(2*n)) < 4 *EPSILON)
+      return _loghs[(int)floor(n)];
+  }                             /* try to get the value from a table */
+  s =  1.000000000190015        /* otherwise compute it */
+    + 76.18009172947146      /(n+1)
+    - 86.50532032941677      /(n+2)
+    + 24.01409824083091      /(n+3)
+    -  1.231739572450155     /(n+4)
+    +  0.1208650972866179e-2 /(n+5)
+    -  0.5395239384953e-5    /(n+6);
+  return (n+0.5) *log((n+5.5)/LN_BASE) +(LN_SQRT_2PI +log(s/n) -5.0);
+}  /* logGamma() */
+
+#else /*--------------------------------------------------------------*/
+
+double logGamma (double n)
+{                               /* --- compute ln(Gamma(n))         */
+  double s;                     /*           = ln((n-1)!), n \in IN */
+
+  assert(n > 0);                /* check the function argument */
+  if (_facts[0] <= 0) _init();  /* initialize the tables */
+  if (n < MAXFACT +1 +4 *EPSILON) {
+    if (fabs(  n -floor(  n)) < 4 *EPSILON)
+      return _logfs[(int)floor(n)-1];
+    if (fabs(2*n -floor(2*n)) < 4 *EPSILON)
+      return _loghs[(int)floor(n)];
+  }                             /* try to get the value from a table */
+  s =    0.99999999999980993227684700473478  /* otherwise compute it */
+    +  676.520368121885098567009190444019 /(n+1)
+    - 1259.13921672240287047156078755283  /(n+2)
+    +  771.3234287776530788486528258894   /(n+3)
+    -  176.61502916214059906584551354     /(n+4)
+    +   12.507343278686904814458936853    /(n+5)
+    -    0.13857109526572011689554707     /(n+6)
+    +    9.984369578019570859563e-6       /(n+7)
+    +    1.50563273514931155834e-7        /(n+8);
+  return (n+0.5) *log((n+7.5)/LN_BASE) +(LN_SQRT_2PI +log(s/n) -7.0);
+}  /* logGamma() */
+
+#endif
+/*----------------------------------------------------------------------
+Use Lanczos' approximation
+\Gamma(n+1) = (n+\gamma+0.5)^(n+0.5)
+            * e^{-(n+\gamma+0.5)}
+            * \sqrt{2\pi}
+            * (c_0 +c_1/(n+1) +c_2/(n+2) +...+c_n/(n+k) +\epsilon)
+and exploit the recursion \Gamma(n+1) = n *\Gamma(n) once,
+i.e., compute \Gamma(n) as \Gamma(n+1) /n.
+
+For the choices \gamma = 5, k = 6, and c_0 to c_6 as defined
+in the first version, it is |\epsilon| < 2e-10 for all n > 0.
+
+Source: W.H. Press, S.A. Teukolsky, W.T. Vetterling, and B.P. Flannery
+        Numerical Recipes in C - The Art of Scientific Computing
+        Cambridge University Press, Cambridge, United Kingdom 1992
+        pp. 213-214
+
+For the choices gamma = 7, k = 8, and c_0 to c_8 as defined
+in the second version, the value is slightly more accurate.
+----------------------------------------------------------------------*/
+
+double Gamma (double n)
+{                               /* --- compute Gamma(n) = (n-1)! */
+  assert(n > 0);                /* check the function argument */
+  if (_facts[0] <= 0) _init();  /* initialize the tables */
+  if (n < MAXFACT +1 +4 *EPSILON) {
+    if (fabs(  n -floor(  n)) < 4 *EPSILON)
+      return _facts[(int)floor(n)-1];
+    if (fabs(2*n -floor(2*n)) < 4 *EPSILON)
+      return _halfs[(int)floor(n)];
+  }                             /* try to get the value from a table */
+  return exp(logGamma(n));      /* compute through natural logarithm */
+}  /* Gamma() */
+
+/*--------------------------------------------------------------------*/
+
+static double _series (double n, double x)
+{                               /* --- series approximation */
+  int    i;                     /* loop variable */
+  double t, sum;                /* buffers */
+
+  sum = t = 1/n;                /* compute initial values */
+  for (i = MAXITER; --i >= 0; ) {
+    sum += t *= x/++n;          /* add one term of the series */
+    if (fabs(t) < fabs(sum) *EPSILON) break;
+  }                             /* if term is small enough, abort */
+  return sum;                   /* return the computed factor */
+}  /* _series() */
+
+/*----------------------------------------------------------------------
+series approximation:
+P(a,x) =    \gamma(a,x)/\Gamma(a)
+\gamma(a,x) = e^-x x^a \sum_{n=0}^\infty (\Gamma(a)/\Gamma(a+1+n)) x^n
+
+Source: W.H. Press, S.A. Teukolsky, W.T. Vetterling, and B.P. Flannery
+        Numerical Recipes in C - The Art of Scientific Computing
+        Cambridge University Press, Cambridge, United Kingdom 1992
+        formula: pp. 216-219
+
+The factor exp(n *log(x) -x) is added in the functions below.
+----------------------------------------------------------------------*/
+
+static double _cfrac (double n, double x)
+{                               /* --- continued fraction approx. */
+  int    i;                     /* loop variable */
+  double a, b, c, d, e, f;      /* buffers */
+
+  b = x+1-n; c = 1/TINY; f = d = 1/b;
+  for (i = 1; i < MAXITER; i++) {
+    a = i*(n-i);                /* use Lentz's algorithm to compute */
+    d = a *d +(b += 2);         /* consecutive approximations */
+    if (fabs(d) < TINY) d = TINY;
+    c = b +a/c;
+    if (fabs(c) < TINY) c = TINY;
+    d = 1/d; f *= e = d *c;
+    if (fabs(e-1) < EPSILON) break;
+  }                             /* if factor is small enough, abort */
+  return f;                     /* return the computed factor */
+}  /* _cfrac() */
+
+/*----------------------------------------------------------------------
+continued fraction approximation:
+P(a,x) = 1 -\Gamma(a,x)/\Gamma(a)
+\Gamma(a,x) = e^-x x^a (1/(x+1-a- 1(1-a)/(x+3-a- 2*(2-a)/(x+5-a- ...))))
+
+Source: W.H. Press, S.A. Teukolsky, W.T. Vetterling, and B.P. Flannery
+        Numerical Recipes in C - The Art of Scientific Computing
+        Cambridge University Press, Cambridge, United Kingdom 1992
+        formula:           pp. 216-219
+        Lentz's algorithm: p.  171
+
+The factor exp(n *log(x) -x) is added in the functions below.
+----------------------------------------------------------------------*/
+
+double lowerGamma (double n, double x)
+{                               /* --- lower incomplete Gamma fn. */
+  assert((n > 0) && (x > 0));   /* check the function arguments */
+  return _series(n, x) *exp(n *log(x) -x);
+}  /* lowerGamma() */
+
+/*--------------------------------------------------------------------*/
+
+double upperGamma (double n, double x)
+{                               /* --- upper incomplete Gamma fn. */
+  assert((n > 0) && (x > 0));   /* check the function arguments */
+  return _cfrac(n, x) *exp(n *log(x) -x);
+}  /* upperGamma() */
+
+/*--------------------------------------------------------------------*/
+
+double GammaP (double n, double x)
+{                               /* --- regularized Gamma function P */
+  assert((n > 0) && (x >= 0));  /* check the function arguments */
+  if (x <=  0) return 0;        /* treat x = 0 as a special case */
+  if (x < n+1) return _series(n, x) *exp(n *log(x) -x -logGamma(n));
+  return 1 -_cfrac(n, x) *exp(n *log(x) -x -logGamma(n));
+}  /* GammaP() */
+
+/*--------------------------------------------------------------------*/
+
+double GammaQ (double n, double x)
+{                               /* --- regularized Gamma function Q */
+  assert((n > 0) && (x >= 0));  /* check the function arguments */
+  if (x <=  0) return 1;        /* treat x = 0 as a special case */
+  if (x < n+1) return 1 -_series(n, x) *exp(n *log(x) -x -logGamma(n));
+  return _cfrac(n, x) *exp(n *log(x) -x -logGamma(n));
+}  /* GammaQ() */
+
+/*----------------------------------------------------------------------
+P(a,x) is also called the regularized gamma function, Q(a,x) = 1-P(a,x).
+P(k/2,x/2), where k is a natural number, is the cumulative distribution
+function (cdf) of a chi^2 distribution with k degrees of freedom.
+----------------------------------------------------------------------*/
+
+double Gammapdf (double x, double k, double theta)
+{                               /* --- probability density function */
+  assert((k > 0) && (theta > 0));
+  if (x <  0) return 0;         /* support is non-negative x */
+  if (x <= 0) return (k == 1) ? 1/theta : 0;
+  if (k == 1) return exp(-x/theta) /theta;
+  return exp ((k-1) *log(x/theta) -x/theta -logGamma(k)) /theta;
+}  /* Gammapdf() */
+
+/*--------------------------------------------------------------------*/
+#ifdef GAMMAQTL
+
+double GammaqtlP (double prob, double k, double theta)
+{                               /* --- quantile of Gamma distribution */
+  int    n = 0;                 /* loop variable */
+  double x, f, a, d, dx, dp;    /* buffers */
+
+  assert((k > 0) && (theta > 0) /* check the function arguments */
+      && (prob >= 0) && (prob <= 1));
+  if (prob >= 1.0) return DBL_MAX;
+  if (prob <= 0.0) return 0;    /* handle limiting values */
+  if      (prob < 0.05) x = exp(logGamma(k) +log(prob) /k);
+  else if (prob > 0.95) x = logGamma(k) -log1p(-prob);
+  else {                        /* distinguish three prob. ranges */
+    f = unitqtlP(prob); a = sqrt(k);
+    x = (f >= -a) ? a *f +k : k;
+  }                             /* compute initial approximation */
+  do {                          /* Lagrange's interpolation */
+    dp = prob -GammacdfP(x, k, 1);
+    if ((dp == 0) || (++n > 33)) break;
+    f = Gammapdf(x, k, 1);
+    a = 2 *fabs(dp/x);
+    a = dx = dp /((a > f) ? a : f);
+    d = -0.25 *((k-1)/x -1) *a*a;
+    if (fabs(d) < fabs(a)) dx += d;
+    if (x +dx > 0) x += dx;
+    else           x /= 2;
+  } while (fabs(a) > 1e-10 *x);
+  if (fabs(dp) > EPS_QTL *prob) return -1;
+  return x *theta;              /* check for convergence and */
+}  /* GammaqtlP() */            /* return the computed quantile */
+
+/*--------------------------------------------------------------------*/
+
+double GammaqtlQ (double prob, double k, double theta)
+{                               /* --- quantile of Gamma distribution */
+  int    n = 0;                 /* loop variable */
+  double x, f, a, d, dx, dp;    /* buffers */
+
+  assert((k > 0) && (theta > 0) /* check the function arguments */
+      && (prob >= 0) && (prob <= 1));
+  if (prob <= 0.0) return DBL_MAX;
+  if (prob >= 1.0) return 0;    /* handle limiting values */
+  if      (prob < 0.05) x = logGamma(k) -log(prob);
+  else if (prob > 0.95) x = exp(logGamma(k) +log1p(-prob) /k);
+  else {                        /* distinguish three prob. ranges */
+    f = unitqtlQ(prob); a = sqrt(k);
+    x = (f >= -a) ? a *f +k : k;
+  }                             /* compute initial approximation */
+  do {                          /* Lagrange's interpolation */
+    dp = prob -GammacdfQ(x, k, 1);
+    if ((dp == 0) || (++n > 33)) break;
+    f = Gammapdf(x, k, 1);
+    a = 2 *fabs(dp/x);
+    a = dx = -dp /((a > f) ? a : f);
+    d = -0.25 *((k-1)/x -1) *a*a;
+    if (fabs(d) < fabs(a)) dx += d;
+    if (x +dx > 0) x += dx;
+    else           x /= 2;
+  } while (fabs(a) > 1e-10 *x);
+  if (fabs(dp) > EPS_QTL *prob) return -1;
+  return x *theta;              /* check for convergence and */
+}  /* GammaqtlQ() */            /* return the computed quantile */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef GAMMA_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double x;                     /* argument */
+
+  if (argc != 2) {              /* if wrong number of arguments given */
+    printf("usage: %s x\n", argv[0]);
+    printf("compute (logarithm of) Gamma function\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  x = atof(argv[1]);            /* get argument */
+  if (x <= 0) { printf("%s: x must be > 0\n", argv[0]); return -1; }
+  printf("   Gamma(%.16g)  = % .20g\n", x, Gamma(x));
+  printf("ln(Gamma(%.16g)) = % .20g\n", x, logGamma(x));
+  return 0;                     /* compute and print Gamma function */
+}  /* main() */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef GAMMAPDF_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double shape = 1;             /* shape parameter */
+  double scale = 1;             /* scale parameter */
+  double x;                     /* argument value */
+
+  if ((argc < 2) || (argc > 4)){/* if wrong number of arguments */
+    printf("usage: %s arg [shape scale]\n", argv[0]);
+    printf("compute probability density function "
+           "of the gamma distribution\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  x = atof(argv[1]);            /* get the argument value */
+  if (argc > 2) shape = atof(argv[2]);
+  if (shape <= 0) {             /* get the parameters */
+    printf("%s: invalid shape parameter\n", argv[0]); return -1; }
+  if (argc > 3) scale = atof(argv[3]);
+  if (scale <= 0) {             /* get the parameters */
+    printf("%s: invalid scale parameter\n", argv[0]); return -1; }
+  printf("gamma: f(%.16g; %.16g, %.16g) = %.16g\n",
+         x, shape, scale, Gammapdf(x, shape, scale));
+  return 0;                     /* compute and print density */
+}  /* main() */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef GAMMACDF_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double shape = 1;             /* shape parameter */
+  double scale = 1;             /* scale parameter */
+  double x;                     /* argument value */
+
+  if ((argc < 2) || (argc > 4)){/* if wrong number of arguments */
+    printf("usage: %s arg [shape scale]\n", argv[0]);
+    printf("compute cumulative distribution function "
+           "of the gamma distribution\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  x = atof(argv[1]);            /* get the argument value */
+  if (argc > 2) shape = atof(argv[2]);
+  if (shape <= 0) {             /* get the parameters */
+    printf("%s: invalid shape parameter\n", argv[0]); return -1; }
+  if (argc > 3) scale = atof(argv[3]);
+  if (scale <= 0) {             /* get the parameters */
+    printf("%s: invalid scale parameter\n", argv[0]); return -1; }
+  printf("gamma: F(% .16g; %.16g, %.16g) = %.16g\n",
+         x, shape, scale, GammacdfP(x, shape, scale));
+  printf("   1 - F(% .16g; %.16g, %.16g) = %.16g\n",
+         x, shape, scale, GammacdfQ(x, shape, scale));
+  return 0;                     /* compute and print probability */
+}  /* main() */
+
+#endif
+/*--------------------------------------------------------------------*/
+#ifdef GAMMAQTL_MAIN
+
+int main (int argc, char *argv[])
+{                               /* --- main function */
+  double shape = 1;             /* shape parameter */
+  double scale = 1;             /* scale parameter */
+  double prob;                  /* argument value */
+
+  if ((argc < 2) || (argc > 4)){/* if wrong number of arguments */
+    printf("usage: %s prob [shape scale]\n", argv[0]);
+    printf("compute quantile of the gamma distribution\n");
+    return 0;                   /* print a usage message */
+  }                             /* and abort the program */
+  prob = atof(argv[1]);         /* get the probability */
+  if ((prob < 0) || (prob > 1)){/* and check it */
+    printf("%s: invalid probability\n", argv[0]); return -1; }
+  if (argc > 2) shape = atof(argv[2]);
+  if (shape <= 0) {             /* get the parameters */
+    printf("%s: invalid shape parameter\n", argv[0]); return -1; }
+  if (argc > 3) scale = atof(argv[3]);
+  if (scale <= 0) {             /* get the parameters */
+    printf("%s: invalid scale parameter\n", argv[0]); return -1; }
+  printf("gamma: F(% .16g; %.16g, %.16g) = %.16g\n",
+         GammaqtlP(prob, shape, scale), shape, scale, prob);
+  printf("   1 - F(% .16g; %.16g, %.16g) = %.16g\n",
+         GammaqtlQ(prob, shape, scale), shape, scale, prob);
+  return 0;                     /* compute and print probability */
+}  /* main() */
+
+#endif