void names_initialize(void)
{
initialize_chain(femalechain,
(unsigned char *) gettext("lucy mary patricia linda barbara elizabeth jennifer maria susan margaret dorothy lisa nancy karen betty helen sandra donna carol ruth sharon michelle laura sarah kimberly deborah jessica shirley cynthia angela melissa brenda amy anna rebecca virginia kathleen pamela martha debra amanda stephanie carolyn christine marie janet catherine frances ann joyce diane"));
initialize_chain(malechain,
(unsigned char *) gettext("steve james john robert michael william david richard charles joseph thomas christopher daniel paul mark donald george kenneth steven edward brian ronald anthony kevin jason matthew gary timothy jose larry jeffrey frank scott eric stephen andrew raymond gregory joshua jerry dennis walter patrick peter harold douglas henry carl arthur ryan roger"));
initialize_chain(surnamechain,
(unsigned char *) gettext("smith johnson williams brown jones miller davis rodriguez wilson martinez anderson taylor thomas hernandez moore martin jackson thompson white lopez lee gonzalez harris clark lewis robinson walker perez hall young allen sanchez wright king scott green baker adams nelson hill ramirez campbell mitchell roberts carter phillips evans turner torres"));
}
void pepbayes_v3(double *Y, double *hyper_param, int *pstart,
int *pnum, int *n_position, int *n_peptide, int *n_indiv, int *nP,
int *cen_ind, int *cen_pep, int *cen_num, int *cen_pos,
int *n_iter, int *n_sweep, int *n_burn,
double *OutProbs, int *write)
{
R_CStackLimit = (uintptr_t)-1;
// miscellaneous useful quantities
int p, i, j, k = 0, c, d;
int pep, pos, th_id;
int *pos_ind_by_pep;
double *ProbSum;
int total_iterations = *n_burn+(*n_sweep)*(*n_iter);
int percent_complete = 10;
adpt zeta_adpt;
adpt m_adpt;
zeta_adpt.total_count = 0;
zeta_adpt.count = 0;
zeta_adpt.tune = 2.5;
m_adpt.total_count = 0;
m_adpt.count = 0;
m_adpt.tune = 5.0;
RngStream rng[*nP];
//statically allocated struct for Adaptive Rejection Sampling
ARS_workspace workspace;
// missing data variables
double *Exprs; // censor-completed expressions
int *Gamma; // cluster membership indicator
double *W; // t-distribution weights
double dof = 4.0; // t-distribution degrees of freedom
double *D; // imputed censored tails
// component membership probability parameters
double *Omega_logit; // membership probabilities, on logit scale
int *Omega_ind; // indicator for whether omega_{cp} > 0
double *A, *B, *U; // prior parameters for omega probabilities
double lambda_a, lambda_b; //hyperparameters for A, B
double a_0, b_0; // hyperparameters for U
double **xA, **xB; // vectors required for ARS
// location-related parameters
double *Mu; // peptide specific means
double kappa = 10.0; // prior mean precision
double *Alpha_pep; // peptide effects
double m = 2.0, zeta = 1.0; // prior mean and variance of peptide effects
double m_0, v_0; // hyperparameters for m
// variance parameters
double *Sig2; // peptide response variance
double alpha = 10.0; // prior parameter
double beta = 10.0; // prior parameter
double alpha_0, beta_0; // rates on alpha, beta (hyperparameters)
double *xAlpha; // vector needed for ARS
// file pointers
FILE *AFILE, *BFILE, *PFILE, *VARFILE, *Sig2FILE, *MUFILE, *DFILE, *OFILE;
FILE *ALPHAFILE;
// retreive and initialize hyperparameter values
a_0 = hyper_param[0];
b_0 = hyper_param[1];
lambda_a = hyper_param[2];
lambda_b = hyper_param[3];
alpha_0 = hyper_param[4];
beta_0 = hyper_param[5];
m_0 = hyper_param[6];
v_0 = hyper_param[7];
// begin memory allocation
Gamma = (int*) R_alloc(*n_peptide*(*n_indiv), sizeof(int));
Exprs = (double*) R_alloc(*n_peptide*(*n_indiv), sizeof(double));
W = (double *) R_alloc(*n_peptide*(*n_indiv), sizeof(double));
double *RB = (double *) R_alloc(*n_peptide*(*n_indiv), sizeof(double));
// xA and xB hold starting values for ARS of a_p, b_p, and alpha.
xA = (double**) R_alloc(*n_position, sizeof(double*));
xB = (double**) R_alloc(*n_position, sizeof(double*));
xAlpha = (double*) R_alloc(NMAX, sizeof(double));
// initial values for hull quantiles.
xAlpha[0] = 1.0;
xAlpha[1] = 2.0;
Omega_ind = (int*) R_alloc(*n_peptide, sizeof(int));
Omega_logit = (double*) R_alloc(*n_peptide, sizeof(double));
pos_ind_by_pep = (int*) R_alloc(*n_peptide, sizeof(int));
ProbSum = (double*) R_alloc(*n_peptide*(*n_indiv), sizeof(double));
for(p = 0; p < *n_position; p++)
{
xA[p] = (double*) R_alloc(NMAX, sizeof(double));
xB[p] = (double*) R_alloc(NMAX, sizeof(double));
for(c = 0; c < pnum[p]; c++)
{
pos_ind_by_pep[pstart[p] + c] = k;
}
k++;
}
Alpha_pep = (double*) R_alloc(*n_peptide, sizeof(double));
Sig2 = (double*) R_alloc(*n_peptide, sizeof(double));
A = (double*) R_alloc(*n_position, sizeof(double));
B = (double*) R_alloc(*n_position, sizeof(double));
U = (double*) R_alloc(*n_position, sizeof(double));
Mu = (double*) R_alloc(*n_peptide, sizeof(double));
double* likworkspace = (double *) R_alloc((*n_peptide)*(*n_indiv), sizeof(double));
// check whether our data is censored at all,
// if so prepare for augmentation.
if(*cen_num > 0)
{
D = (double*) R_alloc(*cen_num, sizeof(double));
for(i = 0; i < *cen_num; i++)
{
D[i] = 0.0;
}
}
if(*write == 1)
{
AFILE = fopen("afile.txt", "w");
BFILE = fopen("bfile.txt", "w");
PFILE = fopen("pfile.txt", "w");
OFILE = fopen("ofile.txt", "w");
ALPHAFILE = fopen("alphafile.txt", "w");
VARFILE = fopen("varfile.txt", "w");
Sig2FILE = fopen("sig2file.txt", "w");
MUFILE = fopen("mufile.txt", "w");
if(*cen_num > 0)
{
DFILE = fopen("dfile.txt", "w");
}
}
for(i = 0; i < *nP; i++)
{
rng[i] = RngStream_CreateStream("");
}
GetRNGstate();
initialize_chain(ProbSum, Exprs, Y, W, Omega_ind, Omega_logit, Alpha_pep,
Gamma, Sig2, Mu, A, B, U,
n_position, pstart, pnum, n_peptide, n_indiv,
xA, xB, RB);
PutRNGstate();
Rprintf("parameters initialized \n");
for(i = 1; i <= total_iterations; i++)
{
R_CheckUserInterrupt();
update_dof_integrated(&dof, Exprs, W, Alpha_pep, Gamma,
Sig2, Mu, likworkspace, *n_indiv, *n_peptide, rng[0]);
#pragma omp parallel private(th_id, workspace, pos) num_threads(*nP)
{
th_id = omp_get_thread_num();
#pragma omp for
for(pep = 0; pep < *n_peptide; pep++)
{
pos = pos_ind_by_pep[pep];
update_peptide(Exprs, Mu + pep, Alpha_pep + pep,
W, Omega_ind + pep, Omega_logit + pep, Gamma,
Sig2 + pep, alpha, beta,
U[pos], A[pos], B[pos],
m, zeta, dof, kappa, *n_indiv, *n_peptide, pep, rng[th_id], RB);
}
#pragma omp for
for(p = 0; p < *n_position; p++)
{
update_position_p(Omega_ind, Omega_logit,
A + p, B + p, U + p,
a_0, b_0, lambda_a, lambda_b,
p, *n_indiv, pnum, pstart, rng[th_id],
xA[p], xB[p], &workspace);
}
// update gammas, alphas, omegas
if((i > *n_burn) && ((i - *n_burn) % (*n_sweep) == 0 ))
{
#pragma omp for
for(d = 0; d < (*n_indiv)*(*n_peptide); d++)
{
ProbSum[d] += RB[d];
}
}
}
update_global_params(&m, &zeta, &alpha, &beta, &kappa,
Mu, Sig2, Alpha_pep, Omega_ind,
m_0, v_0, alpha_0, beta_0,
*n_indiv, *n_peptide, rng[0], &m_adpt, &zeta_adpt,
&workspace, xAlpha, *nP);
if(i % TEST_INT_LENGTH == 0)
{
update_tuning(&m_adpt, i, *n_burn);
update_tuning(&zeta_adpt, i, *n_burn);
}
// check whether we need to update complete data
if((*cen_num > 0) & (i > *n_burn/2))
{
update_censoring(W, D, *cen_num, cen_ind, cen_pep, Y, Exprs,
Gamma, Alpha_pep, Mu, *n_indiv, Sig2, rng[0]);
}
if((i > *n_burn) && ((i - *n_burn) % (*n_sweep) == 0 ) && *write == 1)
{
store_mcmc_output(Alpha_pep, Mu, A, B, U, Sig2, D, Omega_logit,
Omega_ind, kappa, alpha, beta, m, zeta,
dof, *n_peptide, *n_indiv, *n_position, cen_num,
AFILE, BFILE, PFILE, VARFILE, Sig2FILE, MUFILE, DFILE,
OFILE, ALPHAFILE);
}
if( 100*((double) i)/total_iterations >= percent_complete)
{
Rprintf("MCMC %d percent complete\n", percent_complete);
percent_complete += 10;
}
}
// finalize marginal PPA
for(d = 0; d < (*n_indiv)*(*n_peptide); d++)
{
OutProbs[d] = ProbSum[d]/(*n_iter);
}
Rprintf("M acceptance rate: %.3lf, Zeta acceptance rate: %.3lf\n", (double)(m_adpt.total_count)/(*n_iter*(*n_sweep)),
(double)(zeta_adpt.total_count)/(*n_iter*(*n_sweep)));
Rprintf("closing files\n");
if(*write == 1)
{
fclose(AFILE);
fclose(BFILE);
fclose(PFILE);
fclose(OFILE);
fclose(VARFILE);
fclose(ALPHAFILE);
fclose(Sig2FILE);
fclose(MUFILE);
if(*cen_num > 0)
{
fclose(DFILE);
}
}
return;
}
