/*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;
}
