int
main (int argc, char *argv[])
{
double N1, N2, Nanc, NancLower, *uniqTauArray = NULL, *taxonTauArray = NULL,
*descendant1ThetaArray = NULL, *descendant2ThetaArray = NULL,
*ancestralThetaArray = NULL, spTheta, thetaMean, tauequalizer, gaussTime = 0.0,
mig, rec, BottStr1, BottStr2, BottleTime;
double *recTbl;
int tauClass, *PSIarray = NULL, i;
unsigned int numTauClasses = -1, u, locus, taxonID, zzz;
unsigned long randSeed;
unsigned long long rep;
extern const gsl_rng *gBaseRand;
int comp_nums (const void *, const void *);
int b_constrain = 0;
int *subParamConstrainConfig = NULL;
#ifndef HOMOGENEOUS_MUT
double *mutScalerTbl;
#endif
/* set up gParam and gMutParam, as well as gConParam if constrain */
LoadConfiguration (argc, argv);
/* set the lower Nanc */
/* NancLower = 0.00001 * gParam.lowerTheta; */
/* if (NancLower < 0.00000000004) { /1* 4 * (mu=10^(-11)) * (Ne=1) *1/ */
/* NancLower = 0.00000000004; */
/* } */
/* set b_constrain to 1 if constrain */
if (gParam.constrain > 0)
{
//initialize constrain indicator
b_constrain = 1;
//initialize subParamConstrainConfig array
subParamConstrainConfig = calloc (NUMBER_OF_CONPARAM, sizeof (int));
if (subParamConstrainConfig == NULL)
{
fprintf (stderr,
"ERROR: Not enough memory for subParamConstrainConfig\n");
exit (EXIT_FAILURE);
}
for (i = 0; i < strlen (gParam.subParamConstrain); i++)
{
char a = (gParam.subParamConstrain)[i];
if (a == '1')
subParamConstrainConfig[i] = 1;
else if (a == '0')
subParamConstrainConfig[i] = 0;
else {
fprintf(stderr, "ERROR: subParamConstrain string in the config file"
"should be either 0 or 1\n");
exit (EXIT_FAILURE);
}
}
}
/* for initiating the gsl random number generator */
/* initialize PRNG */
srand (gParam.prngSeed); /* Better way of seeding here ? */
randSeed = rand ();
if (debug_level > 0)
randSeed = 1;
gBaseRand = gsl_rng_alloc (gsl_rng_mt19937); /* set the base PRNG to
Mersenne Twister */
gsl_rng_set (gBaseRand, randSeed); /* seed the PRNG */
/* print out all of the parameters */
if(gParam.printConf) {
PrintParam(stdout);
exit (0);
}
/* set up arrays */
/* Sizes are set to the number of taxon pairs (Max number of tau's) */
if ((b_constrain == 1) && (subParamConstrainConfig[0] == 1)) {
uniqTauArray = calloc (gParam.numTaxonLocusPairs, sizeof (double));
PSIarray = calloc (gParam.numTaxonLocusPairs, sizeof (int));
taxonTauArray = calloc(gParam.numTaxonLocusPairs, sizeof (double));
} else {
uniqTauArray = calloc (gParam.numTaxonPairs, sizeof (double));
PSIarray = calloc (gParam.numTaxonPairs, sizeof (int));
taxonTauArray = calloc(gParam.numTaxonPairs, sizeof (double));
}
descendant1ThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
descendant2ThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
ancestralThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
recTbl = calloc (gParam.numLoci, sizeof (double));
if (uniqTauArray == NULL || PSIarray == NULL || recTbl == NULL ||
taxonTauArray == NULL || descendant1ThetaArray == NULL ||
descendant2ThetaArray == NULL || ancestralThetaArray == NULL)
{
fprintf (stderr, "ERROR: Not enough memory for uniqTauArray, PSIarray, or recTbl\n");
exit (EXIT_FAILURE);
}
/* deal with num tau classes */
if (b_constrain == 0 || subParamConstrainConfig[0] != 1)
{
/* fixed numTauClasses configuration */
if (gParam.numTauClasses != 0)
{
if (gParam.numTauClasses > gParam.numTaxonPairs)
{
fprintf (stderr, "WARN: numTauClasses (%u) is larger than "
"numTaxonPairs (%u). Setting numTauClasses to %u",
gParam.numTauClasses, gParam.numTaxonPairs,
gParam.numTaxonPairs);
gParam.numTauClasses = gParam.numTaxonPairs;
}
numTauClasses = gParam.numTauClasses;
}
} /* when tau is constrained numTauClasses are set later */
/* deal with the case when tau is constrained */
if ((b_constrain == 1) && (subParamConstrainConfig[0] == 1)) {
int jj, kk;
double *tempTauArray;
if ((tempTauArray = calloc(gParam.numTaxonLocusPairs, sizeof(double)))
== NULL) {
fprintf (stderr, "ERROR: Not enough memory for tempTauArray\n");
exit (EXIT_FAILURE);
}
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
tempTauArray[jj] = (gConParam.conData[jj]).conTau;
}
numTauClasses = UniqueDouble(tempTauArray, uniqTauArray,
gParam.numTaxonLocusPairs, DBL_EPSILON);
if (gParam.numTauClasses != numTauClasses) {
fprintf (stderr, "WARN: tau's are constrained and found %u different "
"classes in the constrain table. But numTauClasses = %u was set."
" Using the value found in the constrain table.\n", numTauClasses,
gParam.numTauClasses);
gParam.numTauClasses = numTauClasses;
}
/* count tau's to create PSIarray */
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
PSIarray[jj] = 0;
}
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
for (kk = 0; kk < numTauClasses; kk++) {
/* there shouldn't be fabs() below */
if (tempTauArray[jj] - uniqTauArray[kk] < DBL_EPSILON) {
PSIarray[kk]++;
break;
}
}
}
free (tempTauArray);
}
#ifndef HOMOGENEOUS_MUT
if ((mutScalerTbl = calloc(gParam.numLoci, sizeof(double))) == NULL) {
fprintf (stderr, "ERROR: Not enough memory for mutScalerTbl\n");
exit(EXIT_FAILURE);
}
#endif
thetaMean = 1.0;
if (gParam.timeInSubsPerSite == 0) {
thetaMean = (gParam.lowerTheta + gParam.upperTheta) / 2.0;
}
/* Beginning of the main loop */
for (rep = 0; rep < gParam.reps; rep++)
{
int lociTaxonPairIDcntr = 1;
/*
* Each taxon pair was separated at a time tau in the past. Of
* all pairs, some of them may have been separated at the same
* time. numTauClasses is the number of classes with different
* divergence time.
*
* If gParam.numTauClasses is not set, we are sampling
* numTauClasses from a uniform prior dist'n.
*/
if (gParam.numTauClasses == 0)
{ /* numTauClasses is NOT fixed */
numTauClasses =
1 + gsl_rng_uniform_int (gBaseRand, gParam.numTaxonPairs);
}
/* create the recombination rate table for each gene */
rec = gsl_ran_flat (gBaseRand, 0.0, gParam.upperRec);
for (u=0; u < gParam.numLoci; u++)
{
/* all loci shares same recombination rate */
recTbl[u] = rec;
/* each locus has different recomb. rate
recTbl[u] = gsl_ran_flat (gBaseRand, 0.0, gParam.upperRec);
*/
}
#ifndef HOMOGENEOUS_MUT
/* create regional heterogeneity in the mutation rate */
if (gParam.numLoci > 1) {
double shape, scale;
/* arbitrary sample the shape parameter from uniform dist'n */
shape = gsl_ran_flat(gBaseRand, 1.0, 20);
/* shape = 1 is exponential with lambda=1,
larger shape -> normal dist'n with smaller var */
scale = 1/shape; /* E[x] = 1, Var[x] = shape * scale^2 = 1/shape */
/* use gamma */
for (u=0; u < gParam.numLoci; u++) {
mutScalerTbl[u] = gsl_ran_gamma(gBaseRand, shape, scale);
}
} else {
mutScalerTbl[0] = 1.0;
}
#endif
// Randomly generate TauArray only when NOT constrain
if ((b_constrain == 0) || (subParamConstrainConfig[0] != 1))
{
int counter;
/* sample tau's from uniform prior dist'n */
for (u = 0; u < numTauClasses; u++)
// JRO - modified - 11/17/2011
// uniqTauArray[u] = gsl_ran_flat (gBaseRand, 0.0, gParam.upperTau);
uniqTauArray[u] = gsl_ran_flat (gBaseRand, gParam.lowerTau,
gParam.upperTau);
qsort(uniqTauArray, numTauClasses, sizeof(double),comp_nums);
for (counter = 0; counter < numTauClasses; counter++)
{
taxonTauArray[counter] = uniqTauArray[counter];
PSIarray[counter] = 1;
}
for (counter = numTauClasses;
counter < gParam.numTaxonPairs; counter++)
{
tauClass = gsl_rng_uniform_int(gBaseRand, numTauClasses);
taxonTauArray[counter] = uniqTauArray[tauClass];
PSIarray[tauClass] = PSIarray[tauClass] + 1;
}
/* randomly shuflling the order of taxonTauArray */
gsl_ran_shuffle(gBaseRand, taxonTauArray,
gParam.numTaxonPairs, sizeof (double));
}
for (taxonID = 0; taxonID < gParam.numTaxonPairs; taxonID++)
{
//Check upperAncPopSize before doing anything
/* ancestral population size prior */
if (gParam.upperAncPopSize < gParam.lowerTheta)
{
fprintf (stderr,
"The upper bound (%lf * %lf) of ancestral pop. size is "
"smaller than the lower bound (%lf)\n",
gParam.upperAncPopSize, gParam.upperTheta, gParam.lowerTheta);
exit (EXIT_FAILURE);
}
constrainedParameter conTaxonPairDat;
/* Population sizes during the bottleneck after the divergence of 2
pops. This is same as the population sizes, immediately after the
divergence/separation of the 2 pops. These are relative sizes. */
BottStr1 = gsl_ran_flat (gBaseRand, 0.01, 1.0);
BottStr2 = gsl_ran_flat (gBaseRand, 0.01, 1.0);
/* After the populations diverge, they experience pop. bottleneck.
Then the population size exponentially grows until current size.
BottleTime indicate the time when population started to grow.
BottleTime of 1 means, populations start to expand immediately
after divergence. Closer to 0 means, populations hasn't started
to expand until very recently. */
BottleTime = gsl_ran_flat (gBaseRand, 0.000001, 1.0);
/* migration rate prior */
mig = gsl_ran_flat (gBaseRand, 0.0, gParam.upperMig);
/* spTheta prior */
while ((spTheta = gsl_ran_flat (gBaseRand, gParam.lowerTheta,
gParam.upperTheta)) <= 0);
/* The ratio of current population sizes. The populations
exponentially grow to these sizes after bottkleneck is done. */
/* both ends excluded for symmetry */
while ((N1 = gsl_ran_flat (gBaseRand, 0.01, 1.99)) == 0.01)
;
N2 = 2.0 - N1;
/* The upper limit of ancestral theta is defined by the product
of upper Theta (e.g. 40) and upper AncPopSize (e.g. 0.5) */
/* JRO - changing the following hard coded lower limit on ancestral
theta to the lower limit specified by user */
/* Nanc = gsl_ran_flat (gBaseRand, 0.01,
gParam.upperAncPopSize * gParam.upperTheta);*/
Nanc = gsl_ran_flat (gBaseRand, gParam.lowerTheta,
gParam.upperAncPopSize * gParam.upperTheta);
descendant1ThetaArray[taxonID] = spTheta * N1;
descendant2ThetaArray[taxonID] = spTheta * N2;
ancestralThetaArray[taxonID] = Nanc;
/* pick a tau for every taxon-pair with replacement from the
array of X taxon-pairs, where X is a uniform discrete RV
from 1 to number of taxon-pairs */
if ((b_constrain == 0) || (subParamConstrainConfig[0] != 1))
{
gaussTime = taxonTauArray[taxonID];
}
/* use the following if simulating a particular fixed history */
/* gaussTime = uniqTauArray[taxonID]; */
/* print out the results by going through each locus */
for (locus = 0; locus < gParam.numLoci; locus++)
{
double locTheta, thisNanc, scaledGaussTime, scaledBottleTime;
/* check if this locus exist for this taxon pair */
/* this table contains 0-offset index for corresponding
taxon:locus mutPara */
int mpIndex = gMutParam.locTbl->tbl[taxonID][locus];
if(mpIndex<0) { /* this taxon:locus is not in the data */
continue;
}
if (b_constrain == 1)
{ /* If constrained, override with the fixed paras */
/* This part is not debugged well 2/14/2008, Naoki */
int mpIndex = gMutParam.locTbl->tbl[taxonID][locus];
conTaxonPairDat = gConParam.conData[mpIndex];
/* tau */
/* This allow that tau could differ between loci
within a single taxon pair */
if (subParamConstrainConfig[0] == 1)
gaussTime = conTaxonPairDat.conTau;
/** bottleneck priors **/
/* severity of bottle neck (how small the pop become) */
/* these should be [0,1] */
if (subParamConstrainConfig[1] == 1)
BottStr1 = conTaxonPairDat.conBottPop1;
if (subParamConstrainConfig[2] == 1)
BottStr2 = conTaxonPairDat.conBottPop2;
/* timing of bottle neck */
/* should be [0,1] */
if (subParamConstrainConfig[3] == 1)
BottleTime = conTaxonPairDat.conBottleTime;
/* migration rate prior */
if (subParamConstrainConfig[4] == 1)
mig = conTaxonPairDat.conMig;
/* theta per site */
if (subParamConstrainConfig[5] == 1)
spTheta = conTaxonPairDat.conTheta;
/* population sizes immediately after the separation, and
what it grows to after the bottleneck (today) */
/* (0.01, 1.99) */
if (subParamConstrainConfig[6] == 1) {
N1 = conTaxonPairDat.conN1;
N2 = 2.0 - N1;
}
/* The upper limit of ancestral theta is defined by the
product of upper Theta (e.g. 40) and upper
AncPopSize (e.g. 0.5), then converted to relative size
to spTheta */
if (subParamConstrainConfig[7] == 1)
Nanc = conTaxonPairDat.conNanc * gParam.upperTheta;
/* recombination rate per neighboring site */
if (subParamConstrainConfig[8] == 1)
recTbl[locus] = conTaxonPairDat.conRec;
} /* end of constrai */
/* access sample sizes, mutational model for this taxon:locus */
mutParameter taxonPairDat;
taxonPairDat = gMutParam.data[mpIndex];
/* scale the theta for each locus */
/* Note that species wide theta (represents pop size) is
4 Ne mu with mu per site, not per gene.
Assumes mu is constant. This may be a problem with
mitochondoria */
locTheta = spTheta * taxonPairDat.seqLen *
taxonPairDat.NScaler * taxonPairDat.mutScaler;
#ifndef HOMOGENEOUS_MUT
locTheta *= mutScalerTbl[locus];
#endif
/* thisNanc is basically a random deviate from a uniform dist'n:
[gParam.lowerTheta / spTheta,
gParam.upperAncPopSize * gParam.upperTheta/spTheta)
For example, if upperTheta = 10 & upperAncPopSize = 0.5,
upperAncTheta become 10 * 0.5 = 5.
msDQH specify the past population sizes in terms of the
ratio of N_anc / N_theta, so the following division
by locTheta is required.
*/
/* thisNanc = Nanc * taxonPairDat.seqLen / locTheta; */
thisNanc = Nanc / spTheta; /* this can be done outside of locus loop */
/* this scaling is done inside of locus loop to accomodate
the gamma dist'n of mut rate for each locus */
/* tauequalizer = gParam.upperTheta / */
/* 2 / (spTheta * taxonPairDat.NScaler); */
tauequalizer = thetaMean / (spTheta * taxonPairDat.NScaler);
/* WORK, CONFIRM THIS. Naoki Nov 2, 2009. IT USED TO BE
tauequalizer = gParam.upperTheta * taxonPairDat.seqLen /
2 / locTheta;
*/
/* Division by 2 is coming from N1 + N2 = 2.
We are considering that N_0 in theta_0 (=4 N_0 mu) specified
for -t option (we use -t locTheta) of msDQH is equal to
(N1+N2)/2 */
scaledGaussTime = gaussTime * tauequalizer;
/* 1 unit of tau (gaussTime) = 2 N_max (N_max is the
N assumed in upperTheta) */
/* I think we should get rid of /2 from tauequalizer */
/* JRO: Yes the following is weird and the threshold of 0.0001
* coalescent units can actually be thousands of generations which
* is not trivial. Also, the hack to avoid unrealistic growth rates
* is the wrong approach. If the div time is essentially zero, then
* there should simply be no bottleneck. Updating to make the
* threshold smaller, and simply preventing a bottleneck if the
* div time is smaller.*/
/* The following if is a little weird */
/* if (scaledGaussTime < 0.0001) { */
/* scaledGaussTime = 0.0001; */
/* scaledBottleTime = 0.00005; */
/* } else { */
/* scaledBottleTime = BottleTime * 0.95 * scaledGaussTime; */
/* } */
if (scaledGaussTime < 0.000001) {
// no bottleneck if div time is essentially zero
BottStr1 = 1.0;
BottStr2 = 1.0;
}
scaledBottleTime = BottleTime * 0.95 * scaledGaussTime;
if (debug_level)
fprintf (stderr,
"DEBUG: scaled BottleTime:%lf\tgaussTime:%lf\n",
scaledBottleTime, scaledGaussTime);
/* We can send some extra info to msbayes.pl here */
printf ("%u %u %u ", lociTaxonPairIDcntr, taxonID+1, locus+1);
lociTaxonPairIDcntr ++; /* seriral id: 1 to # taxon:locus pairs */
printf ("%.17lf %.17lf %.17lf %.17lf ",
locTheta, scaledGaussTime, mig,
recTbl[locus] * (taxonPairDat.seqLen - 1));
printf ("%.17lf %.17lf %.17lf ", scaledBottleTime,
BottStr1 * N1, BottStr2 * N2);
printf ("%u %u %u %lf %lf %lf ",
taxonPairDat.numPerTaxa,
taxonPairDat.sample[0], taxonPairDat.sample[1],
taxonPairDat.tstv[0], taxonPairDat.tstv[1],
taxonPairDat.gamma);
printf ("%u %.17lf %.17lf %.17lf ",
taxonPairDat.seqLen, N1, N2, thisNanc);
printf ("%lf %lf %lf %lf\n",
taxonPairDat.freqA, taxonPairDat.freqC,
taxonPairDat.freqG, taxonPairDat.freqT);
/* These feed into the system command line (msDQH) within
the perl shell msbayes. Some of these are used directly
by msDQH, but some are also passed on to the sumstats
programs via the msDQH commabnd line, .... like bp[taxonID],
theta, gaussTime, NumPerTax[taxonID], yy, */
}
}
/* The followings are used to calculate prior, processed in msbayes.pl */
printf ("# TAU_PSI_TBL setting: %d realizedNumTauClasses: %u",
gParam.numTauClasses, numTauClasses);
printf(" tauTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%.11lf", taxonTauArray[zzz]);
printf(" d1ThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", descendant1ThetaArray[zzz]);
printf(" d2ThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", descendant2ThetaArray[zzz]);
printf(" aThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", ancestralThetaArray[zzz]);
printf("\n");
}
free (uniqTauArray);
free (taxonTauArray);
free (PSIarray);
free (descendant1ThetaArray);
free (descendant2ThetaArray);
free (ancestralThetaArray);
free (recTbl);
free (subParamConstrainConfig);
exit (0);
}
int BinlessWarpComp(struct options_binless *opts,
double **times,
int *n_vec,
int N,
double **tau_j)
{
double **j;
double *all_times,*all_times_unique,*all_times_sorted;
int *all_times_unique_i,*all_times_unique_j,*all_times_sorted_idx;
int *cnt;
double *mean_ranks,*ranks_vec;
int u,p,m,q;
int U;
int cur_idx;
int cum_cnt;
double min_time,max_time;
int M;
/* How many spikes do we have? */
M=0;
for(p=0;p<N;p++)
M+=n_vec[p];
all_times = (double *)calloc(M,sizeof(double));
all_times_unique = (double *)malloc(M*sizeof(double));
all_times_unique_i=(int *)calloc(M,sizeof(int));
all_times_unique_j=(int *)calloc(M,sizeof(int));
all_times_sorted = (double *)malloc(M*sizeof(double));
all_times_sorted_idx=(int *)calloc(M,sizeof(int));
cnt = (int *)calloc(M,sizeof(double));
/* If there are no spikes anywhere, we can bypass all of this */
if(M==0)
return EXIT_SUCCESS;
/* Concatenate all of the spike trains */
cur_idx = 0;
for(p=0;p<N;p++)
{
memcpy(&all_times[cur_idx],times[p],n_vec[p]*sizeof(double));
cur_idx += n_vec[p];
}
/* Get a vector of all of the unique spike times */
U = UniqueDouble(M,all_times,all_times_unique,all_times_unique_i,all_times_unique_j,cnt);
min_time = all_times_unique[0];
max_time = all_times_unique[U-1];
#ifdef DEBUG
printf("M=%d U=%d min_time=%f max_time=%f\n",M,U,min_time,max_time);
#endif
mean_ranks = (double *)malloc(U*sizeof(double));
/* Find the mean ranks within each group */
cum_cnt = 0;
for(u=0;u<U;u++)
{
mean_ranks[u] = (((double)(cnt[u]+1))/2) + cum_cnt;
#ifdef DEBUG
printf("idx[%d]=%d mean_ranks[%d]=%f cnt[%d]=%d cum_cnt=%d\n",u,all_times_unique_j[u],u,mean_ranks[u],u,cnt[u],cum_cnt);
#endif
cum_cnt += cnt[u];
}
/* Now get the rankings back to their original spike train */
ranks_vec = (double *)malloc(M*sizeof(double));
for(m=0;m<M;m++)
ranks_vec[m] = mean_ranks[all_times_unique_j[m]];
/* Deconcatenate the ranks */
/* and do the time warping (Eq. 17) */
j = (double **)malloc(N*sizeof(double *));
cur_idx = 0;
for(p=0;p<N;p++)
{
j[p] = &ranks_vec[cur_idx];
for(q=0;q<n_vec[p];q++)
{
if((*opts).warp_strat==0) /* Non-uniform warping */
tau_j[p][q] = (*opts).w_start + (((*opts).w_end-(*opts).w_start)/(max_time-min_time))*times[p][q];
else
tau_j[p][q] = (*opts).w_start + (((*opts).w_end-(*opts).w_start)*(j[p][q]-0.5)/((double)M));
#ifdef DEBUG
printf("times[%d][%d]=%.3f j[%d][%d]=%.1f tau_j[%d][%d]=%.3f\n",p,q,times[p][q],p,q,j[p][q],p,q,tau_j[p][q]);
#endif
}
#ifdef DEBUG
printf("\n");
#endif
cur_idx += n_vec[p];
}
free(all_times);
free(all_times_unique);
free(all_times_unique_i);
free(all_times_unique_j);
free(cnt);
free(mean_ranks);
free(ranks_vec);
free(j);
return EXIT_SUCCESS;
}
