Blame randist/gausszig.c

Packit 67cb25
/* gauss.c - gaussian random numbers, using the Ziggurat method
Packit 67cb25
 *
Packit 67cb25
 * Copyright (C) 2005  Jochen Voss.
Packit 67cb25
 *
Packit 67cb25
 * This program is free software; you can redistribute it and/or modify
Packit 67cb25
 * it under the terms of the GNU General Public License as published by
Packit 67cb25
 * the Free Software Foundation; either version 3 of the License, or
Packit 67cb25
 * (at your option) any later version.
Packit 67cb25
 *
Packit 67cb25
 * This program is distributed in the hope that it will be useful,
Packit 67cb25
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 67cb25
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Packit 67cb25
 * GNU General Public License for more details.
Packit 67cb25
 *
Packit 67cb25
 * You should have received a copy of the GNU General Public License along
Packit 67cb25
 * with this library; if not, write to the Free Software Foundation, Inc.,
Packit 67cb25
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
Packit 67cb25
 */
Packit 67cb25
Packit 67cb25
/*
Packit 67cb25
 * This routine is based on the following article, with a couple of
Packit 67cb25
 * modifications which simplify the implementation.
Packit 67cb25
 *
Packit 67cb25
 *     George Marsaglia, Wai Wan Tsang
Packit 67cb25
 *     The Ziggurat Method for Generating Random Variables
Packit 67cb25
 *     Journal of Statistical Software, vol. 5 (2000), no. 8
Packit 67cb25
 *     http://www.jstatsoft.org/v05/i08/
Packit 67cb25
 *
Packit 67cb25
 * The modifications are:
Packit 67cb25
 *
Packit 67cb25
 * 1) use 128 steps instead of 256 to decrease the amount of static
Packit 67cb25
 * data necessary.  
Packit 67cb25
 *
Packit 67cb25
 * 2) use an acceptance sampling from an exponential wedge
Packit 67cb25
 * exp(-R*(x-R/2)) for the tail of the base strip to simplify the
Packit 67cb25
 * implementation.  The area of exponential wedge is used in
Packit 67cb25
 * calculating 'v' and the coefficients in ziggurat table, so the
Packit 67cb25
 * coefficients differ slightly from those in the Marsaglia and Tsang
Packit 67cb25
 * paper.
Packit 67cb25
 *
Packit 67cb25
 * See also Leong et al, "A Comment on the Implementation of the
Packit 67cb25
 * Ziggurat Method", Journal of Statistical Software, vol 5 (2005), no 7.
Packit 67cb25
 *
Packit 67cb25
 */
Packit 67cb25
Packit 67cb25
Packit 67cb25
#include <config.h>
Packit 67cb25
#include <math.h>
Packit 67cb25
#include <gsl/gsl_math.h>
Packit 67cb25
#include <gsl/gsl_rng.h>
Packit 67cb25
#include <gsl/gsl_randist.h>
Packit 67cb25
Packit 67cb25
/* position of right-most step */
Packit 67cb25
#define PARAM_R 3.44428647676
Packit 67cb25
Packit 67cb25
/* tabulated values for the heigt of the Ziggurat levels */
Packit 67cb25
static const double ytab[128] = {
Packit 67cb25
  1, 0.963598623011, 0.936280813353, 0.913041104253,
Packit 67cb25
  0.892278506696, 0.873239356919, 0.855496407634, 0.838778928349,
Packit 67cb25
  0.822902083699, 0.807732738234, 0.793171045519, 0.779139726505,
Packit 67cb25
  0.765577436082, 0.752434456248, 0.739669787677, 0.727249120285,
Packit 67cb25
  0.715143377413, 0.703327646455, 0.691780377035, 0.68048276891,
Packit 67cb25
  0.669418297233, 0.65857233912, 0.647931876189, 0.637485254896,
Packit 67cb25
  0.62722199145, 0.617132611532, 0.607208517467, 0.597441877296,
Packit 67cb25
  0.587825531465, 0.578352913803, 0.569017984198, 0.559815170911,
Packit 67cb25
  0.550739320877, 0.541785656682, 0.532949739145, 0.524227434628,
Packit 67cb25
  0.515614886373, 0.507108489253, 0.498704867478, 0.490400854812,
Packit 67cb25
  0.482193476986, 0.47407993601, 0.466057596125, 0.458123971214,
Packit 67cb25
  0.450276713467, 0.442513603171, 0.434832539473, 0.427231532022,
Packit 67cb25
  0.419708693379, 0.41226223212, 0.404890446548, 0.397591718955,
Packit 67cb25
  0.390364510382, 0.383207355816, 0.376118859788, 0.369097692334,
Packit 67cb25
  0.362142585282, 0.355252328834, 0.348425768415, 0.341661801776,
Packit 67cb25
  0.334959376311, 0.328317486588, 0.321735172063, 0.31521151497,
Packit 67cb25
  0.308745638367, 0.302336704338, 0.29598391232, 0.289686497571,
Packit 67cb25
  0.283443729739, 0.27725491156, 0.271119377649, 0.265036493387,
Packit 67cb25
  0.259005653912, 0.253026283183, 0.247097833139, 0.241219782932,
Packit 67cb25
  0.235391638239, 0.229612930649, 0.223883217122, 0.218202079518,
Packit 67cb25
  0.212569124201, 0.206983981709, 0.201446306496, 0.195955776745,
Packit 67cb25
  0.190512094256, 0.185114984406, 0.179764196185, 0.174459502324,
Packit 67cb25
  0.169200699492, 0.1639876086, 0.158820075195, 0.153697969964,
Packit 67cb25
  0.148621189348, 0.143589656295, 0.138603321143, 0.133662162669,
Packit 67cb25
  0.128766189309, 0.123915440582, 0.119109988745, 0.114349940703,
Packit 67cb25
  0.10963544023, 0.104966670533, 0.100343857232, 0.0957672718266,
Packit 67cb25
  0.0912372357329, 0.0867541250127, 0.082318375932, 0.0779304915295,
Packit 67cb25
  0.0735910494266, 0.0693007111742, 0.065060233529, 0.0608704821745,
Packit 67cb25
  0.056732448584, 0.05264727098, 0.0486162607163, 0.0446409359769,
Packit 67cb25
  0.0407230655415, 0.0368647267386, 0.0330683839378, 0.0293369977411,
Packit 67cb25
  0.0256741818288, 0.0220844372634, 0.0185735200577, 0.0151490552854,
Packit 67cb25
  0.0118216532614, 0.00860719483079, 0.00553245272614, 0.00265435214565
Packit 67cb25
};
Packit 67cb25
Packit 67cb25
/* tabulated values for 2^24 times x[i]/x[i+1],
Packit 67cb25
 * used to accept for U*x[i+1]<=x[i] without any floating point operations */
Packit 67cb25
static const unsigned long ktab[128] = {
Packit 67cb25
  0, 12590644, 14272653, 14988939,
Packit 67cb25
  15384584, 15635009, 15807561, 15933577,
Packit 67cb25
  16029594, 16105155, 16166147, 16216399,
Packit 67cb25
  16258508, 16294295, 16325078, 16351831,
Packit 67cb25
  16375291, 16396026, 16414479, 16431002,
Packit 67cb25
  16445880, 16459343, 16471578, 16482744,
Packit 67cb25
  16492970, 16502368, 16511031, 16519039,
Packit 67cb25
  16526459, 16533352, 16539769, 16545755,
Packit 67cb25
  16551348, 16556584, 16561493, 16566101,
Packit 67cb25
  16570433, 16574511, 16578353, 16581977,
Packit 67cb25
  16585398, 16588629, 16591685, 16594575,
Packit 67cb25
  16597311, 16599901, 16602354, 16604679,
Packit 67cb25
  16606881, 16608968, 16610945, 16612818,
Packit 67cb25
  16614592, 16616272, 16617861, 16619363,
Packit 67cb25
  16620782, 16622121, 16623383, 16624570,
Packit 67cb25
  16625685, 16626730, 16627708, 16628619,
Packit 67cb25
  16629465, 16630248, 16630969, 16631628,
Packit 67cb25
  16632228, 16632768, 16633248, 16633671,
Packit 67cb25
  16634034, 16634340, 16634586, 16634774,
Packit 67cb25
  16634903, 16634972, 16634980, 16634926,
Packit 67cb25
  16634810, 16634628, 16634381, 16634066,
Packit 67cb25
  16633680, 16633222, 16632688, 16632075,
Packit 67cb25
  16631380, 16630598, 16629726, 16628757,
Packit 67cb25
  16627686, 16626507, 16625212, 16623794,
Packit 67cb25
  16622243, 16620548, 16618698, 16616679,
Packit 67cb25
  16614476, 16612071, 16609444, 16606571,
Packit 67cb25
  16603425, 16599973, 16596178, 16591995,
Packit 67cb25
  16587369, 16582237, 16576520, 16570120,
Packit 67cb25
  16562917, 16554758, 16545450, 16534739,
Packit 67cb25
  16522287, 16507638, 16490152, 16468907,
Packit 67cb25
  16442518, 16408804, 16364095, 16301683,
Packit 67cb25
  16207738, 16047994, 15704248, 15472926
Packit 67cb25
};
Packit 67cb25
Packit 67cb25
/* tabulated values of 2^{-24}*x[i] */
Packit 67cb25
static const double wtab[128] = {
Packit 67cb25
  1.62318314817e-08, 2.16291505214e-08, 2.54246305087e-08, 2.84579525938e-08,
Packit 67cb25
  3.10340022482e-08, 3.33011726243e-08, 3.53439060345e-08, 3.72152672658e-08,
Packit 67cb25
  3.8950989572e-08, 4.05763964764e-08, 4.21101548915e-08, 4.35664624904e-08,
Packit 67cb25
  4.49563968336e-08, 4.62887864029e-08, 4.75707945735e-08, 4.88083237257e-08,
Packit 67cb25
  5.00063025384e-08, 5.11688950428e-08, 5.22996558616e-08, 5.34016475624e-08,
Packit 67cb25
  5.44775307871e-08, 5.55296344581e-08, 5.65600111659e-08, 5.75704813695e-08,
Packit 67cb25
  5.85626690412e-08, 5.95380306862e-08, 6.04978791776e-08, 6.14434034901e-08,
Packit 67cb25
  6.23756851626e-08, 6.32957121259e-08, 6.42043903937e-08, 6.51025540077e-08,
Packit 67cb25
  6.59909735447e-08, 6.68703634341e-08, 6.77413882848e-08, 6.8604668381e-08,
Packit 67cb25
  6.94607844804e-08, 7.03102820203e-08, 7.11536748229e-08, 7.1991448372e-08,
Packit 67cb25
  7.2824062723e-08, 7.36519550992e-08, 7.44755422158e-08, 7.52952223703e-08,
Packit 67cb25
  7.61113773308e-08, 7.69243740467e-08, 7.77345662086e-08, 7.85422956743e-08,
Packit 67cb25
  7.93478937793e-08, 8.01516825471e-08, 8.09539758128e-08, 8.17550802699e-08,
Packit 67cb25
  8.25552964535e-08, 8.33549196661e-08, 8.41542408569e-08, 8.49535474601e-08,
Packit 67cb25
  8.57531242006e-08, 8.65532538723e-08, 8.73542180955e-08, 8.8156298059e-08,
Packit 67cb25
  8.89597752521e-08, 8.97649321908e-08, 9.05720531451e-08, 9.138142487e-08,
Packit 67cb25
  9.21933373471e-08, 9.30080845407e-08, 9.38259651738e-08, 9.46472835298e-08,
Packit 67cb25
  9.54723502847e-08, 9.63014833769e-08, 9.71350089201e-08, 9.79732621669e-08,
Packit 67cb25
  9.88165885297e-08, 9.96653446693e-08, 1.00519899658e-07, 1.0138063623e-07,
Packit 67cb25
  1.02247952126e-07, 1.03122261554e-07, 1.04003996769e-07, 1.04893609795e-07,
Packit 67cb25
  1.05791574313e-07, 1.06698387725e-07, 1.07614573423e-07, 1.08540683296e-07,
Packit 67cb25
  1.09477300508e-07, 1.1042504257e-07, 1.11384564771e-07, 1.12356564007e-07,
Packit 67cb25
  1.13341783071e-07, 1.14341015475e-07, 1.15355110887e-07, 1.16384981291e-07,
Packit 67cb25
  1.17431607977e-07, 1.18496049514e-07, 1.19579450872e-07, 1.20683053909e-07,
Packit 67cb25
  1.21808209468e-07, 1.2295639141e-07, 1.24129212952e-07, 1.25328445797e-07,
Packit 67cb25
  1.26556042658e-07, 1.27814163916e-07, 1.29105209375e-07, 1.30431856341e-07,
Packit 67cb25
  1.31797105598e-07, 1.3320433736e-07, 1.34657379914e-07, 1.36160594606e-07,
Packit 67cb25
  1.37718982103e-07, 1.39338316679e-07, 1.41025317971e-07, 1.42787873535e-07,
Packit 67cb25
  1.44635331499e-07, 1.4657889173e-07, 1.48632138436e-07, 1.50811780719e-07,
Packit 67cb25
  1.53138707402e-07, 1.55639532047e-07, 1.58348931426e-07, 1.61313325908e-07,
Packit 67cb25
  1.64596952856e-07, 1.68292495203e-07, 1.72541128694e-07, 1.77574279496e-07,
Packit 67cb25
  1.83813550477e-07, 1.92166040885e-07, 2.05295471952e-07, 2.22600839893e-07
Packit 67cb25
};
Packit 67cb25
Packit 67cb25
Packit 67cb25
double
Packit 67cb25
gsl_ran_gaussian_ziggurat (const gsl_rng * r, const double sigma)
Packit 67cb25
{
Packit 67cb25
  unsigned long int i, j;
Packit 67cb25
  int sign;
Packit 67cb25
  double x, y;
Packit 67cb25
Packit 67cb25
  const unsigned long int range = r->type->max - r->type->min;
Packit 67cb25
  const unsigned long int offset = r->type->min;
Packit 67cb25
Packit 67cb25
  while (1)
Packit 67cb25
    {
Packit 67cb25
      if (range >= 0xFFFFFFFF)
Packit 67cb25
        {
Packit 67cb25
          unsigned long int k = gsl_rng_get(r) - offset;
Packit 67cb25
          i = (k & 0xFF);
Packit 67cb25
          j = (k >> 8) & 0xFFFFFF;
Packit 67cb25
        }
Packit 67cb25
      else if (range >= 0x00FFFFFF)
Packit 67cb25
        {
Packit 67cb25
          unsigned long int k1 = gsl_rng_get(r) - offset;
Packit 67cb25
          unsigned long int k2 = gsl_rng_get(r) - offset;
Packit 67cb25
          i = (k1 & 0xFF);
Packit 67cb25
          j = (k2 & 0x00FFFFFF);
Packit 67cb25
        }
Packit 67cb25
      else
Packit 67cb25
        {
Packit 67cb25
          i = gsl_rng_uniform_int (r, 256); /*  choose the step */
Packit 67cb25
          j = gsl_rng_uniform_int (r, 16777216);  /* sample from 2^24 */
Packit 67cb25
        }
Packit 67cb25
Packit 67cb25
      sign = (i & 0x80) ? +1 : -1;
Packit 67cb25
      i &= 0x7f;
Packit 67cb25
Packit 67cb25
      x = j * wtab[i];
Packit 67cb25
Packit 67cb25
      if (j < ktab[i])
Packit 67cb25
        break;
Packit 67cb25
Packit 67cb25
      if (i < 127)
Packit 67cb25
        {
Packit 67cb25
          double y0, y1, U1;
Packit 67cb25
          y0 = ytab[i];
Packit 67cb25
          y1 = ytab[i + 1];
Packit 67cb25
          U1 = gsl_rng_uniform (r);
Packit 67cb25
          y = y1 + (y0 - y1) * U1;
Packit 67cb25
        }
Packit 67cb25
      else
Packit 67cb25
        {
Packit 67cb25
          double U1, U2;
Packit 67cb25
          U1 = 1.0 - gsl_rng_uniform (r);
Packit 67cb25
          U2 = gsl_rng_uniform (r);
Packit 67cb25
          x = PARAM_R - log (U1) / PARAM_R;
Packit 67cb25
          y = exp (-PARAM_R * (x - 0.5 * PARAM_R)) * U2;
Packit 67cb25
        }
Packit 67cb25
Packit 67cb25
      if (y < exp (-0.5 * x * x))
Packit 67cb25
        break;
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  return sign * sigma * x;
Packit 67cb25
}