void hufmak(unsigned long nfreq[], unsigned long nchin, unsigned long *ilong,
unsigned long *nlong, huffcode *hcode)
{
void hufapp(unsigned long index[], unsigned long nprob[], unsigned long n,
unsigned long i);
int ibit;
long node,*up;
unsigned long j,k,*index,n,nused,*nprob;
static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L,
0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L,
0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L,
0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L,
0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L};
hcode->nch=nchin;
index=lvector(1,(long)(2*hcode->nch-1));
up=(long *)lvector(1,(long)(2*hcode->nch-1));
nprob=lvector(1,(long)(2*hcode->nch-1));
for (nused=0,j=1;j<=hcode->nch;j++) {
nprob[j]=nfreq[j];
hcode->icod[j]=hcode->ncod[j]=0;
if (nfreq[j]) index[++nused]=j;
}
for (j=nused;j>=1;j--) hufapp(index,nprob,nused,j);
k=hcode->nch;
while (nused > 1) {
node=index[1];
index[1]=index[nused--];
hufapp(index,nprob,nused,1);
nprob[++k]=nprob[index[1]]+nprob[node];
hcode->left[k]=node;
hcode->right[k]=index[1];
up[index[1]] = -(long)k;
up[node]=index[1]=k;
hufapp(index,nprob,nused,1);
}
up[hcode->nodemax=k]=0;
for (j=1;j<=hcode->nch;j++) {
if (nprob[j]) {
for (n=0,ibit=0,node=up[j];node;node=up[node],ibit++) {
if (node < 0) {
n |= setbit[ibit];
node = -node;
}
}
hcode->icod[j]=n;
hcode->ncod[j]=ibit;
}
}
*nlong=0;
for (j=1;j<=hcode->nch;j++) {
if (hcode->ncod[j] > *nlong) {
*nlong=hcode->ncod[j];
*ilong=j-1;
}
}
free_lvector(nprob,1,(long)(2*hcode->nch-1));
free_lvector((unsigned long *)up,1,(long)(2*hcode->nch-1));
free_lvector(index,1,(long)(2*hcode->nch-1));
}
void init_fit(unsigned short int number_of_points) {
unsigned short int i;
y_fixed = lvector(0,number_of_points-1);
x_fixed = lvector(0,number_of_points-1);
y_floating = vector(0,number_of_points-1);
x_floating = vector(0,number_of_points-1);
for (i=0; i<number_of_points; i++) {
x_fixed[i] = 250*i;
x_floating[i] = 250.0*i;
}
// this is a memory leak...
}
int main(void)
{
unsigned long i,j,msize,*ija;
float **a,*sa,*ax,*b;
static float ainit[NP][NP]={
3.0,0.0,1.0,0.0,0.0,
0.0,4.0,0.0,0.0,0.0,
0.0,7.0,5.0,9.0,0.0,
0.0,0.0,0.0,0.0,2.0,
0.0,0.0,0.0,6.0,5.0};
static float x[NP+1]={0.0,1.0,2.0,3.0,4.0,5.0};
ija=lvector(1,NMAX);
ax=vector(1,NP);
b=vector(1,NP);
sa=vector(1,NMAX);
a=convert_matrix(&ainit[0][0],1,NP,1,NP);
sprsin(a,NP,0.5,NMAX,sa,ija);
msize=ija[1]-2;
sprstx(sa,ija,x,b,msize);
for (i=1;i<=msize;i++)
for (ax[i]=0.0,j=1;j<=msize;j++) ax[i] += a[j][i]*x[j];
printf("\tReference\tsprstx result\n");
for (i=1;i<=msize;i++) printf("\t%5.2f\t\t%5.2f\n",ax[i],b[i]);
free_convert_matrix(a,1,NP,1,NP);
free_vector(sa,1,NMAX);
free_vector(b,1,NP);
free_vector(ax,1,NP);
free_lvector(ija,1,NMAX);
return 0;
}
int main(void)
{
float d,**a,**al,*b,*x;
unsigned long i,j,*indx;
long idum=(-1);
a=matrix(1,7,1,4);
x=vector(1,7);
b=vector(1,7);
al=matrix(1,7,1,2);
indx=lvector(1,7);
for (i=1;i<=7;i++) {
x[i]=ran1(&idum);
for (j=1;j<=4;j++) {
a[i][j]=ran1(&idum);
}
}
banmul(a,7,2,1,x,b);
for (i=1;i<=7;i++) printf("%ld %12.6f %12.6f\n",i,b[i],x[i]);
bandec(a,7,2,1,al,indx,&d);
banbks(a,7,2,1,al,indx,b);
for (i=1;i<=7;i++) printf("%ld %12.6f %12.6f\n",i,b[i],x[i]);
free_lvector(indx,1,7);
free_matrix(al,1,7,1,2);
free_vector(b,1,7);
free_vector(x,1,7);
free_matrix(a,1,7,1,4);
return 0;
}
float selip(unsigned long k, unsigned long n, float arr[])
{
void shell(unsigned long n, float a[]);
unsigned long i,j,jl,jm,ju,kk,mm,nlo,nxtmm,*isel;
float ahi,alo,sum,*sel;
if (k < 1 || k > n || n <= 0) nrerror("bad input to selip");
isel=lvector(1,M+2);
sel=vector(1,M+2);
kk=k;
ahi=BIG;
alo = -BIG;
for (;;) {
mm=nlo=0;
sum=0.0;
nxtmm=M+1;
for (i=1;i<=n;i++) {
if (arr[i] >= alo && arr[i] <= ahi) {
mm++;
if (arr[i] == alo) nlo++;
if (mm <= M) sel[mm]=arr[i];
else if (mm == nxtmm) {
nxtmm=mm+mm/M;
sel[1 + ((i+mm+kk) % M)]=arr[i];
}
sum += arr[i];
}
}
if (kk <= nlo) {
FREEALL
return alo;
}
else if (mm <= M) {
int main(void)
{
char txt[MAXSTR];
unsigned long i,j,k,l,*indx,*irank;
float *a,b[11];
FILE *fp;
indx=lvector(1,NP);
irank=lvector(1,NP);
a=vector(1,NP);
if ((fp = fopen("tarray.dat","r")) == NULL)
nrerror("Data file tarray.dat not found\n");
fgets(txt,MAXSTR,fp);
for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]);
fclose(fp);
indexx(NP,a,indx);
rank(NP,indx,irank);
printf("original array is:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]);
printf("\n");
}
printf("table of ranks is:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) printf("%7d",irank[10*i+j]);
printf("\n");
}
printf("press return to continue...\n");
(void) getchar();
printf("array sorted according to rank table:\n");
for (i=0;i<=9;i++) {
for (j=1;j<=10;j++) {
k=10*i+j;
for (l=1;l<=NP;l++)
if (irank[l] == k) b[j]=a[l];
}
for (j=1;j<=10;j++) printf("%7.2f",b[j]);
printf("\n");
}
free_vector(a,1,NP);
free_lvector(irank,1,NP);
free_lvector(indx,1,NP);
return 0;
}
LONGVECTOR *new_longvector( long nh)
{
LONGVECTOR *m;
m=(LONGVECTOR *)malloc(sizeof(LONGVECTOR));
if (!m) t_error("allocation failure in LONGVECTOR()");
m->isdynamic=isDynamic;
m->nl=NL;
m->nh=nh;
m->co=lvector(m->nl,nh);
return m;
}
int main(void)
{
int isign;
long idum=(-23);
unsigned long i,j,k,l,ndum=2,*nn;
float *data1,*data2;
nn=lvector(1,NDIM);
data1=vector(1,NDAT2);
data2=vector(1,NDAT2);
for (i=1;i<=NDIM;i++) nn[i]=(ndum <<= 1);
for (i=1;i<=nn[3];i++)
for (j=1;j<=nn[2];j++)
for (k=1;k<=nn[1];k++) {
l=k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1];
l=(l<<1)-1;
/* real part of component */
data2[l]=data1[l]=2*ran1(&idum)-1;
/* imaginary part of component */
l++;
data2[l]=data1[l]=2*ran1(&idum)-1;
}
isign=1;
fourn(data2,nn,NDIM,isign);
/* here would be any processing to be done in Fourier space */
isign = -1;
fourn(data2,nn,NDIM,isign);
printf("Double 3-dimensional transform\n\n");
printf("%22s %24s %20s\n",
"Double transf.","Original data","Ratio");
printf("%10s %13s %12s %13s %11s %13s\n\n",
"real","imag.","real","imag.","real","imag.");
for (i=1;i<=4;i++) {
k=2*(j=2*i);
l=k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1];
l=(l<<1)-1;
printf("%12.2f %12.2f %10.2f %12.2f %14.2f %12.2f\n",
data2[l],data2[l+1],data1[l],data1[l+1],
data2[l]/data1[l],data2[l+1]/data1[l+1]);
}
printf("\nThe product of transform lengths is: %4lu\n",nn[1]*nn[2]*nn[3]);
free_vector(data2,1,NDAT2);
free_vector(data1,1,NDAT2);
free_lvector(nn,1,NDIM);
return 0;
}
/* rscale() allocates and fills rs[], the array of box sizes used by dfa()
below. The box sizes range from (exactly) minbox to (approximately) maxbox,
and are arranged in a geometric series such that the ratio between
consecutive box sizes is (approximately) boxratio. The return value is
the number of box sizes in rs[].
*/
int rscale(long minbox, long maxbox, double boxratio)
{
int ir, n;
long rw;
/* Determine how many scales are needed. */
rslen = log10(maxbox / (double)minbox) / log10(boxratio) + 1.5;
/* Thanks to Peter Domitrovich for pointing out that a previous version
of the above calculation undercounted the number of scales in some
situations. */
rs = lvector(1, rslen);
for (ir = 1, n = 2, rs[1] = minbox; n <= rslen && rs[n-1] < maxbox; ir++)
if ((rw = minbox * pow(boxratio, ir) + 0.5) > rs[n-1])
rs[n++] = rw;
if (rs[--n] > maxbox) --n;
return (n);
}
void sort3(unsigned long n, float ra[], float rb[], float rc[])
{
void indexx(unsigned long n, float arr[], unsigned long indx[]);
unsigned long j,*iwksp;
float *wksp;
iwksp=lvector(1,n);
wksp=vector(1,n);
indexx(n,ra,iwksp);
for (j=1;j<=n;j++) wksp[j]=ra[j];
for (j=1;j<=n;j++) ra[j]=wksp[iwksp[j]];
for (j=1;j<=n;j++) wksp[j]=rb[j];
for (j=1;j<=n;j++) rb[j]=wksp[iwksp[j]];
for (j=1;j<=n;j++) wksp[j]=rc[j];
for (j=1;j<=n;j++) rc[j]=wksp[iwksp[j]];
free_vector(wksp,1,n);
free_lvector(iwksp,1,n);
}
lref_t ltime_apply0(lref_t fn)
{
if (!PROCEDUREP(fn))
vmerror_wrong_type_n(1, fn);
flonum_t t = sys_runtime();
flonum_t gc_t = interp.gc_total_run_time;
size_t cells = interp.gc_total_cells_allocated;
size_t fops = CURRENT_TIB()->count_fop;
size_t frames = CURRENT_TIB()->count_enter_frame;
lref_t argv[6];
argv[0] = apply1(fn, 0, NULL);
argv[1] = flocons(sys_runtime() - t);
argv[2] = flocons(interp.gc_total_run_time - gc_t);
argv[3] = fixcons(interp.gc_total_cells_allocated - cells);
argv[4] = fixcons(CURRENT_TIB()->count_fop - fops);
argv[5] = fixcons(CURRENT_TIB()->count_enter_frame - frames);
return lvector(6, argv);
}
int main(void)
{
unsigned long i,j,k,*ija,*ijb,*ijbt,*ijc;
float *sa,*sb,*sbt,*sc,**a,**b,**c,**ab;
static float ainit[NP][NP]={
1.0,0.5,0.0,0.0,0.0,
0.5,2.0,0.5,0.0,0.0,
0.0,0.5,3.0,0.5,0.0,
0.0,0.0,0.5,4.0,0.5,
0.0,0.0,0.0,0.5,5.0};
static float binit[NP][NP]={
1.0,1.0,0.0,0.0,0.0,
1.0,2.0,1.0,0.0,0.0,
0.0,1.0,3.0,1.0,0.0,
0.0,0.0,1.0,4.0,1.0,
0.0,0.0,0.0,1.0,5.0};
ija=lvector(1,NMAX);
ijb=lvector(1,NMAX);
ijbt=lvector(1,NMAX);
ijc=lvector(1,NMAX);
sa=vector(1,NMAX);
sb=vector(1,NMAX);
sbt=vector(1,NMAX);
sc=vector(1,NMAX);
c=matrix(1,NP,1,NP);
ab=matrix(1,NP,1,NP);
a=convert_matrix(&ainit[0][0],1,NP,1,NP);
b=convert_matrix(&binit[0][0],1,NP,1,NP);
sprsin(a,NP,0.5,NMAX,sa,ija);
sprsin(b,NP,0.5,NMAX,sb,ijb);
sprstp(sb,ijb,sbt,ijbt);
/* specify tridiagonal output, using fact that a is tridiagonal */
for (i=1;i<=ija[ija[1]-1]-1;i++) ijc[i]=ija[i];
sprspm(sa,ija,sbt,ijbt,sc,ijc);
for (i=1;i<=NP;i++) {
for (j=1;j<=NP;j++) {
ab[i][j]=0.0;
for (k=1;k<=NP;k++) {
ab[i][j]=ab[i][j]+a[i][k]*b[k][j];
}
}
}
printf("Reference matrix:\n");
for (i=1;i<=NP;i++) {
for (j=1;j<=NP;j++) printf("%5.2f\t",ab[i][j]);
printf("\n");
}
printf("sprspm matrix (should show only tridiagonals):\n");
for (i=1;i<=NP;i++) for (j=1;j<=NP;j++) c[i][j]=0.0;
for (i=1;i<=NP;i++) {
c[i][i]=sc[i];
for (j=ijc[i];j<=ijc[i+1]-1;j++) c[i][ijc[j]]=sc[j];
}
for (i=1;i<=NP;i++) {
for (j=1;j<=NP;j++) printf("%5.2f\t",c[i][j]);
printf("\n");
}
free_convert_matrix(b,1,NP,1,NP);
free_convert_matrix(a,1,NP,1,NP);
free_matrix(ab,1,NP,1,NP);
free_matrix(c,1,NP,1,NP);
free_vector(sc,1,NMAX);
free_vector(sbt,1,NMAX);
free_vector(sb,1,NMAX);
free_vector(sa,1,NMAX);
free_lvector(ijc,1,NMAX);
free_lvector(ijbt,1,NMAX);
free_lvector(ijb,1,NMAX);
free_lvector(ija,1,NMAX);
return 0;
}
/* "dsort_PP2" SORTS THE PROJECTION MATRIX IN ASCENDING ORDER OF THE
INDEX 'idx'. ADAPTED FROM THE NUMERICAL RECIPES 'HEAPSORT' ROUTINE. */
void dsort_PP2(dSparse_Matrix *MM,int n,int idx)
{
double x;
int i,ir,j,l,hi,i1,i2,ndx;
unsigned long rra,*ra;
if(n<2) return;
ndx = idx==1 ? 2 : 1;
/* CREATE A VECTOR TO INDEX THE ELEMENTS OF MM */
hi=0;
for(i=1;i<=n;i++)
if(MM->IDX[i][ndx]>hi)
hi=MM->IDX[i][ndx];
ra=lvector(1,n);
for(i=1;i<=n;i++)
ra[i]=(long)hi*(MM->IDX[i][idx]-1)+MM->IDX[i][ndx];
/* SORT */
l=(n >> 1)+1;
ir=n;
for(;;){
if(l > 1){
rra=ra[--l];
i1=MM->IDX[l][idx];
i2=MM->IDX[l][ndx];
x=MM->X[l];
}
else {
rra=ra[ir];
i1=MM->IDX[ir][idx];
i2=MM->IDX[ir][ndx];
x=MM->X[ir];
ra[ir]=ra[1];
MM->IDX[ir][idx]=MM->IDX[1][idx];
MM->IDX[ir][ndx]=MM->IDX[1][ndx];
MM->X[ir]=MM->X[1];
if (--ir == 1) {
ra[1]=rra;
MM->IDX[1][idx]=i1;
MM->IDX[1][ndx]=i2;
MM->X[1]=x;
break;
}
}
i=l;
j=l+l;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) j++;
if (rra < ra[j]) {
ra[i]=ra[j];
MM->IDX[i][idx]=MM->IDX[j][idx];
MM->IDX[i][ndx]=MM->IDX[j][ndx];
MM->X[i]=MM->X[j];
i=j;
j <<= 1;
} else j=ir+1;
}
ra[i]=rra;
MM->IDX[i][idx]=i1;
MM->IDX[i][ndx]=i2;
MM->X[i]=x;
}
free_lvector(ra,1,n);
}
int main(void)
{
int k;
unsigned long i,j,lc,lcode=MAXLINE,n,nch,nrad,nt,nfreq[257],tmp,zero=0;
unsigned char *code,mess[MAXLINE],ness[MAXLINE];
arithcode acode;
FILE *fp;
code=cvector(0,MAXLINE);
acode.ilob=lvector(1,NWK);
acode.iupb=lvector(1,NWK);
acode.ncumfq=lvector(1,MC+2);
if ((fp = fopen("text.dat","r")) == NULL)
nrerror("Input file text.dat not found.\n");
for (j=1;j<=256;j++) nfreq[j]=0;
while ((k=getc(fp)) != EOF) {
if ((k -= 31) >= 1) nfreq[k]++;
}
fclose(fp);
nch=96;
nrad=256;
/* here is the initialization that constructs the code */
arcmak(nfreq,(int)nch,(int)nrad,&acode);
/* now ready to prompt for lines to encode */
for (;;) {
printf("Enter a line:\n");
if (gets((char *)&mess[1]) == NULL) break;
n=strlen((char *)&mess[1]);
/* shift from 256 character alphabet to 96 printing characters */
for (j=1;j<=n;j++) mess[j] -= 32;
/* message initialization */
lc=1;
arcode(&zero,&code,&lcode,&lc,0,&acode);
/* here we arithmetically encode mess(1:n) */
for (j=1;j<=n;j++) {
tmp=mess[j];
arcode(&tmp,&code,&lcode,&lc,1,&acode);
}
/* message termination */
arcode(&nch,&code,&lcode,&lc,1,&acode);
printf("Length of line input, coded= %lu %lu\n",n,lc-1);
/* here we decode the message, hopefully to get the original back */
lc=1;
arcode(&zero,&code,&lcode,&lc,0,&acode);
for (j=1;j<=lcode;j++) {
arcode(&i,&code,&lcode,&lc,-1,&acode);
if (i == nch) break;
else ness[j]=(unsigned char)i;
}
if (j > lcode) nrerror("Arith. coding: Never get here");
nt=j-1;
printf("Decoded output:\n");
for (j=1;j<=nt;j++) printf("%c",(char)(ness[j]+32));
printf("\n");
if (nt != n) printf("Error ! j decoded != n input.\n");
}
free_cvector(code,0,MAXLINE);
free_lvector(acode.ncumfq,1,MC+2);
free_lvector(acode.iupb,1,NWK);
free_lvector(acode.ilob,1,NWK);
printf("Normal completion\n");
return 0;
}
void inline quicksort(unsigned long n, int arr[]){
if(n>1){
unsigned long i,ir=n,j,k,l=1,*istack;
int jstack=0;
int a,temp;
istack=lvector(1,NSTACK);
for (;;) {
//Insertion sort when subarray small enough.
if (ir-l < M) {
for (j=l+1;j<=ir;j++) {
a=arr[j];
for (i=j-1;i>=l;i--) {
if (arr[i] <= a) break;
arr[i+1]=arr[i];
}
arr[i+1]=a;
}
if (jstack == 0) break;
ir=istack[jstack--];
//Pop stack and begin a new round of parti-
l=istack[jstack--];
//tioning.
} else {
k=(l+ir) >> 1;
//Choose median of left, center, and right el-
SWAPINT(arr[k],arr[l+1]);
//ements as partitioning element a. Also
if (arr[l] > arr[ir]) {
//rearrange so that a[l] ≤ a[l+1] ≤ a[ir].
SWAPINT(arr[l],arr[ir]);
}
if (arr[l+1] > arr[ir]) {
SWAPINT(arr[l+1],arr[ir]);
}
if (arr[l] > arr[l+1]) {
SWAPINT(arr[l],arr[l+1]);
}
i=l+1;
//Initialize pointers for partitioning.
j=ir;
a=arr[l+1];
//Partitioning element.
for (;;) {
//Beginning of innermost loop.
do i++; while (arr[i] < a);
//Scan up to find element > a.
do j--; while (arr[j] > a);
//Scan down to find element < a.
if (j < i) break;
//Pointers crossed. Partitioning complete.
SWAPINT(arr[i],arr[j]);
//Exchange elements.
}
//End of innermost loop.
arr[l+1]=arr[j];
//Insert partitioning element.
arr[j]=a;
jstack += 2;
//Push pointers to larger subarray on stack, process smaller subarray immediately.
if (jstack > NSTACK) nrerror("NSTACK too small in sort.");
if (ir-i+1 >= j-l) {
istack[jstack]=ir;
istack[jstack-1]=i;
ir=j-1;
} else {
istack[jstack]=j-1;
istack[jstack-1]=l;
l=i;
}
}
}
free_lvector(istack,1,NSTACK);
}else{
void param_decomp(int argc, char ** argv)
/*
* Function param_decomp decomposites the commandline arguments
*/
{
int i,j;
long *seeds,seednum=3;
char *msg;
seeds=lvector(0,seednum-1);
msg="Synopsis:\n\tInStruct -d data_file -o output_file [-i initial_file] [-K population number] [-L loci number] [-N total individual number] [-p ploid] [-u iteration number] [-b burn-in number] [-m missingdata] [-t thinning] [-c chain number] [-s seed1 seed2 seed3] [-sl significance level] [-lb label] [-a popdata] [-g GR_flag] [-r ckrep] [-f prior_flag] [-v mode] [-h alpha_dpm] [-e back_refl] [-y type_freq] [-j nstep_check_empty_cluster] [-x extra_columns] [-w markername] [-cf convgfilename] [-pi print_iter] [-pf print_freq] [-ik inf_K] [-kv n_small n_large] [-df distr_fmt] [-ap autopoly] [-af data_fmt] [-mm max_mem]\n";
if(argc==2&&strcmp(argv[1],"-h")==0) /*print help message*/
{
fprintf(stdout,"%s",msg);
exit(1);
}
else {
if(argc<5) /* partition the commandline arguments*/
{
nrerror("Too few arguments in the command line!");
}
else {
for(i=1; i<argc; i++)
{
if(strcmp(argv[i],"-d")==0)
{ /*-d means to assign data file name*/
datafilename=argv[i+1];
continue;
}
if(strcmp(argv[i],"-o")==0)
{ /*-o means to assign output file name*/
outfilename=argv[i+1];
continue;
}
if(strcmp(argv[i],"-i")==0)
{ /*-i means to assign initial file name*/
initialfilename=argv[i+1];
continue;
}
if(strcmp(argv[i],"-cf")==0)
{ /*-cf means to assign initial file name*/
convgfilename=argv[i+1];
continue;
}
if(strcmp(argv[i],"-L")==0)
{ /*-L means to reassign the loci number a new value*/
nloci=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-N")==0)
{ /*-N means to reset the number of total individuals*/
totalsize=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-K")==0)
{ /*-K means to reassign population number a new value*/
popnum=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-p")==0)
{ /*-p means to reset the number of haplotype in a genome*/
ploid=atoi(argv[i+1]); /*for diploid, ploid=2*/
continue;
}
if(strcmp(argv[i],"-u")==0)
{ /*-u means to reset the number of update steps of MCMC*/
updatenum=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-b")==0)
{ /*-b means to reassign burnin number a new value*/
burnin=atoi(argv[i+1]);
if(burnin==0)
{
nrerror("Burn-in should not be zero!");
}
continue;
}
if(strcmp(argv[i],"-t")==0)
{ /*-t means to reassign thinning number a new value */
thinning=atoi(argv[i+1]); /*thinning is to take iterations at an even interval*/
continue; /*which can reduces the autocorrelation between iterations*/
} /*and thinning can also reduces the memory needed*/
if(strcmp(argv[i],"-c")==0)
{ /*-c means to reassign thinning number a new value*/
chainnum=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-m")==0)
{ /*-m means to reset the number that represents missing data*/
missingdata=argv[i+1];
continue;
}
if(strcmp(argv[i],"-lb")==0)
{ /*-lb indicates whether data_file contains labels for individuals, 1=yes, 0=no*/
label=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-a")==0)
{ /*-a indicates whether data_file contains a column about the original population information, 1=yes, 0=no*/
popdata=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-g")==0)
{ /*-g indicates whether the Gelman_Rudin statistic is used to check convergence,1=yes, 0=no*/
GR_flag=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-f")==0)
{ /*-f indicates which prior is used for selfing rates, 0=uniform,1=normal,2=DPM*/
prior_flag=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-v")==0)
{ /*-v indicates whether selfing rates are wrt. pop (0) or individuals (1)*/
mode=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-r")==0)
{ /*-r indicates how many stored iterations after burn-in are used in convergence checking*/
ckrep=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-e")==0)
{ /*-e indicates which proposal method for selfing rates, adaptive independence sampler(0) or back-reflection (1)*/
back_refl=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-y")==0)
{ /*-y indicates which way to calculate genotype frequency, expectation way (0) or structure way (1)*/
type_freq=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-x")==0)
{ /*-x indicates the number of extra columns in data file*/
n_extra_col=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-pi")==0)
{ /*-pi indicates whether to print the information of each iteration along MCMC running*/
print_iter=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-ap")==0)
{ /*-ap indicates whether the species is autopolyploid (1) or allopolyploid (0) */
autopoly=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-pf")==0)
{ /*-pf indicates whether to print the result of allele frequencies to output file*/
print_freq=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-w")==0)
{ /*-w indicates existence of marker name line*/
markername_flag=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-af")==0)
{ /*-af indicates which format of input file is used*/
data_fmt=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-mm")==0)
{ /*-mm indicates maximum memory allowed*/
max_mem=atof(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-ik")==0)
{ /*-ik indicates whether inferring the number of subpopulations or not*/
inf_K=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-kv")==0)
{ /*-kv indicates the lower and upper boundary for value of K*/
n_small=atoi(argv[i+1]);
n_large=atoi(argv[i+2]);
continue;
}
if(strcmp(argv[i],"-df")==0)
{ /*-df indicates whether to use the Distruct format for output (1) or not (0)*/
distr_fmt=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-sl")==0)
{ /*-sl means to reset the significance level*/
siglevel=atof(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-h")==0)
{ /*-h means to reset the spread alpha in Dirichlet Process Mixture model*/
alpha_dpm=atof(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-j")==0)
{ /*-j means to reset the number of iterations after burn-in that will be used to determine the existence of empty clusters*/
nstep_check_empty_cluster=atoi(argv[i+1]);
continue;
}
if(strcmp(argv[i],"-s")==0)
{
for(j=0; j<seednum; j++) /*-s means to reset seeds for the random number generator*/
{
seeds[j]=atoi(argv[i+j+1]);
}
setseeds(seeds[0],seeds[1],seeds[2]);
continue;
}
}
}
}
if(ckrep>((updatenum-burnin)/thinning))
{
nrerror("The number of iterations for convergence assessment is greater than the total number of retained iterations from MCMC.");
}
if(nstep_check_empty_cluster>((updatenum-burnin)/thinning))
{
nrerror("The number of iterations for checking the existence of empty cluster is greater than the total number of retained iterations from MCMC.");
}
free_lvector(seeds,0,seednum-1);
}
// ---------------- ReadSample ---------------------------
sample ReadSample(char samplefile[50])
{
struct sample InSample;
char line[500];
int abundI;
char preAbund[50];
int i, j, z, found;
char plotname[MAXPLOTLENGTH+1];
char lastplot[MAXPLOTLENGTH+1];
char taxaI[MAXTAXONLENGTH+1];
int lineending;
strcpy(lastplot, "");
i = 0;
InSample.nrec = 0;
InSample.nsamples = 0;
InSample.maxrec = 0;
InSample.ntaxa = 0;
InSample.totabund = 0;
// pre-pre-read
lineending = whatnewline(samplefile);
// preread:
// READ PROPERLY
if ((Ft = fopen(samplefile, "r")) == NULL)
{
printf("Cannot open sample file\n");
exit(0);
}
while (myfgets(line, 500, Ft, lineending) != NULL)
// OK to lv length undynamic
{
sscanf(line, "%s %s %s", plotname, preAbund, taxaI); // string
// Test for non-integer abundances:
z = 0;
while (preAbund[z] != '\0')
{
// printf("%d %d\n", z, preAbund[z]);
if (!isdigit(preAbund[z]))
{
fprintf(stderr,"Error: sample abundances must be integers\n");
exit(1);
}
z++;
}
InSample.nrec++;
// if a new plot:
if (strcmp(lastplot, plotname) != 0)
{
InSample.nsamples ++;
i = 0;
strcpy(lastplot, plotname);
}
i++;
if (InSample.maxrec < i) InSample.maxrec = i;
}
fclose(Ft);
//printf("nrec = %d; nsamples = %d; maxrec = %d\n", InSample.nrec, InSample.nsamples, InSample.maxrec);
// Dimension structure
InSample.srec = ivector(0, InSample.nsamples - 1);
InSample.irec = ivector(0, InSample.nsamples - 1);
InSample.id = imatrix(0, InSample.nsamples - 1, 0, InSample.maxrec);
InSample.abund = imatrix(0, InSample.nsamples - 1, 0, InSample.maxrec);
InSample.pabund = matrix(0, InSample.nsamples - 1, 0, InSample.maxrec);
InSample.taxa = cmatrix(0, InSample.nrec-1, 0, MAXTAXONLENGTH);
InSample.pname = cmatrix(0, InSample.nsamples - 1, 0, MAXPLOTLENGTH);
// Read file for dynamic structure
strcpy(lastplot, "");
i = 0;
InSample.nsamples = 0; // recycling as counter
Ft = fopen(SampleFile, "r");
while (myfgets(line, 500, Ft, lineending) != NULL)
{
sscanf(line, "%s %d %s", plotname, &abundI, taxaI);
// do this on the first line of each new plot
if (strcmp(lastplot, plotname) != 0)
{
strcpy(InSample.pname[InSample.nsamples], plotname);
InSample.nsamples ++;
i = 0;
strcpy(lastplot, plotname);
InSample.srec[InSample.nsamples-1]=0;
}
// recs per sample counter
InSample.srec[InSample.nsamples-1]++;
// set abundance
InSample.abund[InSample.nsamples-1][i] = abundI;
// set taxon
// all other cases than first
found = 0;
for (j = 0; j < InSample.ntaxa; j++)
{
if (strcmp(InSample.taxa[j], taxaI) == 0)
{
InSample.id[InSample.nsamples-1][i] = j;
found = 1;
break;
}
}
// new taxon found - executed on first line
if(found == 0)
{
strcpy(InSample.taxa[InSample.ntaxa], taxaI);
InSample.id[InSample.nsamples-1][i] = InSample.ntaxa;
InSample.ntaxa++;
}
i++;
}
fclose(Ft);
//Calculate sample and species total abundances and frequency
InSample.sppabund = lvector(0, InSample.ntaxa - 1);
InSample.psppabund = vector(0, InSample.ntaxa -1 );
InSample.sppfreq = lvector(0, InSample.ntaxa - 1);
InSample.psppfreq = vector(0, InSample.ntaxa -1 );
// clear by sample, insample
for (i = 0; i < InSample.nsamples; i++)
{
InSample.irec[i] = 0;
for (j = 0; j < InSample.srec[i];j++)
{
InSample.irec[i] += InSample.abund[i][j];
InSample.sppabund[InSample.id[i][j]] = 0;
}
}
// clear by taxonNo in all samples
for (i = 0; i < InSample.ntaxa; i++)
{
InSample.sppfreq[i] = 0;
}
// calculate
for (i = 0; i < InSample.nsamples; i++)
{
for (j = 0; j < InSample.srec[i];j++)
{
InSample.pabund[i][j] = (float) InSample.abund[i][j] / (float) InSample.irec[i];
InSample.sppabund[InSample.id[i][j]] += InSample.abund[i][j];
InSample.totabund += InSample.abund[i][j];
InSample.sppfreq[InSample.id[i][j]]++;
// printf("%d %d %d %s %d\n", i, j, InSample.id[i][j], InSample.taxa[InSample.id[i][j]], (int) InSample.sppabund[InSample.id[i][j]]);
}
}
for (i = 0; i < InSample.ntaxa; i++)
{
InSample.psppabund[i] = (float) InSample.sppabund[i] / (float) InSample.totabund;
InSample.psppfreq[i] = (float) InSample.sppfreq[i] / (float) InSample.nsamples;
}
return InSample;
}