#include <stdio.h>
#include "strsubs.h" 
#include "vsubs.h" 
#include "ranmath.h" 
#include "linsubs.h" 

#include "vsubs.h" 
#include "sortit.h" 
#include "statsubs.h" 

#include <limits.h>
#include <float.h>

static int
ranb1 (int n, double p);
static double
ranpoiss1 (double xm);

double
gds (double a)

{
  return rangam (a);
}

static double
randev1 (double a)
{
  /**
   Random gamma deviate:  a>=1
   GBEST algorithm  (D.J. BEST: Appl. Stat. 29 p 181 1978
   */
  double x, d, e, c, g, f, r1, r2;

  e = a - 1.0;
  c = 3.0 * a - 0.75;

  for (;;)
    {
      r1 = DRAND2();
      g = r1 - (r1 * r1);
      if (g <= 0.0)
        continue;
      f = (r1 - 0.5) * sqrt (c / g);
      x = e + f;
      if (x <= 0.0)
        continue;
      r2 = DRAND2();
      d = 64.0 * r2 * r2 * g * g * g;
      if ((d >= 1.0 - 2.0 * f * f / x)
          && (log (d) >= 2.0 * (e * log (x / e) - f)))
        continue;
      return (x);
    }

}

static double
randev0 (double a)
{
  /**
   algorithm G6: Gamma for a < 1
   */
  double r1, r2, x, w;
  double t = 1.0 - a;
  double p = t / (t + a * exp (-t));
  double s = 1.0 / a;
  for (;;)
    {
      r1 = DRAND2();
      if (r1 <= p)
        {
          x = t * pow (r1 / p, s);
          w = x;
        }
      else
        {
          x = t + log ((1.0 - p) / (1.0 - r1));
          w = t * log (x / t);
        }
      r2 = DRAND2();
      if ((1.0 - r2) <= w)
        {
          if ((1.0 / r2 - 1.0) <= w)
            continue;
          if (-log (r2) <= w)
            continue;
        }
      if (x == 0.0)
        x = 1.0e-20;
      return x;

    }

}

double
ranexp (void)
{
  /**
   exponential mean 1
   */
  double x, t;
  t = DRAND2();
  x = -log (1.0 - t);
  return x;
}

double
rangam (double a)
{
  /**
   generate gamma deviate mean a
   */

  if (a <= 0.0)
    {
      fatalx ("rangam called with bad param.  a:  %9.3f\n", a);
    }

  if (a < 1.0)
    {
      return (randev0 (a));
    }
  if (a == 1.0)
    {
      return (ranexp ());
    }
  return (randev1 (a));
}
#define PI 3.14159265358979

double
ranpoiss (double xm)
{
  return poidev (xm);
}

double
ranpoissx (double xm)
/* poisson variable conditional on >0 */
{
  double x, t, tc, s, y;
  int k;
  if (xm > 1.0)
    {
      for (;;)
        {
          x = ranpoiss (xm);
          if (x > 0.5)
            return x;
        }
    }
  return ranpoiss1 (xm);
}

double
poidev (double xm)
/** 
 NUM REC pp 293 ff (modified) 
 */
{
  static double sq, alxm, g, oldm = (-1.0);
  double em, t, y;

  if (xm < 12.0)
    {
      if (xm != oldm)
        {
          oldm = xm;
          g = exp (-xm);
        }
      em = -1;
      t = 1.0;
      do
        {
          ++em;
          t *= DRAND2();
        }
      while (t > g);
    }
  else
    {
      if (xm != oldm)
        {
          oldm = xm;
          sq = sqrt (2.0 * xm);
          alxm = log (xm);
          g = xm * alxm - lgamma (xm + 1.0);
        }
      do
        {
          do
            {
              y = tan (PI * DRAND2());
              em = sq * y + xm;
            }
          while (em < 0.0);
          em = floor (em);
          t = 0.9 * (1.0 + y * y) * exp (em * alxm - lgamma (em + 1.0) - g);
        }
      while (DRAND2() > t);
    }
  return em;
}
#undef PI

int
randis (double *a, int n)
{
  /* a should be prob dis summing to 1 */
  int i;
  double t, y;
  static int nfirst = 0;

  ++nfirst;
  t = DRAND2();

  for (i = 0; i < n; i++)
    {
      t -= a[i];
      if (t <= 0.0)
        return i;
    }
  if (nfirst == 1)
    {
      printf ("pos t: %15.9f\n", t);
      for (i = 0; i < n; i++)
        {
          printf ("zzrand %4d %9.3f\n", i, a[i]);
        }
    }
  printf ("probable bug (randis)\n");
  printmat (a, 1, n);
  return n - 1;
}

void
ransamp (int *samp, int nsamp, double *p, int plen)
/** 
 pick nsamp elements from random distribution 
 uses randis but array is at least sorted optimally 
 */
{
  double *px;
  int *indx;
  double y;
  int i, j, k;

  if (plen <= 1)
    {
      ivzero (samp, nsamp);
      return;
    }

  ZALLOC(px, plen, double);
  ZALLOC(indx, plen, int);

  y = asum (p, plen);
  vst (px, p, -1.0 / y, plen);
  sortit (px, indx, plen);
  vst (px, px, -1.0, plen);

  for (i = 0; i < nsamp; i++)
    {
      /** 
       really need binary chop picker 
       */
      j = randis (px, plen);
      if (j < 0)
        {
          for (k = 0; k < plen; k++)
            {
              printf ("zz %d %d %12.6f  %12.6f\n", k, indx[k], p[k], px[k]);
            }
          fatalx ("bad ransamp\n");
        }
      k = indx[j];
      samp[i] = k;
    }

  free (px);
  free (indx);

}

void
pick2 (int n, int *k1, int *k2)
{
  long l1, l2;
  /* pick 2 distinct integers < n  */;
  if (n < 2)
    fatalx ("bad pick2 call\n");
  for (;;)
    {
      l1 = LRAND ();
      l2 = LRAND ();
      l1 = l1 % n;
      l2 = l2 % n;
      if (l1 != l2)
        break;
    }
  *k1 = l1;
  *k2 = l2;
}

void
ranperm (int *a, int n)
/** 
 a must be initialized say by idperm 
 */
{
  int l, k, tmp;
  long r;
  for (l = n; l > 1; l--)
    {

      r = LRAND ();
      k = r % l;
      /* now swap k and l-1 */
      tmp = a[l - 1];
      a[l - 1] = a[k];
      a[k] = tmp;

    }
}
int
ranmod (int n)
/* random number 0,...n-1 */
{

  long r, big;

  if (n == 0)
    fatalx ("ranmod(0) called\n");
  if (n == 1)
    return 0;
  big = (2 << 29) - 1;
  r = LRAND ();
  r %= big;
  return (r % n);

}
double
ranbeta (double a, double b)
{
  double xa, xb;

  if ((a <= 0.0) || (b <= 0.0))
    fatalx ("(ranbeta) bad parameters: %9.3f %9.3f\n", a, b);
  xa = rangam (a);
  xb = rangam (b);
  return xa / (xa + xb);
}

int
ranbinom (int n, double p)
{
  /** 
   Knuth Vol 2, p 131
   */
#define BTHRESH  50 
  int a, b;
  double x;
  if (p >= 1)
    return n;
  if (p <= 0)
    return 0;
  if (n <= 0)
    return 0;

  if (n <= BTHRESH)
    {
      return ranb1 (n, p); /** small case */
    }

  a = 1 + n / 2;
  b = n + 1 - a;
  x = ranbeta ((double) a, (double) b);
  if (x >= p)
    return ranbinom (a - 1, p / x);
  return (a + ranbinom (b - 1, (p - x) / (1.0 - x)));
}
static int
ranb1 (int n, double p)
/** 
 binomial dis. 
 Naive routine
 */
{
  int cnt = 0, i;

  for (i = 0; i < n; i++)
    {
      if (DRAND2() <= p)
        ++cnt;
    }

  return cnt;

}
int
ewens (int *a, int n, double theta)
/**
 implements the Ewens sampler.  Categories 1...K
 */
{
  int i, k, maxcat = 0;
  double t, x;

  if (n == 0)
    return;
  a[0] = maxcat = 1;
  for (i = 1; i < n; i++)
    {
      t = theta / ((double) i + theta);
      x = DRAND2();
      if (x > t)
        {
          k = ranmod (i);
          a[i] = a[k];
        }
      else
        {
          ++maxcat;
          a[i] = maxcat;
        }
    }
  return maxcat;
}

double
ranpoiss1 (double xm)
/* poisson variable conditioned on x>0 */
/** xm should be small here 
 ranpoissx is the driver. 
 Don't call this directly
 */
{
  double x, t, tc, s, y;
  int k;
  t = exp (-xm);
  tc = 1.0 - t;
  if (tc == 0.0)
    return 1;
  y = t;
  s = tc * DRAND2();
  /* s uniform [0, tc] */
  k = 1;
  y *= xm / (double) k;
  for (;;)
    {
      if (s < y)
        return (double) k;
      s -= y;
      ++k;
      y *= xm / (double) k;
      if (k >= 100)
        {
          fprintf (stderr, "(ranpoiss1) bug? xm: %12.6f\n", xm);
          return k;
        }
    }
}

void
genmultgauss (double *rvec, int num, int n, double *covar)
// rvec contains num mvg variates
{
  double *cf;
  ZALLOC(cf, n*n, double);
  cholesky (cf, covar, n);
  transpose (cf, cf, n, n);
  gaussa (rvec, num * n);
  mulmat (rvec, rvec, cf, num, n, n);
  free (cf);
}

double
drand2 ()
{
  double x, y;
  double maxran, maxran1;
  static double eps = -1.0;
  /** 
   DRAND is quantized 1/2^31 
   call it twice and get max precision 
   */

  if (eps < 0.0)
    {
      maxran = 1.0 - DBL_EPSILON;
      maxran1 = (double) (BIGINT - 1) / (double) BIGINT;
      eps = maxran - maxran1;
    }

  x = DRAND();
  y = DRAND();
  return x + y * eps;
}

void
ranmultinom (int *samp, int n, double *p, int len)
// multinomial sample p is prob dist  n samples returned
// work is O(len^2) which is silly 
{
  int x;
  double *pp;

  if (len == 0)
    return;
  ivzero (samp, len);
  if (n <= 0)
    return;

  if (len == 1)
    {
      samp[0] = n;
      return;
    }

  ZALLOC(pp, len, double);
  copyarr (p, pp, len);
  bal1 (pp, len);

  samp[0] = x = ranbinom (n, pp[0]);
  ranmultinom (samp + 1, n - x, p + 1, len - 1);
  free (pp);
}
double
ranchi (int d)
{
  double y;

  y = 2.0 * rangam (0.5 * (double) d);
  return y;

}

double
raninvwis (double *wis, int t, int d, double *s)
// inverse Wishart:  t d.o.f. d dimension S data matrix  
// Ref Liu: Monte Carlo Strategies pp 40-41

{
  double *b, *n, *v, *cf, *ww, y;
  int i, j;

  if (t < d)
    {
      fatalx ("(raninvwis) d.o.f. too small %d %d\n", t, d);
    }

  ZALLOC(b, d*d, double);
  ZALLOC(n, d*d, double);
  ZALLOC(v, d, double);
  ZALLOC(cf, d*d, double);
  ZALLOC(ww, d*d, double);

  for (i = 0; i < d; i++)
    {
      v[i] = ranchi (t - i);
      for (j = 0; j < i; j++)
        {
          n[i * d + j] = n[j * d + i] = gauss ();
        }
    }

  y = b[0] = v[0];
  for (j = 1; j < d; j++)
    {
      b[j * d + 0] = b[j] = sqrt (y) * n[j];
    }
  for (j = 1; j < d; j++)
    {
      b[j * d + j] = v[j];
      for (i = 0; i < j; i++)
        {
          y = n[i * d + j];
          b[j * d + j] += y * y;
          b[j * d + i] = b[i * d + j] = y * sqrt (v[i])
              + vdot (n + i * d, n + j * d, i - 1);
        }
    }

  cholesky (cf, s, d);
  mulmat (ww, cf, b, d, d, d);
  transpose (cf, cf, d, d);
  mulmat (wis, ww, cf, d, d, d);

  free (b);
  free (n);
  free (v);
  free (cf);
  free (ww);
}

double
uniform (double lo, double hi)
{
  double x, width;

  width = hi - lo;

  if (width < 0)
    return uniform (hi, lo);

  x = DRAND2() * width;

  return x + lo;

}

void
randirichlet (double *x, double *pp, int n)
/** 
 generate dirichlet r.v. parameters pp
 */
{
  int i;

  vzero (x, n);
  for (i = 0; i < n; i++)
    {
      if (pp[i] > 0.0)
        {
          x[i] = rangam (pp[i]);
        }
    }
  bal1 (x, n);
}

void
randirmult (double *pp, int *aa, int len, int m)

{
  /**
   compound dirichlet - Multinomial
   */
  int k;
  double a, b, p;
  double *x;

  if (len == 0)
    return;
  if (len == 1)
    {
      aa[0] = m;
      return;
    }
  ZALLOC(x, len, double);
  randirichlet (x, pp, len);
  ranmultinom (aa, m, x, len);
  free (x);
}

int
prob1 (double p)
// return YES with probability p
{
  double z;

  if ((p < 0) || (p > 1))
    fatalx ("bad p %12.6f\n", p);
  z = DRAND2();
  if (z < p)
    return YES;

  return NO;
}
double
rant (double df)
// t distribution df > 0
{
  static double p = -1, olddf = -1.0;
  static double zkon;
  double y;

  if (df <= -0.0)
    fatalx ("(rant) %9.3f\n");

  p = df / 2.0;
  zkon = sqrt (p);  // variance of t is p/(p-1) if p > 1
  y = rangam (p);
  if (y == 0.0)
    y = p;  // special case to avoid overflow ;
  return gauss () * zkon / sqrt (y);
}

double
samppow (double e, double a, double b)
// sample x^e in range (a,b)
// uses cdf method since integral is analytic  
// care taken to prevent underflow  
{

  double ztot, rhs, zlog, ee, x;
  double y1, y2, u;

  ee = e + 1.0;
  if (ee < 0.0)
    fatalx ("e must be > -1 \n");  // fixable if integral finite  

  if (b < a)
    return samppow (e, b, a);
  if (a == b)
    return a;

  u = DRAND2();
  if (u == 0.0)
    u = 0.5;  // tiny hack   

  y1 = ee * log (b) + log (u);
  if (a == 0.0)
    zlog = y1;
  else
    {
      y2 = ee * log (a) + log (1.0 - u);
      zlog = addlog (y1, y2);
    }

  /**
   ztot = pow(b, ee) - pow(a, ee) ;   
   rhs = ztot*DRAND() + pow(a, ee) ;
   zlog = log(rhs) ; 
   */
  x = exp (zlog / ee);
  return x;

}

double
rantruncnorm (double T, int upper)
// random normal | > T (upper = 1)
{
  double u;

  if (upper == 0)
    return -rantruncnorm (-T, 1);

  u = DRAND2();
  if (u == 0.0)
    u = 0.5;  // tiny hack   
  u *= ntail (T);

  if (u == 0.0)
    return MAX(T, 50.0);
  return zprob (u);

}

int
ranhprob (int n, int a, int m)
// hypergeometric sampling 
// rejection sampling.  Devroye.  Computing (1987) General method for log-concave densities 
// where mode is known
/** 
 urn with n balls . a black balls.  Pick m without replacement.  Return number of black balls picked.
 */
{
  double y;
  double pm, logpm, w, ru, rw, rat;
  int mode, k, x, zans;

  mode = modehprob (n, a, m);
  logpm = loghprob (n, a, m, mode);
  pm = exp (logpm);
  w = 1 + pm;
  for (;;)
    {
      ru = DRAND();
      rw = DRAND();
      if (ru <= w / (1 + w))
        y = DRAND() * w / pm;
      else
        y = (w + ranexp ()) / pm;
      x = nnint (y);
      if (ranmod (2) == 0)
        x = -x;
      zans = mode + x;
      if (zans < 0)
        continue;
      if (zans > a)
        continue;
      rat = exp (loghprob (n, a, m, zans) - logpm);
      rw *= MIN(1, exp (w - pm * y));
      if (rw <= rat)
        break;
    }
  return zans;

}
