/**
* Description not yet available.
* \param
*/
double dot(const dmatrix& M,const dmatrix& N)
{
int mmin=M.indexmin();
int mmax=M.indexmax();
if (mmin!=N.indexmin() ||
mmax!=N.indexmax() )
{
cerr << "matrix shapes unequal in"
" double dot(const dmatrix& M,const dmatrix& N)"
<< endl;
ad_exit(1);
}
if (M(mmin).indexmin()!=N(mmin).indexmin() ||
M(mmin).indexmax()!=N(mmin).indexmax() )
{
cerr << "matrix shapes unequal in"
" double dot(const dmatrix& M,const dmatrix& N)"
<< endl;
ad_exit(1);
}
double ssum=0;
for (int i=mmin;i<=mmax;i++)
{
int jmin=M(i).indexmin();
int jmax=M(i).indexmax();
for (int j=jmin;j<=jmax;j++)
{
ssum+=M(i,j)*N(i,j);
}
}
return ssum;
}
/**
* Description not yet available.
* \param
*/
void ghk_test(const dmatrix& eps,int i)
{
if (i<eps.indexmin())
{
cerr << "Index too low in function ghk -- min is "
<< eps.indexmin() << " you have " << i << endl;
exit(21);
}
else if (i>eps.indexmax())
{
cerr << "Index too high in function ghk -- max is "
<< eps.indexmax() << " you have " << i << endl;
exit(21);
}
}
/**
* 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;
}
/**
* Description not yet available.
* \param
*/
double ghk(const dvector& lower,const dvector& upper,const dmatrix& Sigma,
const dmatrix& eps)
{
int m=eps.indexmax();
int n=lower.indexmax();
double ssum=0.0;
dmatrix ch=choleski_decomp(Sigma);
dvector l(1,n);
dvector u(1,n);
for (int k=1;k<=m;k++)
{
double weight=1.0;
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
double Phiu=cumd_norm(u(j));
double Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
double eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil);
for (int i=j+1;i<=n;i++)
{
double tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
ssum+=weight;
}
return ssum/m;
}
/**
* Description not yet available.
* \param
*/
dvariable ghk_choleski(const dvar_vector& lower,const dvar_vector& upper,
const dvar_matrix& ch, const dmatrix& eps)
{
RETURN_ARRAYS_INCREMENT();
int n=lower.indexmax();
int m=eps.indexmax();
dvariable ssum=0.0;
dvar_vector l(1,n);
dvar_vector u(1,n);
for (int k=1;k<=m;k++)
{
dvariable weight=1.0;
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
dvariable Phiu=cumd_norm(u(j));
dvariable Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
dvariable eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil);
for (int i=j+1;i<=n;i++)
{
dvariable tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
ssum+=weight;
}
RETURN_ARRAYS_DECREMENT();
return ssum/m;
}
/**
* Description not yet available.
* \param
*/
dvariable ghk_m(const dvar_vector& upper,const dvar_matrix& Sigma,
const dmatrix& eps)
{
RETURN_ARRAYS_INCREMENT();
int n=upper.indexmax();
int m=eps.indexmax();
dvariable ssum=0.0;
dvar_vector u(1,n);
dvar_matrix ch=choleski_decomp(Sigma);
for (int k=1;k<=m;k++)
{
dvariable weight=1.0;
u=upper;
for (int j=1;j<=n;j++)
{
u(j)/=ch(j,j);
dvariable Phiu=cumd_norm(u(j));
weight*=Phiu;
dvariable eta=inv_cumd_norm(1.e-30+Phiu*eps(k,j));
for (int i=j+1;i<=n;i++)
{
dvariable tmp=ch(i,j)*eta;
u(i)-=tmp;
}
}
ssum+=weight;
}
RETURN_ARRAYS_DECREMENT();
return ssum/m;
}
void send_dmatrix_to_slaves(const dmatrix& x,ivector& jmin,ivector& jmax)
{
// ********* begin variable send block *************
int ii=1;
for (int i=1; i<=ad_comm::pvm_manager-> nhost; i++)
{
for (int j=ad_comm::pvm_manager->slave_assignments(i).indexmin();
j<=ad_comm::pvm_manager->slave_assignments(i).indexmax();j++)
{
int kmin=x.indexmin();
int kmax=x.indexmax();
int lmin=jmin(ii);
int lmax=jmax(ii);
ii++;
dmatrix H(kmin,kmax,lmin,lmax);
for (int k=kmin;k<=kmax;k++)
for (int l=lmin;l<=lmax;l++)
H(k,l)=x(k,l);
int bufid = adpvm_master_cinitsend( PvmDataRaw );
adpvm_pack(H);
adpvm_master_csend(ad_comm::pvm_manager->id(i,j));
}
}
// ********* end constant send block *************
}
void initialize(void)
{
indx.initialize();
indx2.fill_seqadd(indexmin(), 1);
sign = 1;
L.initialize();
U.initialize();
for (int i = L.indexmin(); i <= L.indexmax(); i++)
{
L(i, i) = 1.0;
}
}
/**
* LU Decomposition of a Matrix
* \param M \f$M\f$ a square matrix to decompose
* \return a cltudecomp object containg the
* upper and lower parts of the decomposed matrix
*/
cltudecomp ludecomp(const dmatrix & M)
{
int mmin = M.indexmin();
int mmax = M.indexmax();
cltudecomp clu(mmin, mmax);
// get upper and lower parts of LU
dmatrix & alpha = clu.get_L();
dmatrix & gamma = clu.get_U(); // gamma is the transpose of beta
// copy M into alpha and gamma
for (int i = mmin; i <= mmax; i++)
{
for (int j = mmin; j <= mmax; j++)
{
clu(i, j) = M(i, j);
}
}
for (int j = mmin; j <= mmax; j++)
{
int i = 0;
for (i = mmin + 1; i < j; i++)
{
// using subvector here
clu(i, j) -= alpha(i) (mmin, i - 1) * gamma(j) (mmin, i - 1);
}
for (i = j; i <= mmax; i++)
{
// using subvector here
if (j > 1)
{
clu(i, j) -= alpha(i) (mmin, j - 1) * gamma(j) (mmin, j - 1);
}
}
if (j != mmax)
{
double z = 1.0 / gamma(j, j);
for (i = j + 1; i <= mmax; i++)
{
alpha(i, j) *= z;
}
}
}
return clu;
}
/**
* Description not yet available.
* \param
*/
int sub_unallocated(const dmatrix& m)
{
int iflag=0;
int mmin=m.indexmin();
int mmax=m.indexmax();
if (!allocated(m))
{
iflag=1;
return iflag;
}
for (int i=mmin;i<=mmax;i++)
{
if (!allocated(m(i)))
{
iflag=1;
break;
}
}
return iflag;
}
int indexmax()
{
return U.indexmax();
}
int indexmax() const
{
return D.indexmax();
}
int indexmax()
{
return D.indexmax();
}