#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <math.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>

#include <nicklib.h>
#include <getpars.h>

#include "badpairs.h"
#include "admutils.h"
#include "mcio.h"  
#include "mcmcpars.h"  
#include "eigsubs.h"  
#include "egsubs.h"  
#include "qpsubs.h" 
#include "smartsubs.h" 
#include "globals.h" 

#define WVERSION   "200" 
/** 
 Simple eigenvector analysis
 missing mode
 fancynorm mode (divide by sqrt(p*(1-p)) 
 poplistname supported.  Eigenanalysis just on individuals in population 
 But all individuals figure in eigenvector output
 New way of computing effective marker size  (twl2mode)
 popdifference implemented
 ldregression  ldlimit (genetic distance in Morgans)
 nostatslim added  
 dotpop has new format if many groups
 uses new I/O
 Supports packmode
 Alkes style outlier removal added
 Only half XTX computed
 xdata (huge array) removed

 fst calculation added 
 popsizelimit added
 divergence added (not useful?) 

 SNPs discarded if no data.
 Phylipfile now supported

 Preparations for parallelization made
 Various fixups for EIGENSTRAT and altnormstyle

 output capability added (like convertf)

 bug fixed (a last iteration needed for outlier removal)
 bug fixed (numindivs unlimited)
 output files fixed up (NULL OK)

 Many Alkes style options added
 Support for outliername added (outlier info)
 familyname added (ped files)

 bugfix: jackrat dies (outlier removes all of population)
 bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix  bugs 1, 3 fixed

 nrows, ncols output added
 nrows, ncols set each outlier iteration
 indivs with no data removed

 writesnpeig added 

 bugfix: popsize of 1 no anova done
 minallelecnt added
 chrom:  added
 latest greatest handling of chromosome number added.
 bad bugfix: numvalidgtypes 

 checksizemode added.  Bug fix to version 7520 (> 2B genotypes fixed)
 pubmean added

 */

#define MAXFL  50   
#define MAXSTR  512
#define MAXPOPS 100

char *parname = NULL;
char *twxtabname = NULL;
char *trashdir = "/var/tmp";
int qtmode = NO;
Indiv **indivmarkers;
SNP **snpmarkers;

int numsnps, numindivs;
int numeigs = 10;  /// default
int markerscore = NO;
int seed = 0;
int chisqmode = NO;  // approx p-value better to use F-stat
int missingmode = NO;
int dotpopsmode = YES;
int noxdata = YES; /* default as pop structure dubious if Males and females */
int fstonly = NO;
int pcorrmode = NO;
int pcpopsonly = YES;
int nostatslim = 10;
int znval = -1;
int popsizelimit = -1;
int altnormstyle = YES;  // affects subtle details in normalization formula
int minallelecnt = 1;
int lopos = -999999999, hipos = 999999999;  // use with xchrom

int packout = -1;
extern enum outputmodetype outputmode;
extern int checksizemode;
extern int packmode;
extern int plotmode;
extern int verbose;
extern int fancynorm;
extern int numchrom;

int ogmode = NO;
int fsthiprec = NO;
double relthresh = 0.05;

int numoutliter = 5, numoutleigs = 10;
double outlthresh = 6.0;
OUTLINFO **outinfo;
char *outinfoname = NULL;
char *fstdetailsname = NULL;

double plo = .001;
double phi = .999;
double pvhit = .001;
double pvjack = 1.0e-6;
double *chitot;
int *xpopsize;

char *genotypename = NULL;
char *snpname = NULL;
char *indivname = NULL;
char *badsnpname = NULL;
char *poplistname = NULL;
char *outliername = NULL;
char *phylipname = NULL;
char *snpeigname = NULL;

char *indoutfilename = NULL;
char *snpoutfilename = NULL;
char *genooutfilename = NULL;
char *omode = "packedancestrymap";
double blgsize = 0.05;  // block size in Morgans */

double r2thresh = -1.0;
double r2genlim = 0.01; // Morgans 
double r2physlim = 5.0e6;
int killr2 = NO;
int pubmean = NO;

int xchrom = -1;
// list of outliers

int ldregress = 0;
double ldlimit = 9999.0; /* default is infinity */
/* we only consider markers as in possible LD if gdis <= ldlimit */

char *outputname = NULL;
char *outputvname = NULL;
char *weightname = NULL;
FILE *ofile, *ovfile;

double
twestxx (double *lam, int m, double *pzn, double *pzvar);
double
twnorm (double lam, double m, double n);

void
readcommands (int argc, char **argv);
int
loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
void
loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
void
fixxrow (double *xrow, double *xmean, double *xfancy, int len);
void
dofancy (double *cc, int n, double *fancy);
int
fvadjust (double *rr, int n, double *pmean, double *fancy);
void
getcol (double *cc, double *xdata, int col, int nrows, int ncols);
void
getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
          double *xmean, double *xfancy);
void
getcolxz (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
          double *xmean, double *xfancy, int *n0, int *n1);
void
putcol (double *cc, double *xdata, int col, int nrows, int ncols);
double
dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
double
yll (double x1, double x2, double xlen);
void
calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
double
anova1 (double *vec, int len, int *xtypes, int numeg);
double
anova (double *vec, int len, int *xtypes, int numeg);
void
publishit (char *sss, int df, double chi);

void
setmiss (SNP **snpm, int numsnps);
void
setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
void
dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
void
printxcorr (double *X, int nrows, Indiv **indxx);

void
ldreg (double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv,
       double *ldvv2, int rsize, int n);

void
clearld (double *ldmat, double *ldvv, int rsize, int n, int nclear);

void
fixrho (double *a, int n);
void
printdiag (double *a, int n);

void
setoutliermode (int mode);

void
addoutersym (double *X, double *v, int n);
void
symit (double *X, int n);

double
fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
        int nrows, int type1, int type2);

double
oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
           int nrows, int type1, int type2);

void
jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
void
domult (double *tvecs, double *tblock, int numrow, int len);
void
writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
              int ncols);
void
dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
         int *xtypes, int nrows, int ncols, int numeg, double blgsize,
         SNP **snpmarkers, Indiv **indm);
void
fixwt (SNP **snpm, int nsnp, double val);

int
main (int argc, char **argv)
{

  char **eglist;
  int numeg;
  int i, j, k, pos;
  int *vv;
  SNP *cupt, *cupt2;
  Indiv *indx;
  double y1, y2, y;

  int n0, n1, nkill;

  int nindiv = 0;
  int nignore, numrisks = 1;
  SNP **xsnplist;
  Indiv **xindlist;
  int *xindex;
  int nrows, ncols, m;
  double *XTX, *cc, *evecs, *ww;
  double *lambda;
  double *tvecs;
  int weightmode = NO;
  int t;
  double *xmean, *xfancy;
  double *ldmat = NULL, *ldmat2 = NULL;
  double *ldvv = NULL, *ldvv2 = NULL, *vv2 = NULL;
  int chrom, numclear;
  double gdis;
  int outliter, numoutiter, *badlist, nbad;
  int a, b, n;
  FILE *outlfile;

  int xblock, blocksize = 10000;
  double *tblock;

  OUTLINFO *outpt;
  int *idperm, *vecind;   // for sort

  readcommands (argc, argv);
  printf ("## smartrel version: %s\n", WVERSION);
  packmode = YES;
  setomode (&outputmode, omode);

  if (parname == NULL)
    return 0;
  if (xchrom == (numchrom + 1))
    noxdata = NO;

  if (fstonly)
    {
      printf ("fstonly\n");
      numeigs = 0;
      numoutliter = 0;
      numoutiter = 0;
      outputname = NULL;
      snpeigname = NULL;
    }

  if (fancynorm)
    printf ("norm used\n\n");
  else
    printf ("no norm used\n\n");

  nostatslim = MAX(nostatslim, 3);

  outlfile = ofile = stdout;

  if (outputname != NULL)
    openit (outputname, &ofile, "w");
  if (outliername != NULL)
    openit (outliername, &outlfile, "w");
  if (fstdetailsname != NULL)
    openit (fstdetailsname, &fstdetails, "w");

  numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);

  numindivs = getindivs (indivname, &indivmarkers);
  k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
                nignore);

  if (poplistname != NULL)
    {
      ZALLOC(eglist, numindivs, char *);
      numeg = loadlist (eglist, poplistname);
      seteglist (indivmarkers, numindivs, poplistname);
    }
  else
    {
      setstatus (indivmarkers, numindivs, NULL);
      ZALLOC(eglist, MAXPOPS, char *);
      numeg = makeeglist (eglist, MAXPOPS, indivmarkers, numindivs);
    }
  for (i = 0; i < numeg; i++)
    {
      /* printf("%3d %s\n",i, eglist[i]) ; */
    }

  nindiv = 0;
  for (i = 0; i < numindivs; i++)
    {
      indx = indivmarkers[i];
      if (indx->affstatus == YES)
        ++nindiv;
    }

  for (i = 0; i < numsnps; i++)
    {
      cupt = snpmarkers[i];
      chrom = cupt->chrom;
      if ((noxdata) && (chrom == (numchrom + 1)))
        cupt->ignore = YES;
      if (chrom == 0)
        cupt->ignore = YES;
      if (chrom > (numchrom + 1))
        cupt->ignore = YES;
    }
  for (i = 0; i < numsnps; i++)
    {
      cupt = snpmarkers[i];
      pos = nnint (cupt->physpos);
      if ((xchrom > 0) && (cupt->chrom != xchrom))
        cupt->ignore = YES;
      if ((xchrom > 0) && (pos < lopos))
        cupt->ignore = YES;
      if ((xchrom > 0) && (pos > hipos))
        cupt->ignore = YES;
      if (cupt->ignore)
        continue;
      if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
        {
          printf ("nodata: %20s\n", cupt->ID);
          cupt->ignore = YES;
        }
    }

  if (killr2)
    {
      nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
                        r2thresh);
      if (nkill > 0)
        printf ("killhir2.  number of snps killed: %d\n", nkill);
    }

  ZALLOC(vv, numindivs, int);
  numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
  for (i = 0; i < numindivs; ++i)
    {
      if (vv[i] == 0)
        {
          indx = indivmarkers[i];
          indx->ignore = YES;
        }
    }
  free (vv);

  numsnps = rmsnps (snpmarkers, numsnps, NULL);  //  rid ignorable snps

  if (missingmode)
    {
      setmiss (snpmarkers, numsnps);
      fancynorm = NO;
    }

  if (weightname != NULL)
    {
      weightmode = YES;
      getweights (weightname, snpmarkers, numsnps);
    }
  if (ldregress > 0)
    {
      ZALLOC(ldvv, ldregress*numindivs, double);
      ZALLOC(ldvv2, ldregress*numindivs, double);
      ZALLOC(vv2, numindivs, double);
      ZALLOC(ldmat, ldregress*ldregress, double);
      ZALLOC(ldmat2, ldregress*ldregress, double);
      setidmat (ldmat, ldregress);
      vst (ldmat, ldmat, 1.0e-6, ldregress * ldregress);
    }

  ZALLOC(xindex, numindivs, int);
  ZALLOC(xindlist, numindivs, Indiv *);
  ZALLOC(xsnplist, numsnps, SNP *);

  if (popsizelimit > 0)
    {
      setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
    }

  nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
  ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
  printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);

  /**
   cupt = xsnplist[0] ;
   for (j=0; j<nrows; ++j) {  
   k = xindex[j] ;
   g = getgtypes(cupt, k) ;
   indx = indivmarkers[k] ;
   t = indxindex(eglist, numeg, indx -> egroup) ;
   printf("yy1 %20s %20s %20s %d %d %d\n", cupt ->ID, indx -> ID, indx -> egroup, j, k, g) ;
   }
   printf("yya: ") ; printimat(xindex, 1, nrows) ;
   printf("zzindxa:  %s\n", indivmarkers[230] -> egroup) ;
   */

  /* printf("## nrows: %d  ncols  %d\n", nrows, ncols) ; */
  ZALLOC(xmean, ncols, double);
  ZALLOC(xfancy, ncols, double);
  ZALLOC(XTX, nrows*nrows, double);
  ZALLOC(evecs, nrows*nrows, double);
  ZALLOC(tvecs, nrows*nrows, double);
  ZALLOC(lambda, nrows, double);
  ZALLOC(cc, nrows, double);
  ZALLOC(ww, nrows, double);
  ZALLOC(badlist, nrows, int);

  blocksize = MIN(blocksize, ncols);
  ZALLOC(tblock, nrows*blocksize, double);

  // xfancy is multiplier for column xmean is mean to take off
  // badlist is list of rows to delete (outlier removal) 

  numoutiter = 1;

  if (numoutliter >= 1)
    {
      numoutiter = numoutliter + 1;
      ZALLOC(outinfo, nrows, OUTLINFO *);
      for (k = 0; k < nrows; k++)
        {
          ZALLOC(outinfo[k], 1, OUTLINFO);
        }
      /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
    }

  for (outliter = 1; outliter <= numoutiter; ++outliter)
    {
      if (fstonly)
        {
          setidmat (XTX, nrows);
          vclear (lambda, 1.0, nrows);
          break;
        }
      if (outliter > 1)
        {
          ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
        }
      vzero (XTX, nrows * nrows);
      vzero (tblock, nrows * blocksize);
      xblock = 0;

      vzero (xmean, ncols);
      vclear (xfancy, 1.0, ncols);

      for (i = 0; i < ncols; i++)
        {
          cupt = xsnplist[i];
          chrom = cupt->chrom;
          getcolxz (cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
          t = MIN(n0, n1);

          if (t <= minallelecnt)
            {
              cupt->ignore = YES;
              vzero (cc, nrows);
            }

          if (weightmode)
            {
              vst (cc, cc, xsnplist[i]->weight, nrows);
            }
          if (ldregress > 0)
            {
              numclear = 0;
              for (k = 1; k <= ldregress; ++k)
                {
                  j = i - k;
                  if (j < 0)
                    {
                      numclear = ldregress - k + 1;
                      break;
                    }
                  cupt2 = xsnplist[j];
                  if (cupt2->chrom != chrom)
                    gdis = ldlimit + 1.0;
                  else
                    gdis = cupt->genpos - cupt2->genpos;
                  if (gdis >= ldlimit)
                    {
                      numclear = ldregress - k + 1;
                      break;
                    }
                }
              if (numclear > 0)
                clearld (ldmat, ldvv, ldregress, nrows, numclear);
              ldreg (ldmat, ldmat2, cc, vv2, ldvv, ldvv2, ldregress, nrows);
              copyarr (ldmat2, ldmat, ldregress * ldregress);
              copyarr (vv2, cc, nrows);
              copyarr (ldvv2, ldvv, ldregress * nrows);
            }
          copyarr (cc, tblock + xblock * nrows, nrows);
          ++xblock;

          /** this is the key code to parallelize */
          if (xblock == blocksize)
            {
              domult (tvecs, tblock, xblock, nrows);
              vvp (XTX, XTX, tvecs, nrows * nrows);
              xblock = 0;
              vzero (tblock, nrows * blocksize);
            }
        }

      if (xblock > 0)
        {
          domult (tvecs, tblock, xblock, nrows);
          vvp (XTX, XTX, tvecs, nrows * nrows);
        }
      symit (XTX, nrows);

      /**
       a = 0; b=0 ;
       printf("zz1 %12.6f ", XTX[a*nrows+b]) ;
       a = nrows-1; b=nrows-1 ;
       printf(" %12.6f %15.9g\n", XTX[a*nrows+b], asum(XTX, nrows*nrows)) ;
       */

      if (verbose)
        {
          printdiag (XTX, nrows);
        }

      y = trace (XTX, nrows) / (double) (nrows - 1);
      if (isnan(y))
        fatalx ("bad XTX matrix\n");
      /* printf("trace:  %9.3f\n", y) ; */
      if (y <= 0.0)
        fatalx ("XTX has zero trace (perhaps no data)\n");
      vst (XTX, XTX, 1.0 / y, nrows * nrows);
/// mean eigenvalue is 1
      eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order 

      if (outliter > numoutliter)
        break;
      // last pass skips outliers 
      numoutleigs = MIN(numoutleigs, nrows - 1);
      nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
                         outinfo);
      if (nbad == 0)
        break;
      for (i = 0; i < nbad; i++)
        {
          j = badlist[i];
          indx = xindlist[j];
          outpt = outinfo[j];
          fprintf (outlfile,
                   "REMOVED outlier %s iter %d evec %d sigmage %.3f\n",
                   indx->ID, outliter, outpt->vecno, outpt->score);
          indx->ignore = YES;
        }
      nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
      printf ("number of samples after outlier removal: %d\n", nrows);
    }

  if (outliername != NULL)
    fclose (outlfile);

  m = numgtz (lambda, nrows);
  /* printf("matrix rank: %d\n", m) ; */
  if (m == 0)
    fatalx ("no data\n");

  /** smartrel code */
  for (i = 0; i < numeigs; i++)
    {
      y = sqrt (lambda[i]);
      vst (ww, evecs + i * nrows, y, nrows);
      subouter (XTX, ww, nrows);
    }
  free (tvecs);

  n = 0;
  ZALLOC(vecind, nrows*nrows/2, int);
  for (i = 0; i < nrows; i++)
    {
      for (j = i + 1; j < nrows; j++)
        {
          k = i * nrows + j;
          y1 = XTX[i * nrows + i];
          y2 = XTX[j * nrows + j];
          y = XTX[k] / sqrt (y1 * y2);
          y += 1 / (double) (nrows - 1);
          if (y < relthresh)
            continue;
          vecind[n] = k;
          evecs[n] = -y;
          ++n;
        }
    }
  free (XTX);
  if (n == 0)
    {
      printf ("## nothing above relthresh!\n");
      printf ("##end of smartrel run\n");
      return 0;
    }
  ZALLOC(idperm, n, int);
  sortit (evecs, idperm, n);
  for (i = 0; i < n; i++)
    {
      j = idperm[i];
      k = vecind[j];
      a = k / nrows;
      b = k % nrows;
      printf ("rel: %20s ", xindlist[a]->ID);
      printf ("%20s ", xindlist[b]->ID);
      printf (" %9.3f", -evecs[i]);
      printnl ();
    }

  printf ("##end of smartrel run\n");
  return 0;
}

void
readcommands (int argc, char **argv)

{
  int i;
  phandle *ph;
  int t;

  while ((i = getopt (argc, argv, "p:vV")) != -1)
    {

      switch (i)
        {

        case 'p':
          parname = strdup (optarg);
          break;

        case 'v':
          printf ("version: %s\n", WVERSION);
          break;

        case 'V':
          verbose = YES;
          break;

        case '?':
          printf ("Usage: bad params.... \n");
          fatalx ("bad params\n");
        }
    }

  if (parname == NULL)
    {
      fprintf (stderr, "no parameters\n");
      return;
    }

  pcheck (parname, 'p');
  printf ("parameter file: %s\n", parname);
  ph = openpars (parname);
  dostrsub (ph);

  getstring (ph, "genotypename:", &genotypename);
  getstring (ph, "snpname:", &snpname);
  getstring (ph, "indivname:", &indivname);
  getstring (ph, "poplistname:", &poplistname);
  getstring (ph, "snpeigname:", &snpeigname);
  getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
  getstring (ph, "output:", &outputname);
  getstring (ph, "outputvecs:", &outputname);
  getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
  getstring (ph, "outputvals:", &outputvname);
  getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
  getstring (ph, "badsnpname:", &badsnpname);
  getstring (ph, "outliername:", &outliername);
  getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
  getstring (ph, "phylipname:", &phylipname);
  getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
  getstring (ph, "weightname:", &weightname);
  getstring (ph, "fstdetailsname:", &fstdetailsname);
  getdbl (ph, "relthresh:", &relthresh);
  getint (ph, "numeigs:", &numeigs);
  getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
  getint (ph, "markerscore:", &markerscore);
  getint (ph, "chisqmode:", &chisqmode);
  getint (ph, "missingmode:", &missingmode);
  getint (ph, "fancynorm:", &fancynorm);
  getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
  getint (ph, "dotpopsmode:", &dotpopsmode);
  getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
  getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
  getint (ph, "altnormstyle:", &altnormstyle);
  getint (ph, "hashcheck:", &hashcheck);
  getint (ph, "popgenmode:", &altnormstyle);
  getint (ph, "noxdata:", &noxdata);
  t = -1;
  getint (ph, "xdata:", &t);
  if (t >= 0)
    noxdata = 1 - t;
  getint (ph, "nostatslim:", &nostatslim);
  getint (ph, "popsizelimit:", &popsizelimit);
  getint (ph, "minallelecnt:", &minallelecnt);
  getint (ph, "chrom:", &xchrom);
  getint (ph, "lopos:", &lopos);
  getint (ph, "hipos:", &hipos);
  getint (ph, "checksizemode:", &checksizemode);
  getint (ph, "pubmean:", &pubmean);
  getint (ph, "fstonly:", &fstonly);
  getint (ph, "fsthiprecision:", &fsthiprec);

  getint (ph, "ldregress:", &ldregress);
  getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
  getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
  getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
  getint (ph, "minleneig:", &nostatslim);
  getint (ph, "malexhet:", &malexhet);
  getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
  getint (ph, "familynames:", &familynames);

  getint (ph, "numoutliter:", &numoutliter);
  getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
  getint (ph, "numoutleigs", &numoutleigs);
  getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
  getdbl (ph, "outlthresh:", &outlthresh);
  getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
  getdbl (ph, "blgsize:", &blgsize);

  getstring (ph, "indoutfilename:", &indoutfilename);
  getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
  getstring (ph, "snpoutfilename:", &snpoutfilename);
  getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
  getstring (ph, "genooutfilename:", &genooutfilename);
  getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
  getstring (ph, "outputformat:", &omode);
  getstring (ph, "outputmode:", &omode);
  getint (ph, "outputgroup:", &ogmode);
  getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
  getstring (ph, "twxtabname:", &twxtabname);

  getdbl (ph, "r2thresh:", &r2thresh);
  getdbl (ph, "r2genlim:", &r2genlim);
  getdbl (ph, "r2physlim:", &r2physlim);
  getint (ph, "killr2:", &killr2);
  getint (ph, "numchrom:", &numchrom);

  printf ("### THE INPUT PARAMETERS\n");
  printf ("##PARAMETER NAME: VALUE\n");
  writepars (ph);

}

int
fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean  force missing to zero */
/* set up fancy norming  */
{
  double p, ynum, ysum, y, ymean, yfancy = 1.0;
  int i, nmiss = 0;

  ynum = ysum = 0.0;
  for (i = 0; i < n; i++)
    {
      y = cc[i];
      if (y < 0.0)
        {
          ++nmiss;
          continue;
        }
      ++ynum;
      ysum += y;
    }
  if (ynum == 0.0)
    {
      fatalx ("(fvadjust) snp has no data\n");
    }
  ymean = ysum / ynum;
  for (i = 0; i < n; i++)
    {
      y = cc[i];
      if (y < 0.0)
        cc[i] = 0.0;
      else
        cc[i] -= ymean;
    }
  if (pmean != NULL)
    *pmean = ymean;
  if (fancynorm)
    {
      p = 0.5 * ymean;   // autosomes
      if (altnormstyle == NO)
        p = (ysum + 1.0) / (2.0 * ynum + 2.0);
      y = p * (1.0 - p);
      if (y > 0.0)
        yfancy = 1.0 / sqrt (y);
    }
  if (fancy != NULL)
    *fancy = yfancy;
  return nmiss;
}

double
dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0 
// perhaps should rewrite to put xa1 etc in arrays
{
  double *w1;
  int *xt;
  int i, k1, k2, k, n, x1, x2;
  double ylike;
  double ychi;
  double *wmean;
  int imax, imin, *isort;
  static int ncall = 0;

  char ss1[MAXSTR];
  char ss2[MAXSTR];
  double ans, ftail, ftailx, ansx;

  ZALLOC(wmean, numeg, double);
  ZALLOC(w1, len + numeg, double);
  ZALLOC(isort, numeg, int);
  ZALLOC(xt, len, int);
  strcpy (ss1, "");

  calcmean (wmean, vec, len, xtypes, numeg);
  if (pubmean)
    {
      copyarr (wmean, w1, numeg);
      sortit (w1, isort, numeg);
      printf ("%s:means\n", sss);
      for (i = 0; i < numeg; i++)
        {
          k = isort[i];
          printf ("%20s ", eglist[k]);
          printf (" %9.3f\n", wmean[k]);
        }
    }

  vlmaxmin (wmean, numeg, &imax, &imin);
  if (chisqmode)
    {
      ylike = anova1 (vec, len, xtypes, numeg);
      ans = 2.0 * ylike;
    }
  else
    {
      ans = ftail = anova (vec, len, xtypes, numeg);
    }
  ++ncall;

  if (numeg > 2)
    {
      sprintf (ss2, "%s %s ", sss, "overall");
      publishit (ss2, numeg - 1, ans);
      printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
              eglist[imax], wmean[imax]);
    }

  for (k1 = 0; k1 < numeg; ++k1)
    {
      for (k2 = k1 + 1; k2 < numeg; ++k2)
        {
          n = 0;
          x1 = x2 = 0;
          for (i = 0; i < len; i++)
            {
              k = xtypes[i];
              if (k == k1)
                {
                  w1[n] = vec[i];
                  xt[n] = 0;
                  ++n;
                  ++x1;
                }
              if (k == k2)
                {
                  w1[n] = vec[i];
                  xt[n] = 1;
                  ++n;
                  ++x2;
                }
            }

          if (x1 <= 1)
            continue;
          if (x2 <= 1)
            continue;

          ylike = anova1 (w1, n, xt, 2);
          ychi = 2.0 * ylike;
          chitot[k1 * numeg + k2] += ychi;
          if (chisqmode)
            {
              ansx = ychi;
            }
          else
            {
              ansx = ftailx = anova (w1, n, xt, 2);
            }

          sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
          publishit (ss2, 1, ansx);

        }
    }
  free (w1);
  free (xt);
  free (wmean);
  free (isort);
  return ans;
}
double
anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
  int i, k;
  double y1, top, bot, ftail;
  double *w0, *w1, *popsize, *wmean;

  static int ncall2 = 0;

  if (numeg >= len)
    fatalx ("bad anova\n");
  ZALLOC(w0, len, double);
  ZALLOC(w1, len, double);
  ZALLOC(wmean, numeg, double);
  ZALLOC(popsize, numeg, double);

  y1 = asum (vec, len) / (double) len;  // mean
  vsp (w0, vec, -y1, len);

  for (i = 0; i < len; i++)
    {
      k = xtypes[i];
      ++popsize[k];
      wmean[k] += w0[i];
    }

  /* debug */
  if (numeg == 2)
    {
      ++ncall2;
      for (i = 0; i < len; ++i)
        {
          if (ncall2 < 0)
            break;
          k = xtypes[i];
//    printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
        }
    }

  vsp (popsize, popsize, 1.0e-12, numeg);
  vvd (wmean, wmean, popsize, numeg);

  vvt (w1, wmean, wmean, numeg);
  top = vdot (w1, popsize, numeg);

  for (i = 0; i < len; i++)
    {
      k = xtypes[i];
      w1[i] = w0[i] - wmean[k];
    }
  bot = asum2 (w1, len) / (double) (len - numeg);
  bot *= (double) (numeg - 1);
  ftail = rtlf (numeg - 1, len - numeg, top / bot);

  free (w0);
  free (w1);
  free (popsize);
  free (wmean);

  return ftail;

}
double
anova1 (double *vec, int len, int *xtypes, int numeg)
{
  int i, k;
  double y1, y2, ylike;
  double *w0, *w1, *popsize, *wmean;

  ZALLOC(w0, len, double);
  ZALLOC(w1, len, double);
  ZALLOC(wmean, numeg, double);
  ZALLOC(popsize, numeg, double);

  y1 = asum (vec, len) / (double) len;  // mean
  vsp (w0, vec, -y1, len);

  for (i = 0; i < len; i++)
    {
      k = xtypes[i];
      ++popsize[k];
      wmean[k] += w0[i];
    }

  vsp (popsize, popsize, 1.0e-12, numeg);
  vvd (wmean, wmean, popsize, numeg);

  for (i = 0; i < len; i++)
    {
      k = xtypes[i];
      w1[i] = w0[i] - wmean[k];
    }

  y1 = asum2 (w0, len) / (double) len;
  y2 = asum2 (w1, len) / (double) len;
  ylike = 0.5 * ((double) len) * log (y1 / y2);

  free (w0);
  free (w1);
  free (popsize);
  free (wmean);

  return ylike;

}
void
publishit (char *sss, int df, double chi)
{
  double tail;
  char sshit[4];
  char ss2[MAXSTR];
  int i, n;
  char cblank, cunder;
  static int ncall = 0;

  ++ncall;
  cblank = ' ';
  cunder = '_';
  n = strlen (sss);

  strcpy (ss2, sss);
  for (i = 0; i < n; ++i)
    {
      if (ss2[i] == cblank)
        ss2[i] = cunder;
    }

  if (chisqmode)
    {
      if (ncall == 1)
        printf (
            "## Anova statistics for population differences along each eigenvector:\n");
      if (ncall == 1)
        printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
      printf ("%40s %6d %9.3f", ss2, df, chi);
      tail = rtlchsq (df, chi);
      printf (" %12.6g", tail);
    }
  else
    {
      if (ncall == 1)
        printf (
            "## Anova statistics for population differences along each eigenvector:\n");
      if (ncall == 1)
        printf ("%40s %12s\n", "", "p-value");
      printf ("%40s ", ss2);
      tail = chi;
      printf (" %12.6g", tail);
    }
  strcpy (sshit, "");
  if (tail < pvhit)
    strcpy (sshit, "***");
  if (tail < pvjack)
    strcpy (sshit, "+++");
  printf (" %s", sshit);
  printf ("\n");
}

void
dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
  double *pp, *npp, val, yy;
  int *popsize;
  int i, j, k1, k2;

  if (fstonly)
    return;
  ZALLOC(pp, numeg * numeg, double);
  ZALLOC(npp, numeg * numeg, double);
  popsize = xpopsize;

  ivzero (popsize, numeg);

  for (i = 0; i < nrows; i++)
    {
      k1 = xtypes[i];
      ++popsize[k1];
      for (j = i + 1; j < nrows; j++)
        {
          k2 = xtypes[j];
          if (k1 < 0)
            fatalx ("bug\n");
          if (k2 < 0)
            fatalx ("bug\n");
          if (k1 >= numeg)
            fatalx ("bug\n");
          if (k2 >= numeg)
            fatalx ("bug\n");
          val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
          pp[k1 * numeg + k2] += val;
          pp[k2 * numeg + k1] += val;
          ++npp[k1 * numeg + k2];
          ++npp[k2 * numeg + k1];
        }
    }
  vsp (npp, npp, 1.0e-8, numeg * numeg);
  vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1 
  yy = trace (pp, numeg) / (double) numeg;
  vst (pp, pp, 1.0 / yy, numeg * numeg);
  printf ("\n## Average divergence between populations:");
  if (numeg <= 10)
    {
      printf ("\n");
      printf ("%10s", "");
      for (k1 = 0; k1 < numeg; ++k1)
        {
          printf (" %10s", eglist[k1]);
        }
      printf ("  %10s", "popsize");
      printf ("\n");
      for (k2 = 0; k2 < numeg; ++k2)
        {
          printf ("%10s", eglist[k2]);
          for (k1 = 0; k1 < numeg; ++k1)
            {
              val = pp[k1 * numeg + k2];
              printf (" %10.3f", val);
            }
          printf ("  %10d", popsize[k2]);
          printf ("\n");
        }
    }
  else
    {   // numeg >= 10 
      printf ("\n");
      for (k2 = 0; k2 < numeg; ++k2)
        {
          for (k1 = k2; k1 < numeg; ++k1)
            {
              printf ("dotp: %10s", eglist[k2]);
              printf (" %10s", eglist[k1]);
              val = pp[k1 * numeg + k2];
              printf (" %10.3f", val);
              printf ("    %10d", popsize[k2]);
              printf (" %10d", popsize[k1]);
              printf ("\n");
            }
        }
    }
  printf ("\n");
  printf ("\n");
  fflush (stdout);

  free (pp);
  free (npp);

}
void
printxcorr (double *X, int nrows, Indiv **indxx)
{
  int k1, k2, t;
  double y1, y2, yy, rho;
  Indiv *ind1, *ind2;

  if (pcorrmode == NO)
    return;
  for (k1 = 0; k1 < nrows; ++k1)
    {
      for (k2 = k1 + 1; k2 < nrows; ++k2)
        {

          ind1 = indxx[k1];
          ind2 = indxx[k2];

          t = strcmp (ind1->egroup, ind2->egroup);
          if (pcpopsonly && (t != 0))
            continue;

          y1 = X[k1 * nrows + k1];
          y2 = X[k2 * nrows + k2];
          yy = X[k1 * nrows + k2];

          rho = yy / sqrt (y1 * y2 + 1.0e-20);
          printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
                  ind1->egroup, ind2->egroup, rho);

        }
    }
}
void
clearld (double *ldmat, double *ldvv, int rsize, int n, int nclear)
{
  int i, j, lo, hi;

  if (nclear > rsize)
    fatalx ("bad nclear\n");

  lo = rsize - nclear;
  hi = rsize - 1;

  for (i = lo; i <= hi; ++i)
    {
      vzero (ldvv + i * n, n);
      for (j = 0; j <= hi; ++j)
        {
          ldmat[j * rsize + i] = ldmat[i * rsize + j] = 0.0;
        }
// force matrix non-singular 
      ldmat[i * rsize + i] = 1.0e-8;
    }
}

void
ldreg (double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv,
       double *ldvv2, int rsize, int n)
/** ldmat2 is inner product matrix for last rsize columns on exit */
{
  int i, j, k1, k2;
  double *rr, *ans, *tt;
  double y;

  ZALLOC(rr, rsize, double);
  ZALLOC(ans, rsize, double);
  ZALLOC(tt, n, double);

  if (rsize > 1)
    copyarr (ldvv, ldvv2 + n, n * (rsize - 1));
  for (i = 0; i < rsize - 1; i++)
    {
      for (j = 0; j < rsize - 1; j++)
        {
          k1 = i * rsize + j;
          k2 = (i + 1) * rsize + j + 1;
          ldmat2[k2] = ldmat[k1];
        }
    }
  copyarr (vv, ldvv2, n);
  i = 0;
  for (j = 0; j < rsize; j++)
    {
      y = rr[j] = vdot (vv, ldvv + j * n, n);
      y = vdot (vv, ldvv2 + j * n, n);
      if (j == 0)
        y += 1.0e-6;
      ldmat2[i * rsize + j] = ldmat2[j * rsize + i] = y;
    }
  solvit (ldmat, rr, rsize, ans); /* solve normal equations */
  copyarr (vv, vv2, n);
  for (i = 0; i < rsize; i++)
    {
      vst (tt, ldvv + i * n, -ans[i], n);
      vvp (vv2, vv2, tt, n);
    }
  free (rr);
  free (ans);
  free (tt);
}

void
fixwt (SNP **snpm, int nsnp, double val)
{
  int k;
  SNP *cupt;

  for (k = 0; k < nsnp; ++k)
    {
      cupt = snpm[k];
      cupt->weight = val;
    }

}

double
oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
           int nrows, int type1, int type2)
{
  int c1[2], c2[2], *cc;
  int *rawcol;
  int k, g, i;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;
  static int ncall = 0;

  ++ncall;
  ZALLOC(rawcol, nrows, int);

  getrawcol (rawcol, cupt, xindex, nrows);

  ivzero (c1, 2);
  ivzero (c2, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (cc == NULL)
        continue;
      g = rawcol[i];
      if (g < 0)
        continue;
      cc[0] += g;
      cc[1] += 2 - g;
    }
  if (ncall < 0)
    {
      printf ("qq2\n");
      printimat (c1, 1, 2);
      printimat (c2, 1, 2);
    }

  ya = c1[0];
  yb = c1[1];
  yaa = c2[0];
  ybb = c2[1];
  z = ya + yb;
  zz = yaa + ybb;
  if ((z < 0.1) || (zz < 0.1))
    {
      *estn = 0.0;
      *estd = -1.0;
      free (rawcol);
      return 0.0;
    }

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));

  yt = yaa + ybb;
  p2 = yaa / yt;
  h2 = yaa * ybb / (yt * (yt - 1.0));

  en = (p1 - p2) * (p1 - p2);
  en -= h1 / z;
  en -= h2 / zz;

  ed = en;
  ed += h1;
  ed += h2;

  *estn = en;
  *estd = ed;

  free (rawcol);
  return z + zz;

}

double
fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
        int nrows, int type1, int type2)
{
  int c1[2], c2[2], *cc;
  int *rawcol;
  int k, g, i;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;
  int **ccc;
  static int ncall = 0;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);
  ZALLOC(rawcol, nrows, int);

  getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
  getrawcol (rawcol, cupt, xindex, nrows);

  ivzero (c1, 2);
  ivzero (c2, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (cc == NULL)
        continue;
      g = ccc[i][0];
      if (ncall < 1000)
        {
//    printf("zz %d  %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
        }

      if (g < 0)
        continue;
      ivvp (cc, cc, ccc[i], 2);
    }

  if (ncall < 0)
    {
      printf ("qqq\n");
      printimat (c1, 1, 2);
      printimat (c2, 1, 2);
    }

  ya = c1[0];
  yb = c1[1];
  yaa = c2[0];
  ybb = c2[1];
  z = ya + yb;
  zz = yaa + ybb;
  if ((z < 1.1) || (zz < 1.1))
    {
      *estn = 0.0;
      *estd = -1.0;
      free (rawcol);
      free2Dint (&ccc, nrows);
      return 0.0;
    }

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));

  yt = yaa + ybb;
  p2 = yaa / yt;
  h2 = yaa * ybb / (yt * (yt - 1.0));

  en = (p1 - p2) * (p1 - p2);
  en -= h1 / z;
  en -= h2 / zz;

  ed = en;
  ed += h1;
  ed += h2;

  *estn = en;
  *estd = ed;

  free (rawcol);
  free2Dint (&ccc, nrows);
  return z + zz;

}

void
writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
              int ncols)
{
// this is called at end and ffvecs overwritten
  double *xpt, y, yscal, *snpsc;
  int i, j, k, kmax, kmin;
  SNP * cupt;
  FILE *fff;

  for (j = 0; j < numeigs; ++j)
    {
      xpt = ffvecs + j * ncols;
      y = asum2 (xpt, ncols);
      yscal = (double) ncols / y;
      yscal = sqrt (yscal);
      vst (xpt, xpt, yscal, ncols);
    }

  ZALLOC(snpsc, ncols, double);
  vclear (snpsc, -99999, ncols);
  for (j = 0; j < numeigs; ++j)
    {
      for (i = 0; i < ncols; ++i)
        {
          cupt = xsnplist[i];
          if (cupt->ignore)
            continue;
          y = ffvecs[j * ncols + i];
          snpsc[i] = fabs (y);
        }
      for (k = 0; k <= 10; ++k)
        {
          vlmaxmin (snpsc, ncols, &kmax, &kmin);
          cupt = xsnplist[kmax];
          printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
                  cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
          snpsc[kmax] = -1.0;
        }
    }
  free (snpsc);

  if (snpeigname == NULL)
    return;
  openit (snpeigname, &fff, "w");

  for (i = 0; i < ncols; ++i)
    {
      cupt = xsnplist[i];
      if (cupt->ignore)
        continue;

      fprintf (fff, "%20s", cupt->ID);
      fprintf (fff, " %2d", cupt->chrom);
      fprintf (fff, " %12d", nnint (cupt->physpos));

      for (j = 0; j < numeigs; ++j)
        {
          fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
        }
      fprintf (fff, "\n");
    }

  fclose (fff);

}
void
getcolxz (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
          double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
{
  int j, n, g;
  double pmean, yfancy;
  int *rawcol;
  int c0, c1;

  c0 = c1 = 0;
  ZALLOC(rawcol, nrows, int);
  n = cupt->ngtypes;
  if (n < nrows)
    fatalx ("bad snp: %s %d\n", cupt->ID, n);
  getrawcol (rawcol, cupt, xindex, nrows);
  for (j = 0; j < nrows; ++j)
    {
      g = rawcol[j];
      if (g < 0)
        continue;
      c0 += g;
      c1 += 2 - g;
    }
  floatit (xcol, rawcol, nrows);

  fvadjust (xcol, nrows, &pmean, &yfancy);
  vst (xcol, xcol, yfancy, nrows);
  if (xmean != NULL)
    {
      xmean[col] = pmean * yfancy;
      xfancy[col] = yfancy;
    }
  free (rawcol);
  *n0 = c0;
  *n1 = c1;
}

/** this is the code to parallelize */
void
domult (double *tvecs, double *tblock, int numrow, int len)
{
  int i;
  double ycheck;
  vzero (tvecs, len * len);
  for (i = 0; i < numrow; i++)
    {
      ycheck = asum (tblock + i * len, len);
      if (fabs (ycheck) > .00001)
        fatalx ("bad ycheck\n");
      addoutersym (tvecs, tblock + i * len, len);
    }
}
void
getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
          double *xmean, double *xfancy)
// side effect set xmean xfancy
{
  int n;
  double pmean, yfancy;
  int *rawcol;

  if (xmean != NULL)
    {
      xmean[col] = xfancy[col] = 0.0;
    }

  if (cupt->ignore)
    {
      vzero (xcol, nrows);
      return;
    }

  ZALLOC(rawcol, nrows, int);
  n = cupt->ngtypes;
  if (n < nrows)
    fatalx ("bad snp: %s %d\n", cupt->ID, n);
  getrawcol (rawcol, cupt, xindex, nrows);
  floatit (xcol, rawcol, nrows);

  fvadjust (xcol, nrows, &pmean, &yfancy);
  vst (xcol, xcol, yfancy, nrows);
  if (xmean != NULL)
    {
      xmean[col] = pmean * yfancy;
      xfancy[col] = yfancy;
    }
  free (rawcol);
}

