#include  <stdio.h>
#include <string.h>
#include <unistd.h>
#include <math.h>
#include "strsubs.h" 
#include "vsubs.h" 

/** 
 tiny routines BLAS? 
 a small library to do simple arithmetic
 on 1D vectors with no skips 
 */
void
vsp (double *a, double *b, double c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] + c;
}
void
vst (double *a, double *b, double c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] * c;
}
void
vvt (double *a, double *b, double *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] * c[i];
}
void
vvp (double *a, double *b, double *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] + c[i];
}
void
vvm (double *a, double *b, double *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] - c[i];
}
void
vvd (double *a, double *b, double *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (c[i] == 0.0)
        fatalx ("(vvd): zero value in denominator\n");
      a[i] = b[i] / c[i];
    }
}
void
vsqrt (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (b[i] < 0.0)
        fatalx ("(vsqrt): negative value %g\n", b[i]);
      if (b[i] == 0.0)
        {
          a[i] = 0.0;
          continue;
        }
      a[i] = sqrt (b[i]);
    }
}
void
vinvert (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (b[i] == 0.0)
        fatalx ("(vinvert): zero value\n");
      a[i] = 1.0 / b[i];
    }
}
void
vabs (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      a[i] = fabs (b[i]);
    }
}
void
vlog (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (b[i] <= 0.0)
        fatalx ("(vlog): negative or zero value %g\n", b[i]);
      a[i] = log (b[i]);
    }
}
void
vlog2 (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (b[i] <= 0.0)
        fatalx ("(vlog2): negative or zero value %g\n", b[i]);
      a[i] = NPlog2 (b[i]);
    }
}

void
vexp (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      a[i] = exp (b[i]);
    }
}
void
vclear (double *a, double c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = c;
}
void
vzero (double *a, int n)
{
  vclear (a, 0.0, n);
}
void
cpzero (char **a, int n)
{
  int i;
  for (i = 0; i < n; ++i)
    {
      a[i] = NULL;
    }
}
void
cclear (unsigned char *a, unsigned char c, long n)
/** 
 be careful nothing done about NULL at end
 */
{
  long i;
  for (i = 0; i < n; i++)
    {
      a[i] = c;
    }
}
void
ivvp (int *a, int *b, int *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] + c[i];
}
void
ivvm (int *a, int *b, int *c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] - c[i];
}
void
ivsp (int *a, int *b, int c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] + c;
}
void
ivst (int *a, int *b, int c, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = b[i] * c;
}
void
ivclear (int *a, int c, long n)
{
  long i;
  for (i = 0; i < n; i++)
    a[i] = c;
}
void
lvclear (long *a, long c, long n)
{
  long i;
  for (i = 0; i < n; i++)
    a[i] = c;
}

void
ivzero (int *a, int n)
{
  ivclear (a, 0, n);
}
double
clip (double x, double lo, double hi)
/* clip off values to range [lo,hi] */
{
  if (x < lo)
    return lo;
  if (x > hi)
    return hi;
  return x;
}

void
ivclip (int *a, int *b, int loval, int hival, int n)
{
  /* clip off values to range [loval,hival] */
  int i;
  int t;

  for (i = 0; i < n; i++)
    {
      t = MAX(b[i], loval);
      a[i] = MIN(t, hival);
    }
}

void
vclip (double *a, double *b, double loval, double hival, int n)
{
  /* clip off values to range [loval,hival] */
  int i;
  double t;

  for (i = 0; i < n; i++)
    {
      t = MAX(b[i], loval);
      a[i] = MIN(t, hival);
    }
}
void
vmaxmin (double *a, int n, double *max, double *min)
{

  int i;
  double tmax, tmin;

  tmax = tmin = a[0];
  for (i = 1; i < n; i++)
    {
      tmax = MAX(tmax, a[i]);
      tmin = MIN(tmin, a[i]);
    }
  if (max != NULL)
    *max = tmax;
  if (min != NULL)
    *min = tmin;
}
void
vlmaxmin (double *a, int n, int *pmax, int *pmin)
/** 
 return location 
 */
{

  int i;
  double tmax, tmin;
  double lmax, lmin;

  tmax = tmin = a[0];
  lmax = lmin = 0;
  for (i = 1; i < n; i++)
    {
      if (a[i] > tmax)
        {
          tmax = a[i];
          lmax = i;
        }
      if (a[i] < tmin)
        {
          tmin = a[i];
          lmin = i;
        }
    }
  if (pmax != NULL)
    *pmax = lmax;
  if (pmin != NULL)
    *pmin = lmin;
}
void
ivmaxmin (int *a, int n, int *max, int *min)
{

  int i;
  int tmax, tmin;

  tmax = tmin = a[0];
  for (i = 1; i < n; i++)
    {
      tmax = MAX(tmax, a[i]);
      tmin = MIN(tmin, a[i]);
    }
  if (max != NULL)
    *max = tmax;
  if (min != NULL)
    *min = tmin;
}
int
minivec (int *a, int n)
{
  int t;

  ivmaxmin (a, n, NULL, &t);
  return t;

}

int
maxivec (int *a, int n)
{
  int t;

  ivmaxmin (a, n, &t, NULL);
  return t;

}

void
ivlmaxmin (int *a, int n, int *pmax, int *pmin)
/** 
 return location 
 */
{

  int i;
  int tmax, tmin;
  int lmax, lmin;

  tmax = tmin = a[0];
  lmax = lmin = 0;
  for (i = 1; i < n; i++)
    {
      if (a[i] > tmax)
        {
          tmax = a[i];
          lmax = i;
        }
      if (a[i] < tmin)
        {
          tmin = a[i];
          lmin = i;
        }
    }
  if (pmax != NULL)
    *pmax = lmax;
  if (pmin != NULL)
    *pmin = lmin;
}
double
vdot (double *a, double *b, int n)
{
  int i;
  double ans = 0.0;
  for (i = 0; i < n; i++)
    ans += a[i] * b[i];

  return ans;

}
double
corr (double *a, double *b, int n)
{
  double v12, v11, v22, y1, y2, y;
  double *aa, *bb;
  ZALLOC(aa, n, double);
  ZALLOC(bb, n, double);
  y1 = asum (a, n) / (double) n;
  y2 = asum (b, n) / (double) n;

  vsp (aa, a, -y1, n);
  vsp (bb, b, -y2, n);

  v12 = vdot (aa, bb, n);
  v11 = asum2 (aa, n);
  v22 = asum2 (bb, n);

  y = v11 * v22;
  if (y == 0.0)
    fatalx ("(corr) constant vector\n");

  free (aa);
  free (bb);
  return (v12 / sqrt (y));

}
double
corrx (double *a, double *b, int n)
// like corr but constant vec returns 0
{
  double v12, v11, v22, y1, y2, y;
  double *aa, *bb;

  ZALLOC(aa, n, double);
  ZALLOC(bb, n, double);
  y1 = asum (a, n) / (double) n;
  y2 = asum (b, n) / (double) n;

  vsp (aa, a, -y1, n);
  vsp (bb, b, -y2, n);

  v12 = vdot (aa, bb, n);
  v11 = asum2 (aa, n);
  v22 = asum2 (bb, n);

  free (aa);
  free (bb);

  y = v11 * v22;
  y += 1.0e-12;

  return (v12 / sqrt (y));

}

double
variance (double *a, int n)
{

  double *aa;
  double y1, y2;

  ZALLOC(aa, n, double);
  y1 = asum (a, n) / (double) n;
  vsp (aa, a, -y1, n);

  y2 = asum (aa, n) / (double) n;

  free (aa);
  return y2;

}

void
getdiag (double *a, double *b, int n)
/* extract diagonal */
{
  int i, k;

  for (i = 0; i < n; i++)
    {
      k = i * n + i;
      a[i] = b[k];
    }
}

void
setdiag (double *a, double *diag, int n)
/* set diagonal matrix */
{
  int i, k;

  vzero (a, n * n);
  for (i = 0; i < n; i++)
    {
      k = i * n + i;
      a[k] = diag[i];
    }
}

void
copyarr (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      b[i] = a[i];
    }
}

void
revarr (double *b, double *a, int n)
{
  int i;
  double *x;
  ZALLOC(x, n, double);
  for (i = 0; i < n; i++)
    {
      x[n - i - 1] = a[i];
    }
  copyarr (x, b, n);
  free (x);
}
void
revuiarr (unsigned int *b, unsigned int *a, int n)
{
  int i;
  unsigned int *x;
  ZALLOC(x, n, unsigned int);
  for (i = 0; i < n; i++)
    {
      x[n - i - 1] = a[i];
    }
  for (i = 0; i < n; i++)
    {
      b[i] = x[i];
    }
  free (x);
}

void
reviarr (int *b, int *a, int n)
{
  int i;
  int *x;
  ZALLOC(x, n, int);
  for (i = 0; i < n; i++)
    {
      x[n - i - 1] = a[i];
    }
  copyiarr (x, b, n);
  free (x);

}
void
copyiarr (int *a, int *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      b[i] = a[i];
    }
}
void
copyiparr (int **a, int **b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      b[i] = a[i];
    }
}
void
dpermute (double *a, int *ind, int len)
{

  int i, k;
  double *rrr;

  ZALLOC(rrr, len, double);

  for (i = 0; i < len; i++)
    {
      rrr[i] = a[i];
    }

  for (i = 0; i < len; i++)
    {
      k = ind[i];
      a[i] = rrr[k];
    }

  free (rrr);
}
void
ipermute (int *a, int *ind, int len)
{

  int i, k;
  int *rrr;

  ZALLOC(rrr, len, int);

  copyiarr (a, rrr, len);

  for (i = 0; i < len; i++)
    {
      k = ind[i];
      a[i] = rrr[k];
    }

  free (rrr);
}
void
dppermute (double **a, int *ind, int len)
{

  int i, k;
  double **rrr;

  ZALLOC(rrr, len, double *);

  for (i = 0; i < len; i++)
    {
      rrr[i] = a[i];
    }

  for (i = 0; i < len; i++)
    {
      k = ind[i];
      a[i] = rrr[k];
    }

  free (rrr);
}
void
ippermute (int **a, int *ind, int len)
{

  int i, k;
  int **rrr;

  ZALLOC(rrr, len, int *);

  for (i = 0; i < len; i++)
    {
      rrr[i] = a[i];
    }

  for (i = 0; i < len; i++)
    {
      k = ind[i];
      a[i] = rrr[k];
    }

  free (rrr);
}

double
asum (double *a, int n)
{
  int i;
  double ans = 0.0;
  for (i = 0; i < n; i++)
    ans += a[i];

  return ans;
}
int
intsum (int *a, int n)
{
  int i;
  int ans = 0;
  for (i = 0; i < n; i++)
    ans += a[i];

  return ans;
}
long
longsum (long *a, int n)
{
  int i;
  long ans = 0;
  for (i = 0; i < n; i++)
    ans += a[i];

  return ans;
}
int
idot (int *a, int *b, int n)
{
  int i;
  int ans = 0.0;
  for (i = 0; i < n; i++)
    ans += a[i] * b[i];

  return ans;

}

int
iprod (int *a, int n)
/* overflow not checked */
{
  int i;
  int ans = 1;
  for (i = 0; i < n; i++)
    ans *= a[i];

  return ans;
}

double
aprod (double *a, int n)
/* overflow not checked */
{
  int i;
  double ans = 1.0;
  for (i = 0; i < n; i++)
    ans *= a[i];

  return ans;
}
double
asum2 (double *a, int n)
{
  int i;
  double ans = 0.0;
  for (i = 0; i < n; i++)
    ans += a[i] * a[i];

  return ans;
}

double
trace (double *a, int n)
{
  double *diags, t;
  ZALLOC(diags,n,double);
  getdiag (diags, a, n); /* extract diagonal */
  t = asum (diags, n);
  free (diags);
  return t;
}

int
nnint (double x)
{
  long int
  lrint (double x);
// double round(double x) ;
  return (int) lrint (x);
}
void
countcat (int *tags, int n, int *ncat, int nclass)
/* simple frequency count of integer array */

{
  int i, k;
  ivzero (ncat, nclass);
  for (i = 0; i < n; i++)
    {
      k = tags[i];
      if ((k < 0) || (k >= nclass))
        fatalx ("(countcat) bounds error\n");
      ++ncat[k];
    }
}
void
rowsum (double *a, double *rr, int n)
{
  int i, j;
  vclear (rr, 0.0, n);
  for (i = 0; i < n; i++)
    {
      for (j = 0; j < n; j++)
        {
          rr[j] += a[i + j * n];
        }
    }
}
void
colsum (double *a, double *cc, int n)
{
  int i, j;
  vclear (cc, 0.0, n);
  for (i = 0; i < n; i++)
    {
      for (j = 0; j < n; j++)
        {
          cc[i] += a[i + j * n];
        }
    }
}
void
rrsum (double *a, double *rr, int m, int n)
{
  int i, j;
  vclear (rr, 0.0, n);
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          rr[j] += a[i + j * m];
        }
    }
}
void
ccsum (double *a, double *cc, int m, int n)
{
  int i, j;
  vclear (cc, 0.0, m);
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          cc[i] += a[i + j * m];
        }
    }
}
void
printmatfile (double *a, int m, int n, FILE *fff)
/** 
 print a matrix n wide m rows  
 */
{
  printmatwfile (a, m, n, 5, fff);
}
void
printmatwfile (double *a, int m, int n, int w, FILE *fff)
/** 
 print a matrix n wide m rows  w to a row
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          fprintf (fff, "%9.3f ", a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              fprintf (fff, "  ...\n");
            }
        }
      fprintf (fff, "\n");
    }
}
void
printmat (double *a, int m, int n)
/** 
 print a matrix n wide m rows  
 */
{
  printmatw (a, m, n, 5);
}
void
printmatw (double *a, int m, int n, int w)
/** 
 print a matrix n wide m rows  w to a row
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%9.3f ", a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}
void
printmatl (double *a, int m, int n)
/** 
 print a matrix n wide m rows  
 */
{
  printmatwl (a, m, n, 5);
}
void
printmatwl (double *a, int m, int n, int w)
/** 
 print a matrix n wide m rows  w to a row
 15.9f format
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%15.9f ", a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}
void
printmatwf (double *a, int m, int n, int w, char *format)
/**
 print a matrix n wide m rows  w to a row with format
 no spacing introduced here.  User must supply
 */
{
  int i, j, jmod;
  if (format == NULL)
    {
      printmatw (a, m, n, w);
      return;
    }
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf (format, a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}

void
int2c (char *cc, int *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      cc[i] = (char) b[i];
    }
  cc[n] = '\0';
}

void
floatit (double *a, int *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      a[i] = (double) b[i];
    }
}
void
printimatwfile (int *a, int m, int n, int w, FILE *fff)
/** 
 print a matrix n wide m rows  w to a row
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          fprintf (fff, "%5d ", a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              fprintf (fff, "  ...\n");
            }
        }
      fprintf (fff, "\n");
    }
}
void
printimatw (int *a, int m, int n, int w)
/** 
 print a matrix n wide m rows  w to a row
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%5d ", a[i * n + j]);
          jmod = (j + 1) % w;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}
void
printimatx (int *a, int m, int n)
/** 
 print a matrix n wide m rows  
 no final new line
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%5d ", a[i * n + j]);
          jmod = (j + 1) % 10;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
    }
}
void
printimatfile (int *a, int m, int n, FILE *fff)
/** 
 print a matrix n wide m rows  
 */
{
  printimatwfile (a, m, n, 10, fff);
}

void
printimat (int *a, int m, int n)
/** 
 print a matrix n wide m rows  
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%5d ", a[i * n + j]);
          jmod = (j + 1) % 10;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}
void
printimatlfile (int *a, int m, int n, FILE *fff)
/** 
 print a matrix n wide m rows  %10d format
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          fprintf (fff, "%10d ", a[i * n + j]);
          jmod = (j + 1) % 10;
          if ((jmod == 0) && (j < (n - 1)))
            {
              fprintf (fff, "  ...\n");
            }
        }
      fprintf (fff, "\n");
    }
}

void
printimatl (int *a, int m, int n)
/** 
 print a matrix n wide m rows  %10d format
 */
{
  int i, j, jmod;
  for (i = 0; i < m; i++)
    {
      for (j = 0; j < n; j++)
        {
          printf ("%10d ", a[i * n + j]);
          jmod = (j + 1) % 10;
          if ((jmod == 0) && (j < (n - 1)))
            {
              printf ("  ...\n");
            }
        }
      printf ("\n");
    }
}

void
printstringf (char *ss, int w, FILE *fff)
{
  char *sss;
  char *sx;

  ZALLOC(sss, w+1, char);
  cclear (sss, CNULL, w + 1);

  sx = ss;
  for (;;)
    {
      strncpy (sss, sx, w);
      if (strlen (sss) <= 0)
        break;
      sx += w;
      fprintf (fff, "%s\n", sss);
    }

  free (sss);
}

void
printstringbasepos (char *ss, int w, int basepos)
{
  char *sss;
  char *sx;
  int pos = basepos;

  ZALLOC(sss, w+1, char);
  cclear (sss, CNULL, w + 1);

  sx = ss;
  for (;;)
    {
      strncpy (sss, sx, w);
      if (strlen (sss) <= 0)
        break;
      printf ("%12d ", pos);
      printf ("%s\n", sss);
      sx += w;
      pos += w;
    }

  free (sss);
}

void
printstring (char *ss, int w)
{
  printstringf (ss, w, stdout);
}

void
rndit (double *a, double *b, int n)
{
  int i;

  for (i = 0; i < n; ++i)
    {
      a[i] = nearbyint (b[i]);
    }
}

void
fixit (int *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    {
      a[i] = nnint (b[i]);
    }
}
int
findfirst (int *a, int n, int val)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (a[i] == val)
        return i;
    }
  return -1;
}
int
findfirstl (long *a, int n, long val)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (a[i] == val)
        return i;
    }
  return -1;
}
int
findfirstu (unsigned int *a, int n, unsigned int val)
{
  int i;
  for (i = 0; i < n; i++)
    {
      if (a[i] == val)
        return i;
    }
  return -1;
}

int
findlastu (unsigned int *a, int n, unsigned int val)
{
  int i;
  for (i = n - 1; i >= 0; i--)
    {
      if (a[i] == val)
        return i;
    }
  return -1;
}

int
findlast (int *a, int n, int val)
{
  int i;
  for (i = n - 1; i >= 0; i--)
    {
      if (a[i] == val)
        return i;
    }
  return -1;
}
int
binsearch (int *a, int n, int val)
// binary search.  a sorted in ascending order
{
#define TINYS 12
  int x, m, h, v;

  if (n <= TINYS)
    return findfirst (a, n, val);
  if (val < a[0])
    return -1;
  if (val > a[n - 1])
    return -1;
  h = n / 2;
  v = a[h];
  if (val < v)
    return binsearch (a, h, val);
  if (val == v)
    return h;
  m = (n - 1) - (h + 1) + 1;
  x = binsearch (a + h + 1, m, val);
  if (x < 0)
    return -1;
  return x + h + 1;
}

void
idperm (int *a, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = i;
}
double
NPlog2 (double y)
{
  if (y <= 0.0)
    fatalx ("(NPlog2) negative argument\n");
  return (log (y) / log (2.0));
}

double
logfac (int n)
/** 
 log (factorial n))
 */
{
  double y, x;
  x = (double) (n + 1);
  y = lgamma (x);
  return (y);
}

double
logbino (int n, int k)
/* log n choose k */
{
  double top, bot;

  top = logfac (n);
  bot = logfac (n - k) + logfac (k);

  return top - bot;
}

double
loghprob (int n, int a, int m, int k)
// http://www.math.uah.edu/stat/urn/Hypergeometric.xhtml
{
  /** 
   n balls a black.  Pick m without replacement  
   return log prob (k black)
   */

  double ytop, ybot;

  if (k < 0)
    return -1.0e30;
  if (k > a)
    return -1.0e30;
  if (k > m)
    return -1.0e30;
  if ((m - k) > (n - a))
    return -1.0e30;

  ytop = logbino (a, k) + logbino (n - a, m - k);
  ybot = logbino (n, m);
  return ytop - ybot;

}

double
log2fac (int n)
/** 
 log base2 (factorial n))
 */
{
  double y, x;
  x = (double) (n + 1);
  y = lgamma (x);
  return (y / log (2.0));
}

double
addlog (double a, double b)
{
  /* given a = log(A)
   b = log(B)
   returns log(A+B) 
   with precautions for overflow etc
   */
  double x, y, z;

  x = MIN(a, b);
  y = MAX(a, b);

  /** 
   answer is log(1 + A/B) + log (B)  
   */
  z = x - y;
  if (z < -50.0)
    return y;
  z = 1.0 + exp (z);
  z = log (z) + y;
  return (z);

}

double
vldot (double *x, double *y, int n)
/** 
 x. log(y) 
 */
{
  double *z, ans;
  double tiny = 1.0e-19;
  int i;

  ZALLOC(z, n, double);
  vsp (z, y, 1.0e-20, n);
  vlog (z, z, n);

  ans = 0.0;
  for (i = 0; i < n; i++)
    {
      if (x[i] > tiny)
        ans += x[i] * z[i];
    }
  free (z);
  return ans;
}

int
ipow2 (int l)
{
  return nnint (pow (2.0, l));
}

double
pow10 (double x)
{
  return exp (x * log (10.0));
}

double
vpow10 (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = exp (b[i] * log (10.0));
}

double
vlog10 (double *a, double *b, int n)
{
  int i;
  for (i = 0; i < n; i++)
    a[i] = log10 (b[i]);
}

void
transpose (double *aout, double *ain, int m, int n)
/** 
 aout and ain must be identical or not overlap 
 does matrix transpose 

 input  m vectors of length n  (m x n) 
 output n vectors of length m 
 */
{
  double *ttt;
  int i, j, k1, k2;
  if (aout == ain)
    {
      ZALLOC(ttt, m*n, double);
    }
  else
    ttt = aout;

  for (i = 0; i < m; i++)
    for (j = 0; j < n; j++)
      {
        k1 = i * n + j;
        k2 = j * m + i;
        ttt[k2] = ain[k1];
      }
  if (aout == ain)
    {
      copyarr (ttt, aout, m * n);
      free (ttt);
    }
}
int **
initarray_2Dint (int numrows, int numcolumns, int initval)
{
  int i, j;
  int **array;

  ZALLOC(array, numrows, int *);
  for (i = 0; i < numrows; i++)
    {
      ZALLOC(array[i], numcolumns, int);
      if (initval != 0)
        ivclear (array[i], initval, numcolumns);
    }
  return array;
}
long **
initarray_2Dlong (int numrows, int numcolumns, int initval)
{
  int i, j;
  long **array;

  ZALLOC(array, numrows, long *);
  for (i = 0; i < numrows; i++)
    {
      ZALLOC(array[i], numcolumns, long);
      if (initval != 0)
        lvclear (array[i], initval, numcolumns);
    }
  return array;
}

void
free2Dint (int ***xx, int numrows)
{
  int **array;
  int i;
  array = *xx;

  for (i = numrows - 1; i >= 0; i--)
    {
      free (array[i]);
    }
  free (array);
  *xx = NULL;
}

void
free_darray (double **xx)
{
  free (*xx);
  *xx = NULL;
}

void
free_iarray (int **xx)
{
  free (*xx);
  *xx = NULL;
}

double **
initarray_2Ddouble (int numrows, int numcolumns, double initval)
{
  int i, j;
  double **array;

  ZALLOC(array, numrows, double *);
  for (i = 0; i < numrows; i++)
    {
      ZALLOC(array[i], numcolumns, double);
      if (initval != 0.0)
        vclear (array[i], initval, numcolumns);
    }
  return array;
}

long double **
initarray_2Dlongdouble (int numrows, int numcolumns, long double initval)
{
  int i, j;
  long double **array, *bb;

  ZALLOC(array, numrows, long double *);
  for (i = 0; i < numrows; i++)
    {
      ZALLOC(array[i], numcolumns, long double);
      if (initval != 0.0)
        {
          bb = array[i];
          for (j = 0; j < numcolumns; ++j)
            {
              bb[j] = initval;
            }
        }
    }
  return array;
}

void
clear2D (double ***xx, int numrows, int numcols, double val)
{
  double **array;
  int i;
  array = *xx;

  for (i = numrows - 1; i >= 0; i--)
    {
      vclear (array[i], val, numcols);
    }

}

void
iclear2D (int ***xx, int numrows, int numcols, int val)
{
  int **array;
  int i;

  array = *xx;

  for (i = numrows - 1; i >= 0; i--)
    {
      ivclear (array[i], val, numcols);
    }

}

void
free2D (double ***xx, int numrows)
{
  double **array;
  int i;
  array = *xx;

  for (i = numrows - 1; i >= 0; i--)
    {
      free (array[i]);
    }
  free (array);
  *xx = NULL;
}

void
free2Dlongdouble (long double ***xx, int numrows)
{
  long double **array;
  int i;

  array = *xx;

  for (i = numrows - 1; i >= 0; i--)
    {
      free (array[i]);
    }
  free (array);
  *xx = NULL;
}

void
addoutmul (double *mat, double *v, double mul, int n)
{
  int a, b;
  for (a = 0; a < n; ++a)
    {
      for (b = 0; b < n; ++b)
        {
          mat[a * n + b] += v[a] * v[b] * mul;
        }
    }
}

void
addouter (double *out, double *a, int n)
/* 
 add outerprod(a)  to out
 trival to recode to make ~ 2 * faster
 */
{

  addoutmul (out, a, 1.0, n);

}

void
subouter (double *out, double *a, int n)
/* 
 subtract outerprod(a)  to out
 trival to recode to make ~ 2 * faster
 */
{
  addoutmul (out, a, -1.0, n);

}

double
bal1 (double *a, int n)
// WARNING a is input and output
{
  double y;

  y = asum (a, n);
  if (y <= 0.0)
    fatalx ("bad bal1\n");
  vst (a, a, 1.0 / y, n);
  return y;

}

double
logmultinom (int *cc, int n)
/* log multinomial */
{
  int t, k, i;
  double y, ytot;

  if (n <= 1)
    return 0.0;
  t = intsum (cc, n);
  if (t == 0)
    return 0.0;
  ytot = 0;
  for (i = 0; i < n - 1; i++)
    {
      k = cc[i];
      y = logbino (t, k);
      ytot += y;
      t -= k;
    }
  return ytot;
}
void
flipiarr (int *a, int *b, int n)
// reverse array 
{
  int *x, k;
  ZALLOC(x, n, int);

  for (k = 0; k < n; ++k)
    {
      x[n - 1 - k] = b[k];
    }

  copyiarr (x, a, n);

  free (x);

}

void
fliparr (double *a, double *b, int n)
{
  double *x;
  int k;

  ZALLOC(x, n, double);

  for (k = 0; k < n; ++k)
    {
      x[n - 1 - k] = b[k];
    }

  copyarr (x, a, n);

  free (x);

}
void
vcompl (double *a, double *b, int n)
// a <- 1 - b 
{
  double *x;
  ZALLOC(x, n, double);

  vvm (x, x, b, n);
  vsp (x, x, 1.0, n);

  copyarr (x, a, n);

  free (x);
}
void
setidmat (double *a, int n)
// a <- identity matrix
{
  int i;
  vzero (a, n * n);
  for (i = 0; i < n; i++)
    {
      a[i * n + i] = 1.0;
    }
}

int
stripit (double *a, double *b, int *x, int len)
// copy b to a leave out elems where x < 0
{
  int k, n;

  n = 0;
  for (k = 0; k < len; ++k)
    {
      if (x[k] >= 0)
        {
          a[n] = b[k];
          ++n;
        }
    }
  return n;
}

int
istripit (int *a, int *b, int *x, int len)
// copy b to a leave out elems where x < 0
{
  int k, n;

  n = 0;
  for (k = 0; k < len; ++k)
    {
      if (x[k] >= 0)
        {
          a[n] = b[k];
          ++n;
        }
    }
  return n;

}
int
cstripit (char **a, char **b, int *x, int len)
// copy b to a leave out elems where x < 0
{
  int k, n;

  n = 0;
  for (k = 0; k < len; ++k)
    {
      if (x[k] >= 0)
        {
          a[n] = b[k];
          ++n;
        }
    }
  return n;
}

void
mapit (int *a, int *b, int n, int inval, int outval)
{
  int k;

  copyiarr (b, a, n);
  for (k = 0; k < n; ++k)
    {
      if (a[k] == inval)
        a[k] = outval;
    }
}

int
ifall (int n, int k)
// falling factorial
{

  int prod = 1, t = n, j;

  for (j = 0; j < k; ++j)
    {
      prod *= t;
      --t;
    }
  return prod;
}

double
hlife (double val)
{

  return -log (2.0) / log (val);

}
void *
topheap ()
// find top of heap (address).  Useful for finding memory leaks 
{

  return sbrk (0);
}

void
swap (double *pa, double *pb)
{
  double a, b, t;

  a = *pa;
  b = *pb;
  t = b;
  b = a;
  a = t;
  *pa = a;
  *pb = b;

}

void
iswap (int *pa, int *pb)
{
  int a, b, t;

  a = *pa;
  b = *pb;
  t = b;
  b = a;
  a = t;
  *pa = a;
  *pb = b;

}

void
cswap (char *c1, char *c2)
{
  char cc;

  cc = *c1;
  *c1 = *c2;
  *c2 = cc;

}
int
kodeitb (int *xx, int len, int base)
{
  int t = 0, i;

  for (i = 0; i < len; ++i)
    {
      t *= base;
      t += xx[i];
    }
  return t;

}
int
dekodeitb (int *xx, int kode, int len, int base)
{

  int i, t;

  t = kode;
  for (i = len - 1; i >= 0; --i)
    {
      xx[i] = t % base;
      t /= base;
    }
  return intsum (xx, len); // weight

}

void
copyarr2D (double **a, double **b, int nrows, int ncols)
{

  int x;

  for (x = 0; x < nrows; ++x)
    {
      copyarr (a[x], b[x], ncols);
    }
}

void
copyiarr2D (int **a, int **b, int nrows, int ncols)
{

  int x;

  for (x = 0; x < nrows; ++x)
    {
      copyiarr (a[x], b[x], ncols);
    }
}

void
plus2Dint (int **a, int **b, int **c, int nrows, int ncols)
{
  int x;

  for (x = 0; x < nrows; ++x)
    {
      ivvp (a[x], b[x], c[x], ncols);
    }
}

void
minus2Dint (int **a, int **b, int **c, int nrows, int ncols)
{
  int x;

  for (x = 0; x < nrows; ++x)
    {
      ivvm (a[x], b[x], c[x], ncols);
    }
}

void
plus2D (double **a, double **b, double **c, int nrows, int ncols)
{
  int x;

  for (x = 0; x < nrows; ++x)
    {
      vvp (a[x], b[x], c[x], ncols);
    }
}

void
minus2D (double **a, double **b, double **c, int nrows, int ncols)
{
  int x;

  for (x = 0; x < nrows; ++x)
    {
      vvm (a[x], b[x], c[x], ncols);
    }
}

void
sum2D (double *a, double **b, int nrows, int ncols)
{
  int x;

  vzero (a, ncols);
  for (x = 0; x < nrows; ++x)
    {
      vvp (a, a, b[x], ncols);
    }
}
int
total2D (double **a, int nrows, int ncols)
{
  int x;
  double sum = 0;

  for (x = 0; x < nrows; ++x)
    {
      sum += asum (a[x], ncols);
    }

  return sum;

}

int
total2Dint (int **a, int nrows, int ncols)
{
  int x, sum = 0;

  for (x = 0; x < nrows; ++x)
    {
      sum += intsum (a[x], ncols);
    }

  return sum;

}

/** 
 mixed modulus coding (see .../popgen/kimfitdir     
 */
int
kodeitbb (int *xx, int len, int *baselist)
{
  int t = 0, i, base;

  for (i = 0; i < len; ++i)
    {
      base = baselist[i];
      t *= base;
      t += xx[i];
      if (t < 0)
        fatalx ("(kodeitbb) overflow\n");
    }
  return t;
}

int
dekodeitbb (int *xx, int kode, int len, int *baselist)
{
// return weight

  int i, t, base;

  t = kode;
  for (i = len - 1; i >= 0; --i)
    {
      base = baselist[i];
      xx[i] = t % base;
      t /= base;
    }
  return intsum (xx, len);

}
long
nextprime (long num)
// return nextprime >= num 
{
  long x;
  int t;

  for (x = num;; ++x)
    {
      t = isprime (x);
      if (t == YES)
        return x;
    }
}

int
isprime (long num)
// naive algorithm.  Implement Pollard rho at some time
{
  int top, x, t;

  if (num < 2)
    return NO;
  if (num == 2)
    return YES;
  top = nnint (sqrt (num));

  for (x = 2; x <= top; ++x)
    {
      t = num % x;
      if (t == 0)
        return NO;
    }

  return YES;

}
int
irevcomp (int xx, int stringlen)
// consists of stringlen "mininibbles" (2 bits) 
{
  int aa[32], xxx, k, t;

  if (stringlen > 16)
    fatalx ("stringlen > 16\n");
  xxx = xx;
  for (k = 0; k < stringlen; ++k)
    {
      aa[k] = (xxx & 3) ^ 3;
      xxx = xxx >> 2;
    }
  xxx = 0;
  for (k = 0; k < stringlen; ++k)
    {
      t = aa[k];
      xxx = (xxx << 2) | t;
    }
  return xxx;
}
long
lrevcomp (long xx, int stringlen)
// consists of stringlen "mininibbles" (2 bits) 
// could be rewritten to avoid array aa + 1 loop.
{
  int aa[32], k, t;
  long xxx;

  if (stringlen > 32)
    fatalx ("stringlen > 32\n");
  xxx = xx;
  for (k = 0; k < stringlen; ++k)
    {
      aa[k] = (xxx & 3) ^ 3;
      xxx = xxx >> 2;
    }
  xxx = 0;
  for (k = 0; k < stringlen; ++k)
    {
      t = aa[k];
      xxx = (xxx << 2) | t;
    }
  return xxx;
}
void
ismatch (int *a, int *b, int n, int val)
{

  int i;

  for (i = 0; i < n; i++)
    {
      if (b[i] == val)
        a[i] = YES;
      else
        a[i] = NO;

    }
}
int
pmult (double *a, double *b, double *c, int nb, int nc)
// polynomial multiplication 
{
  double *ww;
  int i, j;

  ZALLOC(ww, nb+nc+1, double);

  for (i = 0; i <= nb; ++i)
    {
      for (j = 0; j <= nc; ++j)
        {
          ww[i + j] += b[i] * c[j];
        }
    }

  copyarr (ww, a, nb + nc + 1);
  free (ww);

  return nb + nc;

}

void
pdiff (double *a, double *b, int deg)
// differentiate univariate polynomial
{
  double *ww, y;
  int k;

  ZALLOC(ww, deg+1, double);
  for (k = 1; k <= deg; ++k)
    {
      y = (double) k;
      ww[k - 1] = y * b[k];
    }

  copyarr (ww, a, deg + 1);
  free (ww);

}

