/**
* Description not yet available.
* \param
*/
dmatrix laplace_approximation_calculator::get_gradient_for_hessian_calcs
(const dmatrix& local_Hess,double & f)
{
int us=local_Hess.indexmax();
int nvar=us*us;
independent_variables cy(1,nvar);
cy.initialize();
int ii=1; int i,j;
for (i=1;i<=us;i++)
for (j=1;j<=us;j++)
cy(ii++)=local_Hess(i,j);
dvar_vector vy=dvar_vector(cy);
dvar_matrix vHess(1,us,1,us);
ii=1;
for (i=1;i<=us;i++)
for (j=1;j<=us;j++)
vHess(i,j)=vy(ii++);
dvariable vf=0.0;
int sgn=0;
vf+=0.5*ln_det(vHess,sgn);
f=value(vf);
dvector g(1,nvar);
gradcalc(nvar,g);
dmatrix hessadjoint(1,us,1,us);
ii=1;
for (i=1;i<=us;i++)
for (j=1;j<=us;j++)
hessadjoint(i,j)=g(ii++);
return hessadjoint;
}
/**
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;
}
}
}
/**
* Description not yet available.
* \param
*/
double do_gauss_hermite_block_diagonal_multi(const dvector& x,
const dvector& u0,const dmatrix& Hess,const dvector& _xadjoint,
const dvector& _uadjoint,const dmatrix& _Hessadjoint,
function_minimizer * pmin)
{
ADUNCONST(dvector,xadjoint)
ADUNCONST(dvector,uadjoint)
//ADUNCONST(dmatrix,Hessadjoint)
dvector & w= *(pmin->multinomial_weights);
const int xs=x.size();
const int us=u0.size();
gradient_structure::set_NO_DERIVATIVES();
int nsc=pmin->lapprox->num_separable_calls;
const ivector lrea = (*pmin->lapprox->num_local_re_array)(1,nsc);
int hroom = sum(square(lrea));
int nvar=x.size()+u0.size()+hroom;
independent_variables y(1,nvar);
// need to set random effects active together with whatever
// init parameters should be active in this phase
initial_params::set_inactive_only_random_effects();
initial_params::set_active_random_effects();
/*int onvar=*/initial_params::nvarcalc();
initial_params::xinit(y); // get the initial values into the
// do we need this next line?
y(1,xs)=x;
int i,j;
// contribution for quadratic prior
if (quadratic_prior::get_num_quadratic_prior()>0)
{
//Hess+=quadratic_prior::get_cHessian_contribution();
int & vxs = (int&)(xs);
quadratic_prior::get_cHessian_contribution(Hess,vxs);
}
// Here need hooks for sparse matrix structures
dvar3_array & block_diagonal_vhessian=
*pmin->lapprox->block_diagonal_vhessian;
block_diagonal_vhessian.initialize();
dvar3_array& block_diagonal_ch=
*pmin->lapprox->block_diagonal_vch;
//dvar3_array(*pmin->lapprox->block_diagonal_ch);
int ii=xs+us+1;
d3_array& bdH=(*pmin->lapprox->block_diagonal_hessian);
int ic;
for (ic=1;ic<=nsc;ic++)
{
int lus=lrea(ic);
for (i=1;i<=lus;i++)
for (j=1;j<=lus;j++)
y(ii++)=bdH(ic)(i,j);
}
dvector g(1,nvar);
gradcalc(0,g);
gradient_structure::set_YES_DERIVATIVES();
dvar_vector vy=dvar_vector(y);
//initial_params::stddev_vscale(d,vy);
ii=xs+us+1;
if (initial_df1b2params::have_bounded_random_effects)
{
cerr << "can't do importance sampling with bounded random effects"
" at present" << endl;
ad_exit(1);
}
else
{
for (int ic=1;ic<=nsc;ic++)
{
int lus=lrea(ic);
if (lus>0)
{
for (i=1;i<=lus;i++)
{
for (j=1;j<=lus;j++)
{
block_diagonal_vhessian(ic,i,j)=vy(ii++);
}
}
block_diagonal_ch(ic)=
choleski_decomp(inv(block_diagonal_vhessian(ic)));
}
}
}
int nsamp=pmin->lapprox->use_gauss_hermite;
pmin->lapprox->in_gauss_hermite_phase=1;
dvar_vector sample_value(1,nsamp);
sample_value.initialize();
dvar_vector tau(1,us);;
// !!! This only works for one random efect in each separable call
// at present.
if (pmin->lapprox->gh->mi)
{
delete pmin->lapprox->gh->mi;
pmin->lapprox->gh->mi=0;
}
pmin->lapprox->gh->mi=new multi_index(1,nsamp,
pmin->lapprox->multi_random_effects);
multi_index & mi = *(pmin->lapprox->gh->mi);
//for (int is=1;is<=nsamp;is++)
dvector& xx=pmin->lapprox->gh->x;
do
{
int offset=0;
pmin->lapprox->num_separable_calls=0;
//pmin->lapprox->gh->is=is;
for (ic=1;ic<=nsc;ic++)
{
int lus=lrea(ic);
// will need vector stuff here when more than one random effect
if (lus>0)
{
//tau(offset+1,offset+lus).shift(1)=block_diagonal_ch(ic)(1,1)*
// pmin->lapprox->gh->x(is);
dvector xv(1,lus);
for (int iu=1;iu<=lus;iu++)
{
xv(iu)= xx(mi()(iu));
}
tau(offset+1,offset+lus).shift(1)=block_diagonal_ch(ic)*xv;
offset+=lus;
}
}
// have to reorder the terms to match the block diagonal hessian
imatrix & ls=*(pmin->lapprox->block_diagonal_re_list);
int mmin=ls.indexmin();
int mmax=ls.indexmax();
int ii=1;
int i;
for (i=mmin;i<=mmax;i++)
{
int cmin=ls(i).indexmin();
int cmax=ls(i).indexmax();
for (int j=cmin;j<=cmax;j++)
{
vy(ls(i,j))+=tau(ii++);
}
}
if (ii-1 != us)
{
cerr << "error in interface" << endl;
ad_exit(1);
}
initial_params::reset(vy); // get the values into the model
ii=1;
for (i=mmin;i<=mmax;i++)
{
int cmin=ls(i).indexmin();
int cmax=ls(i).indexmax();
for (int j=cmin;j<=cmax;j++)
{
vy(ls(i,j))-=tau(ii++);
}
}
*objective_function_value::pobjfun=0.0;
pmin->AD_uf_outer();
++mi;
}
while(mi.get_depth()<=pmin->lapprox->multi_random_effects);
nsc=pmin->lapprox->num_separable_calls;
dvariable vf=pmin->do_gauss_hermite_integration();
int sgn=0;
dvariable ld=0.0;
if (ad_comm::no_ln_det_choleski_flag)
{
for (int ic=1;ic<=nsc;ic++)
{
if (allocated(block_diagonal_vhessian(ic)))
{
ld+=w(2*ic)*ln_det(block_diagonal_vhessian(ic),sgn);
}
}
ld*=0.5;
}
else
{
for (int ic=1;ic<=nsc;ic++)
{
if (allocated(block_diagonal_vhessian(ic)))
{
ld+=w(2*ic)*ln_det_choleski(block_diagonal_vhessian(ic));
}
}
ld*=0.5;
}
vf+=ld;
//vf+=us*0.91893853320467241;
double f=value(vf);
gradcalc(nvar,g);
// put uhat back into the model
gradient_structure::set_NO_DERIVATIVES();
vy(xs+1,xs+us).shift(1)=u0;
initial_params::reset(vy); // get the values into the model
gradient_structure::set_YES_DERIVATIVES();
pmin->lapprox->in_gauss_hermite_phase=0;
ii=1;
for (i=1;i<=xs;i++)
xadjoint(i)=g(ii++);
for (i=1;i<=us;i++)
uadjoint(i)=g(ii++);
for (ic=1;ic<=nsc;ic++)
{
int lus=lrea(ic);
for (i=1;i<=lus;i++)
{
for (j=1;j<=lus;j++)
{
(*pmin->lapprox->block_diagonal_vhessianadjoint)(ic)(i,j)=g(ii++);
}
}
}
return f;
}
void function_minimizer::sd_routine(void)
{
int nvar=initial_params::nvarcalc(); // get the number of active parameters
dvector x(1,nvar);
initial_params::xinit(x); // get the number of active parameters
initial_params::restore_start_phase();
int nvar1=initial_params::nvarcalc(); // get the number of active parameters
int num_sdrep_types=stddev_params::num_stddev_params +
initial_params::num_active_calc();
param_labels.allocate(1,num_sdrep_types);
param_size.allocate(1,num_sdrep_types);
int ii=1;
size_t max_name_length = 0;
for (int i=0;i<initial_params::num_initial_params;i++)
{
//if ((initial_params::varsptr[i])->phase_start
// <= initial_params::current_phase)
if (withinbound(0,(initial_params::varsptr[i])->phase_start,
initial_params::current_phase))
{
param_labels[ii]=
(initial_params::varsptr[i])->label();
param_size[ii]=
(initial_params::varsptr[i])->size_count();
if (max_name_length<param_labels[ii].size())
{
max_name_length=param_labels[ii].size();
}
ii++;
}
}
int start_stdlabels=ii;
for (int i=0;i< stddev_params::num_stddev_params;i++)
{
param_labels[ii]=
stddev_params::stddevptr[i]->label();
param_size[ii]=
stddev_params::stddevptr[i]->size_count();
if (max_name_length<param_labels[ii].size())
{
max_name_length=param_labels[ii].size();
}
ii++;
}
int end_stdlabels=ii-1;
int ndvar=stddev_params::num_stddev_calc();
dvector scale(1,nvar1); // need to get scale from somewhere
dvector v(1,nvar); // need to read in v from model.rep
dmatrix S(1,nvar,1,nvar);
{
uistream cif("admodel.cov");
int tmp_nvar = 0;
cif >> tmp_nvar;
if (nvar !=tmp_nvar)
{
cerr << "Incorrect number of independent variables in file"
" model.cov" << endl;
exit(1);
}
cif >> S;
if (!cif)
{
cerr << "error reading covariance matrix from model.cov" << endl;
exit(1);
}
}
int sgn;
initial_params::stddev_scale(scale,x);
double lndet=-ln_det(S,sgn)-2.0*sum(log(scale));
initial_params::set_active_random_effects();
//int nvar1=initial_params::nvarcalc();
dvector diag(1,nvar1+ndvar);
dvector tmp(1,nvar1+ndvar);
{
ofstream ofs("admodel.tmp");
#if defined(__GNU__) || defined(DOS386) || defined(__GNUDOS__)
// *******************************************************
// *******************************************************
{
if (nvar==nvar1) // no random effects
{
for (int i=1;i<=nvar;i++)
{
for (int j=1;j<=i;j++)
{
tmp(j)=S(i,j)*scale(i)*scale(j);
ofs << tmp(j) << " ";
}
ofs << endl;
diag(i)=tmp(i);
}
dmatrix tv(1,ndvar,1,nvar1);
adstring tmpstring="admodel.dep";
if (ad_comm::wd_flag)
tmpstring = ad_comm::adprogram_name + ".dep";
cifstream cif((char*)tmpstring);
int tmp_nvar = 0, tmp_ndvar = 0;
cif >> tmp_nvar >> tmp_ndvar;
if (tmp_nvar!=nvar1)
{
cerr << " tmp_nvar != nvar1 in file " << tmpstring
<< endl;
ad_exit(1);
}
if (ndvar>0)
{
cif >> tv;
dvector tmpsub(1,nvar);
for (int i=1;i<=ndvar;i++)
{
for (int j=1;j<=nvar;j++)
{
tmpsub(j)=(tv(i)*S(j))*scale(j);
}
ofs << tmpsub << " ";
tmpsub=tv(i)*S;
for (int j=1;j<=i;j++)
{
tmp(nvar+j)=tmpsub*tv(j);
ofs << tmp(nvar+j) << " ";
}
diag(i+nvar)=tmp(i+nvar);
if (diag(i+nvar)<=0.0)
{
cerr << "Estimated covariance matrix may not"
" be positive definite" << endl;
cerr << sort(eigenvalues(S)) << endl;
}
ofs << endl;
}
}
}
else // have random effects
{
dmatrix tv(1,ndvar,1,nvar1);
adstring tmpstring="admodel.dep";
if (ad_comm::wd_flag)
tmpstring = ad_comm::adprogram_name + ".dep";
cifstream cif((char*)tmpstring);
int tmp_nvar = 0, tmp_ndvar = 0;
cif >> tmp_nvar >> tmp_ndvar;
if (tmp_nvar!=nvar1)
{
cerr << " tmp_nvar != nvar1 in file " << tmpstring
<< endl;
ad_exit(1);
}
dmatrix BS(1,nvar1,1,nvar1);
BS.initialize();
get_bigS(ndvar,nvar1,nvar,S,BS,scale);
{
tmpstring = ad_comm::adprogram_name + ".bgs";
uostream uos((char*)(tmpstring));
if (!uos)
{
cerr << "error opening file " << tmpstring << endl;
ad_exit(1);
}
uos << nvar1;
uos << BS;
if (!uos)
{
cerr << "error writing to file " << tmpstring << endl;
ad_exit(1);
}
}
for (int i=1;i<=nvar1;i++)
{
for (int j=1;j<=i;j++)
{
tmp(j)=BS(i,j)*scale(i)*scale(j);
ofs << tmp(j) << " ";
}
ofs << endl;
diag(i)=tmp(i);
}
if (ndvar>0)
{
cif >> tv;
dvector tmpsub(1,nvar1);
for (int i=1;i<=ndvar;i++)
{
for (int j=1;j<=nvar1;j++)
{
tmpsub(j)=(tv(i)*BS(j))*scale(j);
}
ofs << tmpsub << " ";
tmpsub=tv(i)*BS;
for (int j=1;j<=i;j++)
{
tmp(nvar1+j)=tmpsub*tv(j);
ofs << tmp(nvar1+j) << " ";
}
diag(i+nvar1)=tmp(i+nvar1);
if (diag(i+nvar1)<=0.0)
{
if (norm(tv(i))>1.e-100)
{
cerr << "Estimated covariance matrix may not"
" be positive definite" << endl;
cerr << sort(eigenvalues(BS)) << endl;
}
}
ofs << endl;
}
}
}
double function_minimizer::projected_hess_determinant(const dvector& g,
const int underflow_flag, const dvector& xscale,
const double& _ln_det_proj_jac)
{
double& ln_det_proj_jac=(double&) _ln_det_proj_jac;
int ibreak=-1;
int sgn=0;
double lndet=0.0;
//char ch;
if (!underflow_flag)
{
uistream ifs("admodel.hes");
if (!ifs)
{
cerr << "Error opening file admodel.hes" << endl;
}
int nvar = 0;
ifs >> nvar;
//dmatrix S(1,nvar,1,nvar);
if (nvar > 0)
{
if (nvar != initial_params::nvarcalc())
{
cout << "the number of independent variables is wrong in admodel.hes"
<< endl;
}
dmatrix p(1,nvar,1,nvar);
dmatrix p1(1,nvar-1,1,nvar);
dmatrix h(1,nvar,1,nvar);
dvector ss(1,nvar);
ifs >> h;
if (!ifs)
{
cerr << "Error reading the hessian from file admodel.hes" << endl;
}
dvector n=g/norm(g);
// project the standard basis vectors onto the tangent space
int i;
for (i=1;i<=nvar;i++)
{
p(i)=-n(i)*n;
p(i,i)+=1;
}
for (i=1;i<=nvar;i++)
{
ss(i)=norm(p(i));
}
double minsize = min(ss);
for (i=1;i<=nvar;i++)
{
if (ss(i) == minsize)
{
ibreak = i;
break;
}
p1(i)=p(i);
}
int ii;
for (ii=i+1;ii<=nvar;ii++)
{
p1(ii-1)=p(ii);
}
dmatrix tmpS(1,nvar-1,1,nvar-1);
//for (ii=1;ii<=nvar-1;ii++)
//{
//for (i=1;i<=nvar;i++)
//{
//p1(ii,i)*=xscale(i);
//}
//}
for (i=1;i<=nvar-1;i++)
{
tmpS(i,i)=p1(i)*p1(i);
for (int j=1;j<i;j++)
{
tmpS(i,j)=p1(i)*p1(j);
tmpS(j,i)=tmpS(i,j);
}
}
ln_det_proj_jac=ln_det(tmpS,sgn);
// reset the p1 basis
for (i=1;i<=nvar;i++)
{
if (i==ibreak) break;
p1(i)=p(i);
}
for (ii=i+1;ii<=nvar;ii++)
{
p1(ii-1)=p(ii);
}
for (i=1;i<=nvar;i++)
{
for (int j=1;j<i;j++)
{
double tmp=(h(i,j)+h(j,i))/2.;
h(i,j)=tmp;
h(j,i)=tmp;
}
}
// move to "model space"
for (i=1;i<=nvar;i++)
{
for (int j=1;j<=nvar;j++)
{
h(i,j)/=(xscale(i)*xscale(j));
}
}
for (i=1;i<nvar;i++)
{
dvector tmp = h*p1(i);
tmpS(i,i)=tmp*p1(i);
for (int j=1;j<i;j++)
{
tmpS(i,j)=tmp*p1(j);
tmpS(j,i)=tmpS(i,j);
}
}
lndet=ln_det(tmpS,sgn);
}
if (sgn <= 0)
{
cerr << "Error restricted Hessian is not positive definite" << endl;
}
}
