double chisq ( gsl_histogram* values, gsl_histogram* expected )
{
gsl_histogram*t = gsl_histogram_clone(values);
gsl_histogram_sub(t, expected);
int j;
double chi = 0;
for (j=0; j<B; ++j)
{
chi += pow(gsl_histogram_get(t, j), 2)/gsl_histogram_get(expected, j);
}
return gsl_cdf_chisq_Q(chi, B-1);
}
/* ==== */
static void
wl_montecarlo(char *struc)
{
short *pt=NULL;
move_str m;
int e,enew,emove,eval_me,status,debug=1;
long int crosscheck=1000000; /* used for convergence checks */
long int crosscheck_limit = 100000000000000000;
double g_b1,g_b2,prob,lnf = 1.; /* log modification parameter f */
size_t b1,b2; /* indices in g/h corresponding to
old/new energies */
gsl_histogram *gcp=NULL; /* clone of g used during crosscheck output */
eval_me = 1; /* paranoid checking of neighbors against RNAeval */
if (wanglandau_opt.verbose){
printf("[[wl_montecarlo()]]\n");
}
pt = vrna_pt_get(struc);
//mtw_dump_pt(pt);
//char *str = vrna_pt_to_db(pt);
//printf(">%s<\n",str);
e = vrna_eval_structure_pt(wanglandau_opt.sequence,pt,P);
/* determine bin where the start structure goes */
status = gsl_histogram_find(g,(float)e/100,&b1);
if (status) {
if (status == GSL_EDOM){
printf ("error: %s\n", gsl_strerror (status));
}
else {fprintf(stderr, "GSL error: gsl_errno=%d\n",status);}
exit(EXIT_FAILURE);
}
printf("%s\n", wanglandau_opt.sequence);
print_str(stderr,pt);
printf(" (%6.2f) bin:%d\n",(float)e/100,b1);
if (wanglandau_opt.verbose){
fprintf(stderr,"\nStarting MC loop ...\n");
}
while (lnf > wanglandau_opt.ffinal) {
if(wanglandau_opt.debug){
fprintf(stderr,"\n==================\n");
fprintf(stderr,"in while: lnf=%8.6f\n",lnf);
fprintf(stderr,"steps: %d\n",steps);
fprintf(stderr,"current histogram g:\n");
gsl_histogram_fprintf(stderr,g,"%6.2f","%30.6f");
fprintf(stderr,"\n");
print_str(stderr,pt);
fprintf(stderr, " (%6.2f) bin:%d\n",(float)e/100,b1);
/* mtw_dump_pt(pt); */
}
/* make a random move */
m = get_random_move_pt(wanglandau_opt.sequence,pt);
/* compute energy difference for this move */
emove = vrna_eval_move_pt(pt,s0,s1,m.left,m.right,P);
/* evaluate energy of the new structure */
enew = e + emove;
if(wanglandau_opt.debug){
fprintf(stderr,
"random move: left %i right %i enew(%6.4f)=e(%6.4f)+emove(%6.4f)\n",
m.left,m.right,(float)enew/100,(float)e/100,(float)emove/100);
}
/* ensure the new energy is within sampling range */
if ((float)enew/100 >= wanglandau_opt.max){
fprintf(stderr,
"New structure has energy %6.2f >= %6.2f (upper energy bound)\n",
(float)enew/100,wanglandau_opt.max);
fprintf(stderr,"Please increase --bins or adjust --max! Exiting ...\n");
exit(EXIT_FAILURE);
}
/* determine bin where the new structure goes */
status = gsl_histogram_find(g,(float)enew/100,&b2);
if (status) {
if (status == GSL_EDOM){
printf ("error: %s\n", gsl_strerror (status));
}
else {fprintf(stderr, "GSL error: gsl_errno=%d\n",status);}
exit(EXIT_FAILURE);
}
steps++; /* # of MC steps performed so far */
/* lookup current values for bins b1 and b2 */
g_b1 = gsl_histogram_get(g,b1);
g_b2 = gsl_histogram_get(g,b2);
/* core MC steps */
prob = MIN2(exp(g_b1 - g_b2), 1.0);
rnum = gsl_rng_uniform (r);
if ((prob == 1 || (rnum <= prob)) ) { /* accept & apply the move */
apply_move_pt(pt,m);
if(wanglandau_opt.debug){
print_str(stderr,pt);
fprintf(stderr, " %6.2f bin:%d [A]\n", (float)enew/100,b2);
}
b1 = b2;
e = enew;
}
else { /* reject the move */
if(wanglandau_opt.debug){
print_str(stderr,pt);
fprintf(stderr, " (%6.2f) bin:%d [R]\n", (float)enew/100,b2);
}
}
/* update histograms g and h */
if(wanglandau_opt.truedosbins_given && b2 <= wanglandau_opt.truedosbins){
/* do not update if b2 <= truedosbins, i.e. keep true DOS values
in those bins */
if (wanglandau_opt.debug){
fprintf(stderr, "NOT UPDATING bin %d\n",b1);
}
} else{
if(wanglandau_opt.debug){
fprintf(stderr, "UPDATING bin %d\n",b1);
}
status = gsl_histogram_increment(h,(float)e/100);
status = gsl_histogram_accumulate(g,(float)e/100,lnf);
}
maxbin = MAX2(maxbin,(int)b1);
// stuff that can be skipped
/*
printf ("performed move l:%4d r:%4d\t Energy +/- %6.2f\n",m.left,m.right,(float)emove/100);
print_str(stderr,pt);printf(" %6.2f bin:%d\n",(float)enew/100,b2);
e = vrna_eval_structure_pt(wanglandau_opt.sequence,pt,P);
if (eval_me == 1 && e != enew){
fprintf(stderr, "energy evaluation against vrna_eval_structure_pt() mismatch... HAVE %6.2f != %6.2f (SHOULD BE)\n",(float)enew/100, (float)e/100);
exit(EXIT_FAILURE);
}
print_str(stderr,pt);printf(" %6.2f\n",(float)e/100);
*/
// end of stuff that can be skipped
/* output DoS every x*10^(1/4) steps, starting with x=10^6 (we
used this fopr comparing perfomance and convergence of
different DoS sampling methods */
if((steps % crosscheck == 0) && (crosscheck <= crosscheck_limit)){
fprintf(stderr,"# crosscheck reached %li steps ",crosscheck);
gcp = gsl_histogram_clone(g);
if(wanglandau_opt.verbose){
fprintf(stderr,"## gcp before scaling\n");
gsl_histogram_fprintf(stderr,gcp,"%6.2f","%30.6f");
}
scale_dos(gcp); /* scale estimated g; make ln(g[0])=0 */
if(wanglandau_opt.verbose){
fprintf(stderr,"## gcp after scaling\n");
gsl_histogram_fprintf(stderr,gcp,"%6.2f","%30.6f");
}
double Z = partition_function(gcp);
output_dos(gcp,'s');
fprintf(stderr, "Z=%10.4g\n", Z);
crosscheck *= (pow(10, 1.0/4.0));
gsl_histogram_free(gcp);
fprintf(stderr,"-> new crosscheck will be performed at %li steps\n", crosscheck);
}
if(steps % wanglandau_opt.checksteps == 0) {
if( histogram_is_flat(h) ) {
lnf /= 2;
fprintf(stderr,"# steps=%20li | f=%12g | histogram is FLAT\n",
steps,lnf);
gsl_histogram_reset(h);
}
else {
fprintf(stderr, "# steps=%20li | f=%12g | histogram is NOT FLAT\n",
steps,lnf);
}
output_dos(g,'l');
}
/* stop criterion */
if(steps % wanglandau_opt.steplimit == 0){
fprintf(stderr,"maximun number of MC steps (%li) reached, exiting ...",
wanglandau_opt.steplimit);
break;
}
} /* end while */
free(pt);
return;
}
