//recursive function to be called from 'genfullmodels_priors' void genfullmodels_recur_priors(int nhier, int currhier1, int *temp, int *tempind, int q, int nrow, int ncol, int *structure, int *r, int *models_num, int *nalt_ls, int *nalt_s) { /*'nhier' is number of hierarchies 'currhier1' is current hierarchy 'temp' and 'tempind' are vectors recording structural information 'q' is specific row of 'structure' we wish to extract 'nrow' and 'ncol' are using for indexing 'structure' is a matrix containing intermediate model structures 'r' denotes current model 'models_num' is a vector recording model structure 'nalt_ls' records the number of alternative models according to "less stringent" criteria 'nalt_s' records the number of alternative models according to "stringent" criteria*/ //declare necessary variables int j,k,currhier,nsamp,nmod=10; nsamp=ncol; currhier=currhier1+1; //continue working through hierarchies in order and expand model set if(temp[currhier]==1) { for(j=0;j<nmod;j++) { models_num[tempind[currhier]]=j; if(currhier<(nhier-1)) genfullmodels_recur_priors(nhier,currhier,temp,tempind,q,nrow,ncol,structure,r,models_num,nalt_ls,nalt_s); else { *r=*r+1; //now calculate prior specification based on model *nalt_ls=*nalt_ls+calc_lessstring_single(nsamp,models_num); *nalt_s=*nalt_s+calc_string_single(nsamp,models_num); } } } else { for(j=0;j<nmod;j++) { //now fill in gaps and pass to recursive function if necessary for(k=0;k<nsamp;k++) { if(structure[index2(q,k,nrow)]==tempind[currhier]) { models_num[k]=j; models_num[k+nsamp]=tempind[currhier]; } } if(currhier<(nhier-1)) genfullmodels_recur_priors(nhier,currhier,temp,tempind,q,nrow,ncol,structure,r,models_num,nalt_ls,nalt_s); else { *r=*r+1; //now calculate prior specification based on model *nalt_ls=*nalt_ls+calc_lessstring_single(nsamp,models_num); *nalt_s=*nalt_s+calc_string_single(nsamp,models_num); } } } return; }
/*function to generate independent model structure recursively (for use in approximation routine)*/ void genfullmodels_indep_priors(int currcol, int nsamp, int nmod, int *models_num, int *nalt_ls, int *nalt_s) { /*'currcol' is the current sample in 'models_num' 'nsamp' is the total number of samples of 'models_num' 'nmod' is the number of model choices 'models_num' is a vector recording model structures 'nalt_ls' records the number of alternative models according to "less stringent" criteria 'nalt_s' records the number of alternative models according to "stringent" criteria*/ int i; for(i = 0; i < nmod; i++) { models_num[currcol] = i; if(currcol == (nsamp - 1)) { //now calculate prior specification based on model *nalt_ls = *nalt_ls + calc_lessstring_single(nsamp, models_num); *nalt_s = *nalt_s + calc_string_single(nsamp, models_num); } else genfullmodels_indep_priors(currcol + 1, nsamp, nmod, models_num, nalt_ls, nalt_s); } return; }
/*function to generate all possible models based on an intermediate set of structures (returns just normalising constants for efficient EXACT routine)*/ void genfullmodels_exact(int q, int nrow, int ncol, int *structure, int *r, int *models_num, double *norm_ls, double *norm_s, double *palt_ls, double *palt_s, double lpriornull_ls, double lprioralt_ls, double lpriornull_s, double lprioralt_s, double *lPDM_int_mat, int *ncomb_sub, int *sum, int *temp_index, int *mods, int *inds, int *prec_ind) { /*'q' is specific row of 'structure' we wish to extract 'nrow' and 'ncol' are using for indexing 'structure' is a matrix containing intermediate model structures 'r' denotes current model 'models_num' is a vector recording model structures 'norm_ls' and 'norm_s' record normalising constants 'palt_ls' and 'palt_s' record PPAs based on criteria 'lprior...' are the log-priors for a single model for the two criteria 'lPDM_int_mat' is intermediate vector for calculating normalising constants 'sum', 'temp_index', 'mods' and 'inds' are all intermediate vectors for use during calculation 'prec_ind' is an indicator to record whether there is a potential precision issue*/ //declare necessary variables int i,j,k,nhier,nsamp,nmod=10,priorind; double temp_norm,temp_norm1; nsamp=ncol; int * temp = (int *) Calloc(nsamp,int); int * tempind = (int *) Calloc(nsamp,int); //count up how many hierarchies for(i=0;i<nsamp;i++) { temp[i]=0; for(j=0;j<nsamp;j++) temp[i]+=(structure[index2(q,j,nrow)]==i ? 1:0); } nhier=0; for(j=0;j<nsamp;j++) nhier+=(temp[j]>0 ? 1:0); //order hierarchies bubble_sort_dec_int(temp,tempind,nsamp); //now work through hierarchies in order and expand model set if(nhier==1) { for(i=0;i<nmod;i++) { for(j=0;j<nsamp;j++) { models_num[j]=i; models_num[j+nsamp]=0; } //now calculate prior specification based on model temp_norm=calc_lPDMs_single_vec(nsamp,nmod,models_num,lPDM_int_mat,ncomb_sub,sum,temp_index,mods,inds); priorind=calc_lessstring_single(nsamp,models_num); temp_norm1=exp(temp_norm+(priorind==1 ? lprioralt_ls:lpriornull_ls)); if(temp_norm1==0.0) *prec_ind=1; *norm_ls=*norm_ls+temp_norm1; *palt_ls=*palt_ls+(priorind==1 ? temp_norm1:0.0); priorind=calc_string_single(nsamp,models_num); temp_norm1=exp(temp_norm+(priorind==1 ? lprioralt_s:lpriornull_s)); if(temp_norm1==0.0) *prec_ind=1; *norm_s=*norm_s+temp_norm1; *palt_s=*palt_s+(priorind==1 ? temp_norm1:0.0); *r=*r+1; } } else { //temp[0] must be >1 in this loop for(j=0;j<nmod;j++) { //initialise structures for(k=0;k<nsamp;k++) models_num[k+nsamp]=k; //now fill in gaps and pass to recursive function for(k=0;k<nsamp;k++) { if(structure[index2(q,k,nrow)]==tempind[0]) { models_num[k]=j; models_num[k+nsamp]=tempind[0]; } } genfullmodels_recur_exact(nhier,0,temp,tempind,q,nrow,ncol,structure,r,models_num,norm_ls,norm_s,palt_ls,palt_s,lpriornull_ls,lprioralt_ls,lpriornull_s,lprioralt_s,lPDM_int_mat,ncomb_sub,sum,temp_index,mods,inds,prec_ind); } } //free memory from the heap (automatically sets pointer to NULL) Free(temp);Free(tempind); return; }
/*function to run recursive loop to calculate final lPPAs for Occam's window approach without recording all models*/ void final_lPPA_recur(int nsamp, int nmod, int nmodcol, int incmods, int *totmods, int currsamp, int *r1, int m1, int *currmods, double curr_lPPA, int curr_hyp, int **models_num, int **hyp, double **lPPA_mat, int **multfact, int *uni, int *uni_ind, int string, double lpriornull, double lprioralt) { /*'nsamp' is the number of samples 'nmod' is the number of models 'nmodcol' is the number of samples plus model indicators (the number of columns of 'models_num') 'incmods' is INITIAL arbitrary number of models corresponding to the amount of memory made available for models_num 'totmods' is CURRENT arbitrary number of models corresponding to the amount of memory made available for models_num (may need to be extended during run or cut down at the end) 'currsamp' denotes the sample (i.e. column in 'lPDM_int_mat') that was changed at the previous level of the recursion 'r1' denotes current number of models in adjusted model set 'm1' is current model in model set that is being compared to 'currmods' is model structure at the previous level of the recursion 'curr_lPPA' is the log[P'(D|M)] for the current model at the previous level of the hierarchy 'curr_hyp' is the null/alt status of the model at the previous level of the hierarchy 'models_num' is matrix for storing model choices 'hyp' is a binary vector of length 'incmods', with 0=null and 1=alt 'lPPA_mat' is an output vector of log[P'(M|D)]s corresponding to the set of output models 'multfact' is a vector of multiplication factors 'uni' and 'uni_ind' are intermediate matrices for use in calculations 'string' is binary recording criteria type 'lprior*' represent the prior information for null and alternative models*/ int i,j,k,l,q,d,temp_hyp; double temp_lPPA; int *currmods1 = (int *) Calloc(nmodcol,int); for(i=0;i<nmodcol;i++) currmods1[i]=currmods[i]; //start loop for(i=currsamp;i<nsamp;i++) { j=currmods[i]; if(uni_ind[index2(j,i,nmod)]>0) { for(k=0;k<uni_ind[index2(j,i,nmod)];k++) { q=0; for(l=0;l<nsamp;l++) if(currmods[l+nsamp]==currmods[i+nsamp]) q++; if(q==1) { for(l=0;l<nmodcol;l++) currmods1[l]=currmods[l]; currmods1[i]=uni[index3(j,k,i,nmod,nmod)]; temp_lPPA=curr_lPPA; if(string==0) temp_hyp=calc_lessstring_single(nsamp,currmods1); else temp_hyp=calc_string_single(nsamp,currmods1); if(temp_hyp!=curr_hyp) { if(temp_hyp==1) temp_lPPA+=(lprioralt-lpriornull); else temp_lPPA+=(lpriornull-lprioralt); //update model set for(l=0;l<nmodcol;l++) (*models_num)[index2_col(*r1,l,nmodcol)]=currmods1[l]; (*lPPA_mat)[*r1]=temp_lPPA; (*hyp)[*r1]=temp_hyp; (*multfact)[*r1]=1; *r1=*r1+1; //increase size of output vectors if necessary if(*r1>(*totmods-1)) realloc_approx_new(nmodcol,totmods,incmods,models_num,hyp,lPPA_mat,multfact); //now enter further recursion if necessary if((i+1)<nsamp) { //just check next sample is independent q=i+1; d=2; while(q<nsamp&&d!=1) { d=0; for(l=0;l<nsamp;l++) if(currmods1[l+nsamp]==currmods1[q+nsamp]) d++; if(d==1) final_lPPA_recur(nsamp,nmod,nmodcol,incmods,totmods,q,r1,*r1,currmods1,temp_lPPA,temp_hyp,models_num,hyp,lPPA_mat,multfact,uni,uni_ind,string,lpriornull,lprioralt); q++; } } } else { (*multfact)[m1]++; //now enter further recursion if necessary if((i+1)<nsamp) { //just check next sample is independent q=i+1; d=2; while(q<nsamp&&d!=1) { d=0; for(l=0;l<nsamp;l++) if(currmods1[l+nsamp]==currmods1[q+nsamp]) d++; if(d==1) final_lPPA_recur(nsamp,nmod,nmodcol,incmods,totmods,q,r1,m1,currmods1,temp_lPPA,temp_hyp,models_num,hyp,lPPA_mat,multfact,uni,uni_ind,string,lpriornull,lprioralt); q++; } } } } } } } //free memory from the heap Free(currmods1); return; }