void param_init_bounded_number_vector::allocate(int min1,int max1,
const double_index_type & bmin,const double_index_type & bmax,
const index_type& phase_start,const char * s)
{
int size = max1 - min1 + 1;
if (size > 0)
{
v = new param_init_bounded_number[size];
if (!v)
{
cerr << " error trying to allocate memory in "
"param_init_bounded_number_vector " << endl;
exit(1);
}
index_min=min1;
index_max=max1;
v-=indexmin();
for (int i=indexmin();i<=indexmax();i++)
{
if (it) v[i].set_initial_value(ad_double((*it)[i]));
adstring ss=s + adstring("[") + str(i) + adstring("]");
v[i].allocate(ad_double(bmin[i]),ad_double(bmax[i]),
ad_integer(phase_start[i]),(char*)(ss) );
}
}
}
void param_init_bounded_number_matrix::allocate(int rowmin, int rowmax,
int colmin, int colmax,
const dmatrix& bmin, const dmatrix& bmax,
const imatrix& phase_start,
const char* s)
{
#ifndef OPT_LIB
assert(v == NULL);
#endif
int size = rowmax - rowmin + 1;
if (size > 0)
{
index_min = rowmin;
index_max = rowmax;
v = new param_init_bounded_number_vector[size];
if (!v)
{
cerr << " error trying to allocate memory in "
"param_init_bounded_number_vector " << endl;
ad_exit(1);
}
v -= index_min;
for (int i = index_min; i <= index_max; i++)
{
/*if (it) v[i].set_initial_value(it[i]);*/
adstring a = s + adstring("[") + str(i) + adstring("]");
v[i].allocate(colmin, colmax, bmin[i], bmax[i], phase_start[i],
(char*)(a));
}
}
}
TEST_F(test_df1b2variable, copy_constructor_null)
{
adpool* save = df1b2variable::pool;
extern df1b2_gradlist* f1b2gradlist;
df1b2_gradlist* save2 = f1b2gradlist;
{
adpool a;
const size_t n = 10;
size_t size = sizeof(double) * df1b2variable::get_blocksize(n);
a.set_size(size);
df1b2variable::pool = &a;
df1b2_gradlist gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
f1b2gradlist = &gradlist;;
df1b2variable::noallocate = 1;
df1b2variable empty;
df1b2variable v(empty);
ASSERT_EQ(NULL, v.ptr);
ASSERT_EQ(NULL, v.ncopies);
ASSERT_EQ(NULL, v.u);
ASSERT_EQ(NULL, v.u_dot);
ASSERT_EQ(NULL, v.u_bar);
ASSERT_EQ(NULL, v.u_dot_bar);
ASSERT_EQ(NULL, v.u_tilde);
ASSERT_EQ(NULL, v.u_dot_tilde);
ASSERT_EQ(NULL, v.u_bar_tilde);
ASSERT_EQ(NULL, v.u_dot_bar_tilde);
ASSERT_EQ(0, v.indindex);
}
df1b2variable::pool = save;
f1b2gradlist = save2;
}
Gear::Gear(data_int syr, data_int eyr, data_int sage, data_int eage){
static int m_gearcount = 1;
m_syr = syr;
m_eyr = eyr;
m_sage = sage;
m_eage = eage;
adstring gearalloc = adstring("gearalloc") + str(m_gearcount);
m_allocation.allocate(gearalloc);
m_is_fishery = m_allocation > 0 ? true : false;
catches = new Catch;
adstring name = adstring("gear") + str(m_gearcount);
catches->allocate(name);
m_gearcount++;
}
TEST_F(test_df1b2atan2, df1b2_gradlist_default_constructor)
{
int argc = 1;
char* argv[] = {"./gtest-all"};
ad_comm::argc = argc;
ad_comm::argv = argv;
int get_f1b2buffer_size(const char * s);
int bs = get_f1b2buffer_size("-l1");
int nbs = get_f1b2buffer_size("-nl1");
ASSERT_EQ(0, bs);
ASSERT_EQ(0, nbs);
int bs2 = get_f1b2buffer_size("-l2");
int nbs2 = get_f1b2buffer_size("-nl2");
ASSERT_EQ(0, bs2);
ASSERT_EQ(0, nbs2);
int bs3 = get_f1b2buffer_size("-l3");
int nbs3 = get_f1b2buffer_size("-nl3");
ASSERT_EQ(0, bs3);
ASSERT_EQ(0, nbs3);
df1b2_gradlist f1b2gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
ad_comm::argc = 0;
ad_comm::argv = 0;
}
TEST_F(test_df1b2atan2, atan2)
{
int argc = 1;
char* argv[] = {"./gtest-all"};
ad_comm::argc = argc;
ad_comm::argv = argv;
adpool pool;
pool.set_size(808);
pool.nvar = 808;
df1b2variable::pool = &pool;
df1b2_gradlist::no_derivatives = 0;
df1b2variable::noallocate = 0;
extern df1b2_gradlist* f1b2gradlist;
df1b2_gradlist gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
f1b2gradlist = &gradlist;;
df1b2variable y(0.0);
df1b2variable x(0.0);
df1b2variable atan2(const df1b2variable& y, const df1b2variable& x);
df1b2variable v = atan2(y, x);
ASSERT_DOUBLE_EQ(std::atan2(0, 0), value(v));
ad_comm::argc = 0;
ad_comm::argv = 0;
}
void function_minimizer::set_runtime_crit(const char * s)
{
adstring opt="{" + adstring(s) + "}";
dvector temp1((char*)(opt));
if (allocated(convergence_criteria)) convergence_criteria.deallocate();
convergence_criteria.allocate(temp1.indexmin(),temp1.indexmax());
convergence_criteria=temp1;
}
void function_minimizer::set_runtime_maxfn(const char * s)
{
adstring opt="{" + adstring(s) + "}";
dvector temp1((char*)(opt));
if (allocated(maximum_function_evaluations))
maximum_function_evaluations.deallocate();
maximum_function_evaluations.allocate(temp1.indexmin(),temp1.indexmax());
maximum_function_evaluations=temp1;
}
void initial_params::save()
{
adstring extension;
if (current_phase == max_number_phases)
{
extension = "ar";
}
else if (current_phase >= 10)
{
extension = str(current_phase);
}
else
{
extension = "0" + str(current_phase);
}
{
adstring tadstring=ad_comm::adprogram_name + adstring(".p") + extension;
ofstream parfile((char*)tadstring);
if (parfile.good())
{
parfile << setshowpoint()
<< "# Number of parameters = " << initial_params::nvarcalc()
<< " Objective function value = " << *objective_function_value::pobjfun
<< " Maximum gradient component = " << objective_function_value::gmax
<< endl;
for (int i = 0; i < num_initial_params; ++i)
{
varsptr[i]->save_value(parfile);
}
}
}
{
adstring tadstring = ad_comm::adprogram_name + adstring(".b") + extension;
uostream barfile((char*)tadstring);
if (barfile.good())
{
for (int i = 0; i < num_initial_params; ++i)
{
(varsptr[i])->bsave_value(barfile);
}
}
}
}
TEST_F(test_df1b2variable, copy_constructor_noallocate_false)
{
adpool* save = df1b2variable::pool;
extern df1b2_gradlist* f1b2gradlist;
df1b2_gradlist* save2 = f1b2gradlist;
{
adpool a;
const size_t n = 10;
size_t size = sizeof(double) * df1b2variable::get_blocksize(n);
a.set_size(size);
df1b2variable::pool = &a;
df1b2_gradlist gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
f1b2gradlist = &gradlist;;
df1b2variable::noallocate = 0;
df1b2variable v;
ASSERT_TRUE(v.ptr);
ASSERT_EQ(0, ((twointsandptr*)v.ptr)->nvar);
ASSERT_EQ(0, ((twointsandptr*)v.ptr)->ncopies);
ASSERT_TRUE(((twointsandptr*)v.ptr)->ptr == &a);
ASSERT_EQ(0, *v.ncopies);
ASSERT_TRUE(v.u == (v.ptr + 2));
ASSERT_TRUE(v.u_dot == (v.u + 1));
int nvar = v.get_local_nvar();
ASSERT_TRUE(v.u_bar == (v.u_dot + nvar));
ASSERT_TRUE(v.u_dot_bar == (v.u_bar + nvar));
ASSERT_TRUE(v.u_tilde == (v.u_dot_bar + nvar));
ASSERT_TRUE(v.u_dot_tilde == (v.u_tilde + 1));
ASSERT_TRUE(v.u_bar_tilde == (v.u_dot_tilde + nvar));
ASSERT_TRUE(v.u_dot_bar_tilde == (v.u_bar_tilde + nvar));
ASSERT_FALSE(0 == v.indindex);
df1b2variable copy(v);
ASSERT_TRUE(v.ptr);
ASSERT_EQ(0, ((twointsandptr*)copy.ptr)->nvar);
ASSERT_EQ(1, ((twointsandptr*)copy.ptr)->ncopies);
ASSERT_TRUE(((twointsandptr*)copy.ptr)->ptr == &a);
ASSERT_EQ(1, *copy.ncopies);
ASSERT_TRUE(v.u == copy.u);
ASSERT_TRUE(v.u_dot == copy.u_dot);
ASSERT_TRUE(v.u_bar == copy.u_bar);
ASSERT_TRUE(v.u_dot_bar == copy.u_dot_bar);
ASSERT_TRUE(v.u_tilde == copy.u_tilde);
ASSERT_TRUE(v.u_dot_tilde == copy.u_dot_tilde);
ASSERT_TRUE(v.u_bar_tilde == copy.u_bar_tilde);
ASSERT_TRUE(v.u_dot_bar_tilde == copy.u_dot_bar_tilde);
ASSERT_TRUE(v.indindex != copy.indindex);
ASSERT_TRUE(0 == copy.indindex);
}
df1b2variable::pool = save;
f1b2gradlist = save2;
}
void val(const adstring& s, int& v, int& code)
{
int z;
if ( (s.size() > 2) && (s(1,2) == adstring("0x") ))
z = sscanf((const char*)s,"%x",&v);
else
z = sscanf((const char*)s,"%d",&v);
if (z != 1)
code = 1;
else
code = 0;
}
int val(const adstring& s)
{
int code;
int v;
int z;
if ( (s.size() > 2) && (s(1,2) == adstring("0x") ))
z = sscanf((const char*)s,"%x",&v);
else
z = sscanf((const char*)s,"%d",&v);
if (z != 1)
code = 1;
else
code = 0;
return v;
}
TEST_F(test_df1b2variable, constructor_double)
{
adpool* save = df1b2variable::pool;
extern df1b2_gradlist* f1b2gradlist;
df1b2_gradlist* save2 = f1b2gradlist;
{
adpool a;
const size_t n = 10;
size_t size = sizeof(double) * df1b2variable::get_blocksize(n);
a.set_size(size);
df1b2variable::pool = &a;
df1b2_gradlist gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
f1b2gradlist = &gradlist;;
double expected = 6.5;
df1b2variable v(expected);
ASSERT_TRUE(v.ptr);
ASSERT_EQ(0, ((twointsandptr*)v.ptr)->nvar);
ASSERT_EQ(0, ((twointsandptr*)v.ptr)->ncopies);
ASSERT_TRUE(((twointsandptr*)v.ptr)->ptr == &a);
ASSERT_EQ(0, *v.ncopies);
ASSERT_DOUBLE_EQ(*v.u, expected);
ASSERT_TRUE(v.u == (v.ptr + 2));
ASSERT_TRUE(v.u_dot == (v.u + 1));
int nvar = v.get_local_nvar();
ASSERT_TRUE(v.u_bar == (v.u_dot + nvar));
ASSERT_TRUE(v.u_dot_bar == (v.u_bar + nvar));
ASSERT_TRUE(v.u_tilde == (v.u_dot_bar + nvar));
ASSERT_TRUE(v.u_dot_tilde == (v.u_tilde + 1));
ASSERT_TRUE(v.u_bar_tilde == (v.u_dot_tilde + nvar));
ASSERT_TRUE(v.u_dot_bar_tilde == (v.u_bar_tilde + nvar));
ASSERT_FALSE(0 == v.indindex);
}
df1b2variable::pool = save;
f1b2gradlist = save2;
}
TEST_F(test_df1b2atan2, no_derivatives_0)
{
int argc = 1;
char* argv[] = {"./gtest-all"};
ad_comm::argc = argc;
ad_comm::argv = argv;
adpool pool;
pool.set_size(808);
pool.nvar = 808;
df1b2variable::pool = &pool;
df1b2_gradlist::no_derivatives = 0;
df1b2variable::noallocate = 0;
extern df1b2_gradlist* f1b2gradlist;
df1b2_gradlist gradlist(4000000U,200000U,8000000U,400000U,2000000U,100000U,adstring("f1b2list1"));
f1b2gradlist = &gradlist;;
df1b2variable y;
ad_comm::argc = 0;
ad_comm::argv = 0;
}
/**
* Description not yet available.
* \param
*/
void function_minimizer::constraint_report()
{
adstring tmp;
if (initial_params::current_phase==initial_params::max_number_phases)
{
tmp="on";
}
else if (initial_params::current_phase>=10)
{
tmp=str(initial_params::current_phase);
}
else
{
tmp="0" + str(initial_params::current_phase);
}
{
adstring tadstring=ad_comm::adprogram_name + adstring(".c") + tmp;
ofstream ofs((char*)tadstring);
ofs << setshowpoint();
ofs << "# Objective function value = " << endl << " "
<< *objective_function_value::pobjfun << endl;
if (function_minimizer::ph)
{
ofs << "# Equality constraint values: "<< endl;
named_dvar_vector & w = *function_minimizer::ph;
for (int i=w.indexmin();i<=w.indexmax();i++)
{
adstring ads= adstring(w.label().mychar()) + "("
+ str(i) + ") ";
if (i<10)
ofs << " ";
else if (i<100)
ofs << " ";
else
ofs << " ";
ofs << ads << w(i)<< endl;
}
}
if (function_minimizer::pg)
{
ofs << "# Inequality constraint values: "<< endl;
named_dvar_vector & w = *function_minimizer::pg;
for (int i=w.indexmin();i<=w.indexmax();i++)
{
if (i<10)
ofs << " ";
else if (i<100)
ofs << " ";
else
ofs << " ";
adstring ads= adstring(w.label().mychar()) + "("
+ str(i) + ") ";
ofs << ads << w(i)<< endl;
}
}
ofs << "#exit condition: ";
switch(function_minimizer::constraint_exit_number)
{
case 1:
ofs << "Error calculatinumberv constraint" <<endl;
break;
case 2:
ofs << "Error calculatinumberv objective function" <<endl;
break;
case 7:
ofs << "Current search direction is not feasible" << endl;
break;
case 11:
ofs << "Kuhn-Tucker conditions satisfied" << endl;
break;
case 15:
ofs << "Function munimxizer not makinumberv enough progress -- "
"Is answer attained?" << endl;
break;
default:
ofs << "Unknown error" <<endl;
break;
}
}
}
adstring& adstring::operator=(const char t)
{
*this = adstring(t);
return *this;
}
}
}
}
if (!psvflag) {
pofs_psave=
new uostream(
(char*)(ad_comm::adprogram_name + adstring(".psv")),ios::app);
} else {
pofs_psave=
new uostream((char*)(ad_comm::adprogram_name + adstring(".psv")));
}
} else {
pofs_psave=
new uostream((char*)(ad_comm::adprogram_name + adstring(".psv")));
}
if (!pofs_psave|| !(*pofs_psave))
{
cerr << "Error trying to open file" <<
ad_comm::adprogram_name + adstring(".psv") << endl;
mcsave_flag=0;
if (pofs_psave)
{
delete pofs_psave;
pofs_psave=NULL;
}
}
else
{
if (psvflag || (mcrestart_flag == -1) )
/**
Symmetrize and invert the hessian
*/
void function_minimizer::hess_inv(void)
{
initial_params::set_inactive_only_random_effects();
int nvar=initial_params::nvarcalc(); // get the number of active parameters
independent_variables x(1,nvar);
initial_params::xinit(x); // get the initial values into the x vector
//double f;
dmatrix hess(1,nvar,1,nvar);
uistream ifs("admodel.hes");
int file_nvar = 0;
ifs >> file_nvar;
if (nvar != file_nvar)
{
cerr << "Number of active variables in file mod_hess.rpt is wrong"
<< endl;
}
for (int i = 1;i <= nvar; i++)
{
ifs >> hess(i);
if (!ifs)
{
cerr << "Error reading line " << i << " of the hessian"
<< " in routine hess_inv()" << endl;
exit(1);
}
}
int hybflag = 0;
ifs >> hybflag;
dvector sscale(1,nvar);
ifs >> sscale;
if (!ifs)
{
cerr << "Error reading sscale"
<< " in routine hess_inv()" << endl;
}
double maxerr=0.0;
for (int i = 1;i <= nvar; i++)
{
for (int j=1;j<i;j++)
{
double tmp=(hess(i,j)+hess(j,i))/2.;
double tmp1=fabs(hess(i,j)-hess(j,i));
tmp1/=(1.e-4+fabs(hess(i,j))+fabs(hess(j,i)));
if (tmp1>maxerr) maxerr=tmp1;
hess(i,j)=tmp;
hess(j,i)=tmp;
}
}
/*
if (maxerr>1.e-2)
{
cerr << "warning -- hessian aprroximation is poor" << endl;
}
*/
for (int i = 1;i <= nvar; i++)
{
int zero_switch=0;
for (int j=1;j<=nvar;j++)
{
if (hess(i,j)!=0.0)
{
zero_switch=1;
}
}
if (!zero_switch)
{
cerr << " Hessian is 0 in row " << i << endl;
cerr << " This means that the derivative if probably identically 0 "
" for this parameter" << endl;
}
}
int ssggnn;
ln_det(hess,ssggnn);
int on1=0;
{
ofstream ofs3((char*)(ad_comm::adprogram_name + adstring(".eva")));
{
dvector se=eigenvalues(hess);
ofs3 << setshowpoint() << setw(14) << setprecision(10)
<< "unsorted:\t" << se << endl;
se=sort(se);
ofs3 << setshowpoint() << setw(14) << setprecision(10)
<< "sorted:\t" << se << endl;
if (se(se.indexmin())<=0.0)
{
negative_eigenvalue_flag=1;
cout << "Warning -- Hessian does not appear to be"
" positive definite" << endl;
}
}
ivector negflags(0,hess.indexmax());
int num_negflags=0;
{
int on = option_match(ad_comm::argc,ad_comm::argv,"-eigvec");
on1=option_match(ad_comm::argc,ad_comm::argv,"-spmin");
if (on > -1 || on1 >-1 )
{
ofs3 << setshowpoint() << setw(14) << setprecision(10)
<< eigenvalues(hess) << endl;
dmatrix ev=trans(eigenvectors(hess));
ofs3 << setshowpoint() << setw(14) << setprecision(10)
<< ev << endl;
for (int i=1;i<=ev.indexmax();i++)
{
double lam=ev(i)*hess*ev(i);
ofs3 << setshowpoint() << setw(14) << setprecision(10)
<< lam << " " << ev(i)*ev(i) << endl;
if (lam<0.0)
{
num_negflags++;
negflags(num_negflags)=i;
}
}
if ( (on1>-1) && (num_negflags>0)) // we will try to get away from
{ // saddle point
negative_eigenvalue_flag=0;
spminflag=1;
if(negdirections)
{
delete negdirections;
}
negdirections = new dmatrix(1,num_negflags);
for (int i=1;i<=num_negflags;i++)
{
(*negdirections)(i)=ev(negflags(i));
}
}
int on2 = option_match(ad_comm::argc,ad_comm::argv,"-cross");
if (on2>-1)
{ // saddle point
dmatrix cross(1,ev.indexmax(),1,ev.indexmax());
for (int i = 1;i <= ev.indexmax(); i++)
{
for (int j=1;j<=ev.indexmax();j++)
{
cross(i,j)=ev(i)*ev(j);
}
}
ofs3 << endl << " e(i)*e(j) ";
ofs3 << endl << cross << endl;
}
}
}
if (spminflag==0)
{
if (num_negflags==0)
{
hess=inv(hess);
int on=0;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-eigvec"))>-1)
{
int i;
ofs3 << "choleski decomp of correlation" << endl;
dmatrix ch=choleski_decomp(hess);
for (i=1;i<=ch.indexmax();i++)
ofs3 << ch(i)/norm(ch(i)) << endl;
ofs3 << "parameterization of choleski decomnp of correlation" << endl;
for (i=1;i<=ch.indexmax();i++)
{
dvector tmp=ch(i)/norm(ch(i));
ofs3 << tmp(1,i)/tmp(i) << endl;
}
}
}
}
}
if (spminflag==0)
{
if (on1<0)
{
for (int i = 1;i <= nvar; i++)
{
if (hess(i,i) <= 0.0)
{
hess_errorreport();
ad_exit(1);
}
}
}
{
adstring tmpstring="admodel.cov";
if (ad_comm::wd_flag)
tmpstring = ad_comm::adprogram_name + ".cov";
uostream ofs((char*)tmpstring);
ofs << nvar << hess;
ofs << gradient_structure::Hybrid_bounded_flag;
ofs << sscale;
}
}
}
void function_minimizer::shmc_mcmc_routine(int nmcmc,int iseed0,double dscale,
int restart_flag) {
if (nmcmc<=0)
{
cerr << endl << "Error: Negative iterations for MCMC not meaningful" << endl;
ad_exit(1);
}
uostream * pofs_psave=NULL;
if (mcmc2_flag==1)
{
initial_params::restore_start_phase();
}
initial_params::set_inactive_random_effects();
initial_params::set_active_random_effects();
int nvar_re=initial_params::nvarcalc();
int nvar=initial_params::nvarcalc(); // get the number of active parameters
if (mcmc2_flag==0)
{
initial_params::set_inactive_random_effects();
nvar=initial_params::nvarcalc(); // get the number of active parameters
}
initial_params::restore_start_phase();
independent_variables parsave(1,nvar_re);
// dvector x(1,nvar);
// initial_params::xinit(x);
// dvector pen_vector(1,nvar);
// {
// initial_params::reset(dvar_vector(x),pen_vector);
// }
initial_params::mc_phase=1;
int old_Hybrid_bounded_flag=-1;
int on,nopt = 0;
//// ------------------------------ Parse input options
// Step size. If not specified, will be adapted. If specified must be >0
// and will not be adapted.
double eps=0.1;
double _eps=-1.0;
int useDA=1; // whether to adapt step size
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-hyeps",nopt))>-1)
{
if (!nopt) // not specified means to adapt, using function below to find reasonable one
{
cerr << "Warning: No step size given after -hyeps, ignoring" << endl;
useDA=1;
}
else // read in specified value and do not adapt
{
istringstream ist(ad_comm::argv[on+1]);
ist >> _eps;
if (_eps<=0)
{
cerr << "Error: step size (-hyeps argument) needs positive number";
ad_exit(1);
}
else
{
eps=_eps;
useDA=0;
}
}
}
// Chain number -- for console display purposes only
int chain=1;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-chain",nopt))>-1) {
if (nopt) {
int iii=atoi(ad_comm::argv[on+1]);
if (iii <1) {
cerr << "Error: chain must be >= 1" << endl;
ad_exit(1);
} else {
chain=iii;
}
}
}
// Number of leapfrog steps. Defaults to 10.
int L=10;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-hynstep",nopt))>-1)
{
if (nopt)
{
int _L=atoi(ad_comm::argv[on+1]);
if (_L < 1 )
{
cerr << "Error: hynstep argument must be integer > 0 " << endl;
ad_exit(1);
}
else
{
L=_L;
}
}
}
// Number of warmup samples if using adaptation of step size. Defaults to
// half of iterations.
int nwarmup= (int)nmcmc/2;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-nwarmup",nopt))>-1)
{
if (nopt)
{
int iii=atoi(ad_comm::argv[on+1]);
if (iii <=0 || iii > nmcmc)
{
cerr << "Error: nwarmup must be 0 < nwarmup < nmcmc" << endl;
ad_exit(1);
}
else
{
nwarmup=iii;
}
}
}
// Target acceptance rate for step size adaptation. Must be
// 0<adapt_delta<1. Defaults to 0.8.
double adapt_delta=0.8; // target acceptance rate specified by the user
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-adapt_delta",nopt))>-1)
{
if (nopt)
{
istringstream ist(ad_comm::argv[on+1]);
double _adapt_delta;
ist >> _adapt_delta;
if (_adapt_delta < 0 || _adapt_delta > 1 )
{
cerr << "Error: adapt_delta must be between 0 and 1"
" using default of 0.8" << endl;
}
else
{
adapt_delta=_adapt_delta;
}
}
}
// Use diagnoal covariance (identity mass matrix)
int diag_option=0;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcdiag"))>-1)
{
diag_option=1;
cout << " Setting covariance matrix to diagonal with entries " << dscale
<< endl;
}
// Restart chain from previous run?
int mcrestart_flag=option_match(ad_comm::argc,ad_comm::argv,"-mcr");
if(mcrestart_flag > -1){
cerr << endl << "Error: -mcr option not implemented for HMC" << endl;
ad_exit(1);
}
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcec"))>-1)
{
cerr << endl << "Error: -mcec option not yet implemented with HMC" << endl;
ad_exit(1);
// use_empirical_flag=1;
// read_empirical_covariance_matrix(nvar,S,ad_comm::adprogram_name);
}
// Prepare the mass matrix for use. Depends on many factors below.
dmatrix S(1,nvar,1,nvar);
dvector old_scale(1,nvar);
int old_nvar;
// Need to grab old_scale values still, since it is scaled below
read_covariance_matrix(S,nvar,old_Hybrid_bounded_flag,old_scale);
if (diag_option) // set covariance to be diagonal
{
S.initialize();
for (int i=1;i<=nvar;i++)
{
S(i,i)=dscale;
}
}
// How much to thin, for now fixed at 1.
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcsave"))>-1)
{
cerr << "Option -mcsave does not currently work with HMC -- every iteration is saved" << endl;
ad_exit(1);
}
//// ------------------------------ End of input processing
//// Setup more inputs and outputs
pofs_psave=
new uostream((char*)(ad_comm::adprogram_name + adstring(".psv")));
if (!pofs_psave|| !(*pofs_psave))
{
cerr << "Error trying to open file" <<
ad_comm::adprogram_name + adstring(".psv") << endl;
ad_exit(1);
}
if (mcrestart_flag == -1 )
{
(*pofs_psave) << nvar;
}
// need to rescale the hessian
// get the current scale
dvector x0(1,nvar);
dvector current_scale(1,nvar);
initial_params::xinit(x0);
int mctmp=initial_params::mc_phase;
initial_params::mc_phase=0;
initial_params::stddev_scale(current_scale,x0);
initial_params::mc_phase=mctmp;
// cout << "old scale=" << old_scale << endl;
// cout << "current scale=" << current_scale << endl;
// cout << "S before=" << S << endl;
// I think this is only needed if mcmc2 is used??
// for (int i=1;i<=nvar;i++)
// {
// for (int j=1;j<=nvar;j++)
// {
// S(i,j)*=old_scale(i)*old_scale(j);
// }
// }
if(diag_option){
for (int i=1;i<=nvar;i++)
{
for (int j=1;j<=nvar;j++)
{
S(i,j)*=current_scale(i)*current_scale(j);
}
}
}
// cout << "S after=" << S << endl;
gradient_structure::set_NO_DERIVATIVES();
if (mcmc2_flag==0)
{
initial_params::set_inactive_random_effects();
}
// Setup random number generator, based on seed passed
int iseed=2197;
if (iseed0) iseed=iseed0;
random_number_generator rng(iseed);
gradient_structure::set_YES_DERIVATIVES();
initial_params::xinit(x0);
// Dual averaging components
dvector epsvec(1,nmcmc+1), epsbar(1,nmcmc+1), Hbar(1,nmcmc+1);
epsvec.initialize(); epsbar.initialize(); Hbar.initialize();
double time_warmup=0;
double time_total=0;
std::clock_t start = clock();
time_t now = time(0);
tm* localtm = localtime(&now);
cout << endl << "Starting static HMC for model '" << ad_comm::adprogram_name <<
"' at " << asctime(localtm);
// write sampler parameters
ofstream adaptation("adaptation.csv", ios::trunc);
adaptation << "accept_stat__,stepsize__,int_time__,energy__,lp__" << endl;
// Declare and initialize the variables needed for the algorithm
dmatrix chd = choleski_decomp(S); // cholesky decomp of mass matrix
dvector y(1,nvar); // unbounded parameters
y.initialize();
// transformed params
independent_variables z(1,nvar); z=chd*y;
dvector gr(1,nvar); // gradients in unbounded space
// Need to run this to fill gr with current gradients and initial NLL.
double nllbegin=get_hybrid_monte_carlo_value(nvar,z,gr);
if(std::isnan(nllbegin)){
cerr << "Starting MCMC trajectory at NaN -- something is wrong!" << endl;
ad_exit(1);
}
// initial rotated gradient
dvector gr2(1,nvar); gr2=gr*chd;
dvector p(1,nvar); // momentum vector
p.fill_randn(rng);
// Copy initial value to parsave in case first trajectory rejected
initial_params::copy_all_values(parsave,1.0);
double iaccept=0.0;
// The gradient and params at beginning of trajectory, in case rejected.
dvector gr2begin(1,nvar); gr2begin=gr2;
dvector ybegin(1,nvar); ybegin=y;
double nll=nllbegin;
// if(useDA){
// eps=find_reasonable_stepsize(nvar,y,p,chd);
// epsvec(1)=eps; epsbar(1)=eps; Hbar(1)=0;
// }
double mu=log(10*eps);
// Start of MCMC chain
for (int is=1;is<=nmcmc;is++) {
// Random momentum for next iteration, only affects Ham values
p.fill_randn(rng);
double H0=nll+0.5*norm2(p);
// Generate trajectory
int divergence=0;
for (int i=1;i<=L;i++) {
// leapfrog updates gr, p, y, and gr2 by reference
nll=leapfrog(nvar, gr, chd, eps, p, y, gr2);
// Break trajectory early if a divergence occurs to save computation
if(std::isnan(nll)){
divergence=1; break;
}
} // end of trajectory
// Test whether to accept the proposed state
double Ham=nll+0.5*norm2(p); // Update Hamiltonian for proposed set
double alpha=min(1.0, exp(H0-Ham)); // acceptance ratio
double rr=randu(rng); // Runif(1)
if (rr<alpha && !divergence){ // accept
iaccept++;
// Update for next iteration: params, Hamiltonian and gr2
ybegin=y;
gr2begin=gr2;
nllbegin=nll;
initial_params::copy_all_values(parsave,1.0);
} else {
// Reject and don't update anything to reuse initials for next trajectory
y=ybegin;
gr2=gr2begin;
nll=nllbegin;
}
// Save parameters to psv file, duplicated if rejected
(*pofs_psave) << parsave;
// Adaptation of step size (eps).
if(useDA && is <= nwarmup){
eps=adapt_eps(is, eps, alpha, adapt_delta, mu, epsvec, epsbar, Hbar);
}
adaptation << alpha << "," << eps << "," << eps*L << "," << H0 << "," << -nll << endl;
if(is ==nwarmup) time_warmup = ( std::clock()-start)/(double) CLOCKS_PER_SEC;
print_mcmc_progress(is, nmcmc, nwarmup, chain);
} // end of MCMC chain
// This final ratio should closely match adapt_delta
if(useDA){
cout << "Final acceptance ratio=" << iaccept/nmcmc << " and target is " << adapt_delta<<endl;
cout << "Final step size=" << eps << "; after " << nwarmup << " warmup iterations"<< endl;
} else {
cout << "Final acceptance ratio=" << iaccept/nmcmc << endl;
}
time_total = ( std::clock() - start ) / (double) CLOCKS_PER_SEC;
print_mcmc_timing(time_warmup, time_total);
// I assume this closes the connection to the file??
if (pofs_psave)
{
delete pofs_psave;
pofs_psave=NULL;
}
} // end of HMC function
void function_minimizer::pvm_master_mcmc_routine(int nmcmc,int iseed0,double dscale,
int restart_flag)
{
uostream * pofs_psave=NULL;
dmatrix mcmc_display_matrix;
int mcmc_save_index=1;
int mcmc_wrap_flag=0;
int mcmc_gui_length=10000;
int no_sd_mcmc=0;
int on2=-1;
if ( (on2=option_match(ad_comm::argc,ad_comm::argv,"-nosdmcmc"))>-1)
no_sd_mcmc=1;
if (stddev_params::num_stddev_params==0)
{
cerr << " You must declare at least one object of type sdreport "
<< endl << " to do the mcmc calculations" << endl;
return;
}
{
//ofstream of_bf("testbf");
//if (adjm_ptr) set_labels_for_mcmc();
ivector number_offsets;
dvector lkvector;
//double current_bf=0;
double lcurrent_bf=0;
double size_scale=1.0;
double total_spread=200;
//double total_spread=2500;
uostream * pofs_sd = NULL;
int nvar=initial_params::nvarcalc(); // get the number of active parameters
int scov_option=0;
dmatrix s_covar;
dvector s_mean;
int on=-1;
int ncsim=25000;
int nslots=800;
//int nslots=3600;
int initial_nsim=4800;
int ntmp=0;
int ncor=0;
double bfsum=0;
int ibfcount=0;
double llbest;
double lbmax;
//if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcscov",ntmp))>-1)
//{
scov_option=1;
s_covar.allocate(1,nvar,1,nvar);
s_mean.allocate(1,nvar);
s_mean.initialize();
s_covar.initialize();
int ndvar=stddev_params::num_stddev_calc();
int numdvar=stddev_params::num_stddev_number_calc();
/*
if (adjm_ptr)
{
mcmc_display_matrix.allocate(1,numdvar,1,mcmc_gui_length);
number_offsets.allocate(1,numdvar);
number_offsets=stddev_params::copy_all_number_offsets();
}
*/
dvector x(1,nvar);
dvector scale(1,nvar);
dmatrix values;
int have_hist_flag=0;
initial_params::xinit(x);
dvector pen_vector(1,nvar);
{
initial_params::reset(dvar_vector(x),pen_vector);
cout << pen_vector << endl << endl;
}
initial_params::mc_phase=0;
initial_params::stddev_scale(scale,x);
initial_params::mc_phase=1;
dvector bmn(1,nvar);
dvector mean_mcmc_values(1,ndvar);
dvector s(1,ndvar);
dvector h(1,ndvar);
//dvector h;
dvector square_mcmc_values(1,ndvar);
square_mcmc_values.initialize();
mean_mcmc_values.initialize();
bmn.initialize();
int use_empirical_flag=0;
int diag_option=0;
int topt=0;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcdiag"))>-1)
{
diag_option=1;
cout << " Setting covariance matrix to diagonal with entries " << dscale
<< endl;
}
dmatrix S(1,nvar,1,nvar);
dvector sscale(1,nvar);
if (!diag_option)
{
int on,nopt;
int rescale_bounded_flag=0;
double rescale_bounded_power=0.5;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcrb",nopt))>-1)
{
if (nopt)
{
int iii=atoi(ad_comm::argv[on+1]);
if (iii < 1 || iii > 9)
{
cerr << " -mcrb argument must be integer between 1 and 9 --"
" using default of 5" << endl;
rescale_bounded_power=0.5;
}
else
rescale_bounded_power=iii/10.0;
}
else
{
rescale_bounded_power=0.5;
}
rescale_bounded_flag=1;
}
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcec"))>-1)
{
use_empirical_flag=1;
}
if (use_empirical_flag)
{
read_empirical_covariance_matrix(nvar,S,ad_comm::adprogram_name);
}
else if (!rescale_bounded_flag)
{
int tmp;
read_covariance_matrix(S,nvar,tmp,sscale);
}
else
{
read_hessian_matrix_and_scale1(nvar,S,rescale_bounded_power,
mcmc2_flag);
//read_hessian_matrix_and_scale(nvar,S,pen_vector);
}
{ // scale covariance matrix for model space
dmatrix tmp(1,nvar,1,nvar);
for (int i=1;i<=nvar;i++)
{
tmp(i,i)=S(i,i)*(scale(i)*scale(i));
for (int j=1;j<i;j++)
{
tmp(i,j)=S(i,j)*(scale(i)*scale(j));
tmp(j,i)=tmp(i,j);
}
}
S=tmp;
}
}
else
{
S.initialize();
for (int i=1;i<=nvar;i++)
{
S(i,i)=dscale;
}
}
cout << sort(eigenvalues(S)) << endl;
dmatrix chd = choleski_decomp( (dscale*2.4/sqrt(double(nvar))) * S);
dmatrix chdinv=inv(chd);
int sgn;
dmatrix symbds(1,2,1,nvar);
initial_params::set_all_simulation_bounds(symbds);
ofstream ofs_sd1((char*)(ad_comm::adprogram_name + adstring(".mc2")));
{
long int iseed=0;
int number_sims;
if (nmcmc<=0)
{
number_sims= 100000;
}
else
{
number_sims= nmcmc;
}
//cin >> iseed;
if (iseed0<=0)
{
iseed=-36519;
}
else
{
iseed=-iseed0;
}
if (iseed>0)
{
iseed=-iseed;
}
cout << "Initial seed value " << iseed << endl;
random_number_generator rng(iseed);
rng.better_rand();
//better_rand(iseed);
double lprob=0.0;
double lpinv=0.0;
double lprob3=0.0;
// get lower and upper bounds
independent_variables y(1,nvar);
independent_variables parsave(1,nvar);
// read in the mcmc values to date
int ii=1;
dmatrix hist;
if (restart_flag)
{
int tmp=0;
if (!no_sd_mcmc) {
hist.allocate(1,ndvar,-nslots,nslots);
tmp=read_hist_data(hist,h,mean_mcmc_values,s,parsave,iseed,
size_scale);
values.allocate(1,ndvar,-nslots,nslots);
for (int i=1;i<=ndvar;i++)
{
values(i).fill_seqadd(mean_mcmc_values(i)-0.5*total_spread*s(i)
+.5*h(i),h(i));
}
}
if (iseed>0)
{
iseed=-iseed;
}
double br=rng.better_rand();
if (tmp) have_hist_flag=1;
chd=size_scale*chd;
chdinv=chdinv/size_scale;
}
else
{
int on=-1;
int nopt=0;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcpin",nopt))>-1)
{
if (nopt)
{
cifstream cif((char *)ad_comm::argv[on+1]);
if (!cif)
{
cerr << "Error trying to open mcmc par input file "
<< ad_comm::argv[on+1] << endl;
exit(1);
}
cif >> parsave;
if (!cif)
{
cerr << "Error reading from mcmc par input file "
<< ad_comm::argv[on+1] << endl;
exit(1);
}
}
else
{
cerr << "Illegal option with -mcpin" << endl;
}
}
else
{
ii=1;
initial_params::copy_all_values(parsave,ii);
}
}
ii=1;
initial_params::restore_all_values(parsave,ii);
gradient_structure::set_NO_DERIVATIVES();
ofstream ogs("sims");
ogs << nvar << " " << number_sims << endl;
initial_params::xinit(y);
send_int_to_slaves(1);
double llc=-pvm_master_get_monte_carlo_value(nvar,y);
send_int_to_slaves(1);
llbest=-pvm_master_get_monte_carlo_value(nvar,y);
lbmax=llbest;
// store current mcmc variable values in param_values
//dmatrix store_mcmc_values(1,number_sims,1,ndvar);
#if defined(USE_BAYES_FACTORS)
lkvector.allocate(1,number_sims);
#endif
dvector mcmc_values(1,ndvar);
dvector mcmc_number_values;
//if (adjm_ptr) mcmc_number_values.allocate(1,numdvar);
int offs=1;
stddev_params::copy_all_values(mcmc_values,offs);
/*
if (adjm_ptr)
{
offs=1;
stddev_params::copy_all_number_values(mcmc_number_values,offs);
}
*/
int change_ball=2500;
int nopt;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcscale",nopt))>-1)
{
if (nopt)
{
int iii=atoi(ad_comm::argv[on+1]);
if (iii <=0)
{
cerr << " Invalid option following command line option -mcball -- "
<< endl << " ignored" << endl;
}
else
change_ball=iii;
}
}
int iac=0;
int liac=0;
int isim=0;
int itmp=0;
double logr;
int u_option=0;
double ll;
int s_option=1;
int psvflag=0;
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcu"))>-1)
{
u_option=1;
}
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcnoscale"))>-1)
{
s_option=0;
}
//cout << llc << " " << llc << endl;
int iac_old=0;
int i_old=0;
{
if (!restart_flag)
{
pofs_sd =
new uostream((char*)(ad_comm::adprogram_name + adstring(".mcm")));
}
int mcsave_flag=0;
int mcrestart_flag=option_match(ad_comm::argc,ad_comm::argv,"-mcr");
if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mcsave"))>-1)
{
int jj=(int)atof(ad_comm::argv[on+1]);
if (jj <=0)
{
cerr << " Invalid option following command line option -mcsave -- "
<< endl;
}
else
{
mcsave_flag=jj;
if ( mcrestart_flag>-1)
{
// check that nvar is correct
{
uistream uis((char*)(ad_comm::adprogram_name + adstring(".psv")));
if (!uis)
{
cerr << "Error trying to open file" <<
ad_comm::adprogram_name + adstring(".psv") <<
" for mcrestart" << endl;
cerr << " I am starting a new file " << endl;
psvflag=1;
}
else
{
int nv1;
uis >> nv1;
if (nv1 !=nvar)
{
cerr << "wrong number of independent variables in" <<
ad_comm::adprogram_name + adstring(".psv") <<
cerr << " I am starting a new file " << endl;
psvflag=1;
}
}
}
if (!psvflag) {
pofs_psave=
new uostream(
(char*)(ad_comm::adprogram_name + adstring(".psv")),ios::app);
} else {
pofs_psave=
new uostream((char*)(ad_comm::adprogram_name + adstring(".psv")));
}
} else {
void ad_comm::allocate(void)
{
#if defined (_WIN32)
directory_prefix='\\';
#else
directory_prefix='/';
#endif
adstring tmpstring;
#if defined(_MSC_VER)
//remove path
for (int i = (int)adprogram_name.size(); i >= 1; i--)
{
if (adprogram_name(i)==directory_prefix)
{
adprogram_name=adprogram_name(i+1,adprogram_name.size());
break;
}
}
#endif
#if defined(_WIN32)
// strip off the .exe
#ifdef __MINGW64__
size_t _n = adprogram_name.size();
assert(_n <= INT_MAX);
int n = (int)_n;
#else
int n = (int)adprogram_name.size();
#endif
if (n > 4)
{
if (adprogram_name(n - 3) == '.'
&& tolower(adprogram_name(n - 2)) == 'e'
&& tolower(adprogram_name(n - 1)) == 'x'
&& tolower(adprogram_name(n)) == 'e')
{
n -= 4;
}
}
adprogram_name=adprogram_name(1,n);
#endif
// change the working directory name
if (argc > 1)
{
int on=0;
if ( (on=option_match(argc,argv,"-wd"))>-1)
{
if (on>argc-2 || argv[on+1][0] == '-')
{
cerr << "Invalid input data command line option"
" -- ignored" << endl;
}
else
{
tmpstring = adstring(argv[on+1]);
wd_flag=1;
}
}
}
if (length(tmpstring))
{
if (tmpstring(length(tmpstring)) == directory_prefix)
{
adprogram_name=tmpstring + adprogram_name;
working_directory_path = tmpstring;
}
else
{
adprogram_name=tmpstring + directory_prefix + adprogram_name;
working_directory_path = tmpstring + directory_prefix;
}
}
tmpstring=adprogram_name + adstring(".dat");
if (argc > 1)
{
int on=0;
if ( (on=option_match(argc,argv,"-ind"))>-1)
{
if (on>argc-2 || argv[on+1][0] == '-')
{
cerr << "Invalid input data command line option"
" -- ignored" << endl;
}
else
{
tmpstring = adstring(argv[on+1]);
}
}
}
global_datafile= new cifstream(tmpstring);
if (!global_datafile)
{
cerr << "Error trying to open data input file "
<< tmpstring << endl;
}
else
{
if (!(*global_datafile))
{
cerr << "Error trying to open data input file "
<< tmpstring << endl;
delete global_datafile;
global_datafile=NULL;
}
}
adstring ts=adprogram_name + adstring(".log");
global_logfile= new ofstream( (char*)ts);
int biopt=-1;
int aiopt=-1;
biopt=option_match(argc,argv,"-binp");
aiopt=option_match(argc,argv,"-ainp");
tmpstring=adprogram_name + adstring(".bin");
if (!global_bparfile && aiopt == -1)
{
if (biopt>-1)
{
if (biopt>argc-2 || argv[biopt+1][0] == '-')
{
cerr << "Invalid input parameter file command line option"
" -- ignored" << endl;
}
else
{
tmpstring = adstring(argv[biopt+1]);
}
}
global_bparfile= new uistream(tmpstring);
if (global_bparfile)
{
if (!(*global_bparfile))
{
if (biopt>-1)
{
cerr << "Error trying to open binary inoput par file "
<< tmpstring << endl;
exit(1);
}
delete global_bparfile;
global_bparfile=NULL;
}
}
}
tmpstring=adprogram_name + adstring(".pin");
if (!global_parfile)
{
if (aiopt>-1)
{
if (aiopt>argc-2 || argv[aiopt+1][0] == '-')
{
cerr << "Invalid input parameter file command line option"
" -- ignored" << endl;
}
else
{
tmpstring = adstring(argv[aiopt+1]);
}
}
global_parfile= new cifstream(tmpstring);
if (global_parfile)
{
if (!(*global_parfile))
{
if (aiopt>-1)
{
cerr << "Error trying to open ascii inoput par file "
<< tmpstring << endl;
exit(1);
}
delete global_parfile;
global_parfile=NULL;
}
}
}
}
