/**
* Description not yet available.
* \param
*/
init_df1_two_variable::init_df1_two_variable(const prevariable& _v)
{
if (num_ind_var > 1)
{
cerr << "can only have 2 independent_variables in df1_two_variable"
" function" << endl;
ad_exit(1);
}
else
{
ADUNCONST(prevariable,v)
ind_var[num_ind_var++]=&v;
*get_u() = value(v);
switch(num_ind_var)
{
case 1:
*get_u_x() = 1.0;
*get_u_y() = 0.0;
break;
case 2:
*get_u_x() = 0.0;
*get_u_y() = 1.0;
break;
default:
cerr << "illegal num_ind_var value of " << num_ind_var
<< " in df1_two_variable function" << endl;
ad_exit(1);
}
}
}
/**
* Description not yet available.
* \param
*/
local_dep_df1b2variable::local_dep_df1b2variable
(const df1b2variable & _x) : df1b2variable(newadkl)
{
ADUNCONST(df1b2variable,x)
p=&_x;
xu=*(x.get_u());
}
/**
* Description not yet available.
* \param
*/
df1b2variable asin(const df1b2variable& _xx)
{
ADUNCONST(df1b2variable,xx)
df1b2variable z;
double x=value(xx);
double f=asin(x);
double t1=1.0/(1-x*x);
double dfx = sqrt(t1);
double t2 = t1*dfx;
double d2f = t2 *x;
double d3f = t2 + 3.0* d2f*t1*x;
double * xd=xx.get_u_dot();
double * zd=z.get_u_dot();
*z.get_u()=f;
for (unsigned int i=0;i<df1b2variable::nvar;i++)
{
*zd++ =dfx * *xd++;
}
if (!df1b2_gradlist::no_derivatives)
f1b2gradlist->write_pass1(&xx,&z,dfx,d2f,d3f);
return z;
}
/**
* Description not yet available.
* \param
*/
local_dep_df1b2vector::local_dep_df1b2vector(const df1b2vector & _x)
{
ADUNCONST(df1b2vector,x)
p=&_x;
int mmin=x.indexmin();
int mmax=x.indexmax();
//int ind_index = x(mmin).get_ind_index();
df1b2variable::noallocate=1;
df1b2vector::allocate(mmin,mmax);
df1b2variable::noallocate=0;
}
/**
* Description not yet available.
* \param
*/
dvector value(const df1b2vector& _t1)
{
ADUNCONST(df1b2vector,t1)
dvector tmp(t1.indexmin(),t1.indexmax());
for (int i=t1.indexmin(); i<=t1.indexmax(); i++)
{
tmp.elem(i)=value(t1(i));
}
return(tmp);
}
df1b2variable log_negbinomial_density(double x,const df1b2variable& _xmu,
const df1b2variable& _xtau)
{
ADUNCONST(df1b2variable,xmu)
ADUNCONST(df1b2variable,xtau)
init_df3_two_variable mu(xmu);
init_df3_two_variable tau(xtau);
*mu.get_u_x()=1.0;
*tau.get_u_y()=1.0;
if (value(tau)-1.0<0.0)
{
cerr << "tau <=1 in log_negbinomial_density " << endl;
ad_exit(1);
}
df3_two_variable r=mu/(1.e-120+(tau-1.0));
df3_two_variable tmp;
tmp=gammln(x+r)-gammln(r) -gammln(x+1)
+r*log(r)+x*log(mu)-(r+x)*log(r+mu);
df1b2variable tmp1;
tmp1=tmp;
return tmp1;
}
/**
* Description not yet available.
* \param
*/
df1b2variable df1b2function2c::operator () (double x,const df1b2variable& _y)
{
ADUNCONST(df1b2variable,y)
df1b2variable z;
double yu=*y.get_u();
double * yd=y.get_u_dot();
double * zd=z.get_u_dot();
*z.get_u()=(*f)(x,yu);
double dfy=(*df)(x,yu);
for (int i=0; i<df1b2variable::nvar; i++)
{
*zd++ =dfy * *yd++ ;
}
// WRITE WHATEVER ON TAPE
if (!df1b2_gradlist::no_derivatives)
f1b2gradlist->write_pass1c(x,&y,&z,this);
return z;
}
/**
* Description not yet available.
* \param
*/
df1b2variable operator * (const df1b2variable& _x, double y)
{
ADUNCONST(df1b2variable,x)
df1b2variable z;
double * xd=x.get_u_dot();
double * zd=z.get_u_dot();
double xu=*x.get_u();
*z.get_u()=y*xu;
for (unsigned int i=0;i<df1b2variable::nvar;i++)
{
*zd++ = y * *xd++;
}
// WRITE WHATEVER ON TAPE
if (!df1b2_gradlist::no_derivatives)
f1b2gradlist->write_pass1_prod(&x,y,&z);
return z;
}
/** Lu decomposition of a variable matrix.
\param _a A dmatrix; replaced by the by its resulting LU decomposition
\param _indx An ivector containing the row permutations generated by partial pivoting
\param _d A double containing -1 or +1 depending whether the number of row interchanges was even or odd, repectively.
\n\n The implementation of this algorithm was inspired by
"Numerical Recipes in C", 2nd edition,
Press, Teukolsky, Vetterling, Flannery, chapter 2
*/
void ludcmp(const dvar_matrix& _a, const ivector& _indx, const prevariable& _d)
{
ADUNCONST(dvar_matrix,a)
ADUNCONST(prevariable,d)
ivector& indx= (ivector&) _indx;
int i,j,k;
#if !defined(OPT_LIB) && (__cplusplus >= 201103L)
int n = [](unsigned int colsize) -> int
{
assert(colsize <= INT_MAX);
return static_cast<int>(colsize);
} (a.colsize());
#else
int n = static_cast<int>(a.colsize());
#endif
int lb=a.colmin();
int ub=a.colmax();
dvariable big,dum,sum,temp;
dvar_vector vv(lb,ub);
d=1.0;
for (i=lb;i<=ub;i++)
{
big=0.0;
for (j=lb;j<=ub;j++)
{
temp=fabs(a(i,j));
if (temp > big)
{
big=temp;
}
}
if (big == 0.0)
{
cerr << "Error in matrix inverse -- matrix singular in inv(dmatrix)\n";
}
vv(i)=1.0/big;
}
for (j=lb;j<=ub;j++)
{
for (i=lb;i<j;i++)
{
sum=a(i,j);
for (k=lb;k<i;k++)
{
sum = sum - a(i,k)*a(k,j);
}
a(i,j)=sum;
}
int imax = j;
big=0.0;
for (i=j;i<=ub;i++)
{
sum=a(i,j);
for (k=lb;k<j;k++)
{
sum = sum - a(i,k)*a(k,j);
}
a(i,j)=sum;
dum=vv(i)*fabs(sum);
if ( dum >= big)
{
big=dum;
imax=i;
}
}
if (j != imax)
{
for (k=lb;k<=ub;k++)
{
dum=a(imax,k);
a(imax,k)=a(j,k);
a(j,k)=dum;
}
d = -1.*d;
vv(imax)=vv(j);
}
indx(j)=imax;
if (a(j,j) == 0.0)
{
a(j,j)=eps0;
}
if (j != n)
{
dum=1.0/(a(j,j));
for (i=j+1;i<=ub;i++)
{
a(i,j) = a(i,j) * dum;
}
}
}
}
/** Householder transformation for eigenvalue computation.
\param _m Real, symmetric matrix; on return contains the orthogonal
transformed matrix.
\param _d On return contains the diagonal elements of the tri-diagonal matrix.
\param _e On return contains the off-diagonal elements.
\n\n The implementation of this algorithm was inspired by
"Numerical Recipes in C", 2nd edition,
Press, Teukolsky, Vetterling, Flannery, chapter 11
*/
void tri_dag(const dvar_matrix& _m,const dvar_vector& _d, const dvar_vector& _e)
{
ADUNCONST(dvar_vector,d)
ADUNCONST(dvar_vector,e)
dvar_matrix& m=(dvar_matrix&) _m;
if (m.rowsize() != m.colsize())
{
cerr << "Error -- non square matrix passed to "
"void tridag(const dmatrix& m)\n";
ad_exit(1);
}
if (m.rowsize() != d.size() || m.rowsize() != e.size()
|| d.indexmin() != 1 || e.indexmin() !=1 )
{
cerr <<"Error -- incorrect vector size passed to "
"void tridag(const dmatrix& m)\n";
ad_exit(1);
}
int n=m.rowsize();
int l,k,j,i;
dvariable scale,hh,h,g,f;
for (i=n;i>=2;i--)
{
l=i-1;
h=scale=0.0;
if (l > 1)
{
for (k=1;k<=l;k++)
scale += fabs(m[i][k]);
if (scale == 0.0)
e[i]=m[i][l];
else
{
for (k=1;k<=l;k++)
{
m[i][k] /= scale;
h += m[i][k]*m[i][k];
}
f=m[i][l];
g = f>0. ? -sqrt(h) : sqrt(h);
e[i]=scale*g;
h -= f*g;
m[i][l]=f-g;
f=0.0;
for (j=1;j<=l;j++)
{
#ifdef EIGEN_VECTORS
/* Next statement can be omitted if eigenvectors not wanted */
m[j][i]=m[i][j]/h;
#endif
g=0.0;
for (k=1;k<=j;k++)
g += m[j][k]*m[i][k];
for (k=j+1;k<=l;k++)
g += m[k][j]*m[i][k];
e[j]=g/h;
f += e[j]*m[i][j];
}
hh=f/(h+h);
for (j=1;j<=l;j++)
{
f=m[i][j];
e[j]=g=e[j]-hh*f;
for (k=1;k<=j;k++)
m[j][k] -= (f*e[k]+g*m[i][k]);
}
}
}
else
{
e[i]=m[i][l];
}
d[i]=h;
}
/* Next statement can be omitted if eigenvectors not wanted */
d[1]=0.0;
e[1]=0.0;
/* Contents of this loop can be omitted if eigenvectors not
wanted except for statement d[i]=a[i][i]; */
#ifdef EIGEN_VECTORS
for (i=1;i<=n;i++)
{
l=i-1;
if (d[i])
{
for (j=1;j<=l;j++)
{
g=0.0;
for (k=1;k<=l;k++)
g += m[i][k]*m[k][j];
for (k=1;k<=l;k++)
m[k][j] -= g*m[k][i];
}
}
d[i]=m[i][i];
m[i][i]=1.0;
for (j=1;j<=l;j++) m[j][i]=m[i][j]=0.0;
}
#else
for (i=1;i<=n;i++)
{
d[i]=m[i][i];
}
#endif
}
/**
* 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;
}
