/**
Determine if the lower and upper bounds of two evctors match in a specified
function.
\param v1 a data vector
\param v2 a data vector
\param function_nam a pointer to the name of the function in question.
*/
void shape_check(const dvector& v1, const dvector& v2,
const char *function_name)
{
if (v1.indexmin() != v2.indexmin() || v1.indexmax() != v2.indexmax())
{
cerr << " Vector sizes do no match in" << function_name << "\n";
ad_exit(1);
}
}
dvariable robust_regression(dvector& obs, dvar_vector& pred,
const double& cutoff)
{
if (obs.indexmin() != pred.indexmin() || obs.indexmax() != pred.indexmax() )
{
cerr << "Index limits on observed vector are not equal to the Index\n\
limits on the predicted vector in robust_reg_likelihood function\n";
}
RETURN_ARRAYS_INCREMENT(); //Need this statement because the function
//returns a variable type
int min=obs.indexmin();
int max=obs.indexmax();
dvariable sigma_hat;
dvariable sigma_tilde;
int nobs = max-min+1;
double width=3.0;
double pcon=0.05;
double width2=width*width;
dvariable zpen;
zpen=0.0;
double a,a2;
a=cutoff;
// This bounds a between 0.05 and 1.75
a2=a*a;
dvariable tmp,tmp2,tmp4,sum_square,v_hat;
dvar_vector diff_vec = obs-pred;
tmp = norm(diff_vec);
sum_square = tmp * tmp;
v_hat = 1.e-80 + sum_square/nobs;
sigma_hat=pow(v_hat,.5);
sigma_tilde=a*sigma_hat;
double b=2.*pcon/(width*sqrt(PI));
dvariable log_likelihood;
dvariable div1;
dvariable div2,div4;
div1 = 2*(a2*v_hat);
div2 = width2*(a2*v_hat);
div4 = div2*div2;
log_likelihood = 0;
for (int i=min; i<=max; i++)
{
tmp=diff_vec[i];
tmp2=tmp*tmp;
tmp4=tmp2*tmp2;
log_likelihood -= log((1-pcon)*exp(-tmp2/div1)+b/(1.+tmp4/div4) );
}
log_likelihood += nobs*log(a2*v_hat)/2.;
log_likelihood += zpen;
RETURN_ARRAYS_DECREMENT(); // Need this to decrement the stack increment
// caused by RETURN_ARRAYS_INCREMENT();
return(log_likelihood);
}
/**
* Description not yet available.
* \param
*/
dmatrix outer_prod(const dvector& v1, const dvector& v2)
{
dmatrix tmp(v1.indexmin(),v1.indexmax(), v2.indexmin(), v2.indexmax() );
for (int i=v1.indexmin(); i<=v1.indexmax(); i++)
{
for (int j=v2.indexmin(); j<=v2.indexmax(); j++)
{
tmp.elem(i,j)=v1.elem(i)*v2.elem(j);
}
}
return(tmp);
}
/**
* Description not yet available.
* \param
*/
void lvector::fill_multinomial(const int& seed, const dvector& p)
// Fils a dvector with random numbers drawn from a multinomial distribution
{
double sum=mean(p)*p.size();
int pmin=p.indexmin();
int pmax=p.indexmax();
dvector tmp(pmin,pmax);
dvector tmp1(pmin,pmax);
dvector choose(indexmin(),indexmax());
choose.fill_randu(seed);
tmp=p/sum;
tmp1(pmin)=tmp(pmin);
for (int j=pmin+1;j<=pmax-1;j++)
{
tmp1(j)=tmp1(j-1)+tmp(j);
}
tmp1(pmax)=1.0;
for (int i=indexmin();i<=indexmax();i++)
{
int j=pmin;
while (choose(i)>tmp1(j))
{
j++;
}
(*this)(i)=j;
}
}
/** negative log likelihood of negative binomial with mean and tau
\brief Negative binomial with mean=mu and variance = mu*tau
\author Mollie Brooks
\param x observed counts
\param mu is the predicted mean
\param tau is the overdispersion parameter like in the quasi-poisson. should be >1
\return negative log likelihood \f$ -( \ln(\Gamma(x+k))-\ln(\Gamma(k))-\ln(x!)+k\ln(k)+x\ln(\mu)-(k+x)\ln(k+\mu) )\f$
where \f$ k=\mu/(10^{-120}+\tau-1.0) \f$
\ingroup STATLIB
**/
dvariable dnbinom_tau(const dvector& x, const dvar_vector& mu, const dvar_vector& tau)
{
//the observed counts are in x
//mu is the predicted mean
//tau is the overdispersion parameter
RETURN_ARRAYS_INCREMENT();
int i,imin,imax;
imin=x.indexmin();
imax=x.indexmax();
dvariable loglike;
loglike=0.;
for(i = imin; i<=imax; i++)
{
if (value(tau(i))<1.0)
{
cerr<<"tau("<<i<<") is <=1.0 in dnbinom_tau()";
return(0.0);
}
loglike += log_negbinomial_density(x(i), mu(i), tau(i));
}
RETURN_ARRAYS_DECREMENT();
return(-loglike);
}
/**
* 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
*/
dvector solve_trans(const lower_triangular_dmatrix& M,const dvector& y)
{
int mmin=M.indexmin();
int mmax=M.indexmax();
if (y.indexmin() !=mmin || y.indexmax() !=mmax)
{
cerr << "incompatible size in solve_trans" << endl;
ad_exit(1);
}
dvector x(mmin,mmax);
int i,j;
for (i=mmax;i>=mmin;i--)
{
double sum=0.0;
for (j=i+1;j<=mmax;j++)
{
sum+=M(j,i)*x(j);
}
x(i)=(y(i)-sum)/M(i,i);
}
return x;
}
/**
* Description not yet available.
* \param
*/
double ghk(const dvector& lower,const dvector& upper,const dmatrix& Sigma,
const dmatrix& eps,int _i)
{
int n=lower.indexmax();
dmatrix ch=choleski_decomp(Sigma);
dvector l(1,n);
dvector u(1,n);
ghk_test(eps,_i); // test for valid i range
double weight=1.0;
int k=_i;
{
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;
}
}
}
return weight;
}
/**
Return the total sum of the elements in values.
\param values dvector
*/
double sum(const dvector& values)
{
double total = 0.0;
for (int i = values.indexmin(); i <= values.indexmax(); ++i)
{
total += values.elem(i);
}
return total;
}
/**
Return dvector results of squaring elements in a values;
constant vector object.
\ingroup misc
\param values of constant object to be squared.
\return vector of the same length as #values containing \f$values_i^2\f$
*/
dvector square(const dvector& values)
{
dvector results;
results.allocate(values);
for (int i = values.indexmin(); i <= values.indexmax(); ++i)
{
results(i) = square(values(i));
}
return results;
}
/**
Return ivector filled with flags for 1 positive and -1 negative
for values in dvector v.
*/
ivector sgn(const dvector& v)
{
int mmin = v.indexmin();
int mmax = v.indexmax();
ivector ret(mmin, mmax);
for (int i = mmin; i <= mmax; ++i)
{
ret(i)= v(i) > 0 ? 1 : -1;
}
return ret;
}
dvector cubic_spline_function::operator () (const dvector& u)
{
int mmin=u.indexmin();
int mmax=u.indexmax();
dvector z(mmin,mmax);
for (int i=mmin;i<=mmax;i++)
{
z(i)=splint(x,y,y2,u(i));
}
return z;
}
/**
* Description not yet available.
* \param
*/
void nograd_assign_row(const dvar_matrix& m, const dvector& v, const int& ii)
{
// cout << "Entering nograd assign"<<endl;
//kkludge_object kg;
if (ii<m.rowmin()||ii>m.rowmax() ||
(v.indexmin()!=m(ii).indexmin()) ||
(v.indexmax()!=m(ii).indexmax()) )
{
cerr << "Error -- Index out of bounds in\n"
"void nograd_assign(const dvar_matrix& m, const dvector& v, const int& ii)"
<< endl;
ad_exit(1);
}
int min=v.indexmin();
int max=v.indexmax();
for (int j=min;j<=max;j++)
{
value(m(ii,j))=v(j);
}
// out(i)=nograd_assign(m(i));
}
/**
\ingroup matop
Element-wise division of two vectors; constant objects.
Exits with error if bounds of the two arguments differ.
\param t1 A vector, \f$u\f$ with valid subscripts in \f$[i_1,i_n]\f$
\param t2 A vector, \f$v\f$ with valid subscripts in \f$[i_1,i_n]\f$
\return A vector containing \f$z_i = u_i\div v_i; [i_1,i_n]\f$.
*/
dvector elem_div(const dvector& t1, const dvector& t2)
{
if (t1.indexmin() != t2.indexmin() || t1.indexmax() != t2.indexmax())
{
cerr << "Index bounds do not match in "
"dvector elem_div(const dvector&, const dvector&)\n";
ad_exit(1);
}
dvector tmp(t1.indexmin(),t1.indexmax());
#ifndef USE_ASSEMBLER
for (int i=t1.indexmin(); i<=t1.indexmax(); i++)
{
tmp[i]=t1[i]/t2[i];
}
#else
int min=t1.indexmin();
int n=t1.indexmax()-min+1;
dp_vector_elem_prod(&(tmp(min)),&(t1(min)),&(t2(min)),n);
#endif
return(tmp);
}
/**
* Description not yet available.
* \param
*/
dvar_vector operator*(const dvar_matrix& m, const dvector& x)
{
RETURN_ARRAYS_INCREMENT();
if (x.indexmin() != m.colmin() || x.indexmax() != m.colmax())
{
cerr << " Incompatible array bounds in "
"dvar_vector operator * (const dvar_matrix& m, const dvar_vector& x)\n";
ad_exit(21);
}
kkludge_object kkk;
dvar_vector tmp(m.rowmin(),m.rowmax(),kkk);
double sum;
for (int i=m.rowmin(); i<=m.rowmax(); i++)
{
sum=0.0;
const dvar_vector& tt=m.elem(i);
for (int j=x.indexmin(); j<=x.indexmax(); j++)
{
//sum+=m[i][j]*x[j];
sum+=tt.elem_value(j)*x.elem(j);
}
tmp.elem_value(i)=sum;
}
save_identifier_string("PL4");
x.save_dvector_value();
x.save_dvector_position();
m.save_dvar_matrix_position();
tmp.save_dvar_vector_position();
save_identifier_string("PLX");
gradient_structure::GRAD_STACK1->
set_gradient_stack(dmcv_prod);
RETURN_ARRAYS_DECREMENT();
return(tmp);
}
/**
* Description not yet available.
* \param
*/
dvar_vector operator*(const dvector& x, const dvar_matrix& m)
{
RETURN_ARRAYS_INCREMENT();
if (x.indexmin() != m.rowmin() || x.indexmax() != m.rowmax())
{
cerr << " Incompatible array bounds in "
"dvar_vector operator*(const dvector& x, const dvar_matrix& m)\n";
ad_exit(21);
}
dvar_vector tmp(m.colmin(),m.colmax());
dvariable sum;
for (int j=m.colmin(); j<=m.colmax(); j++)
{
sum=0.0;
for (int i=x.indexmin(); i<=x.indexmax(); i++)
{
sum+=x.elem(i)*m.elem(i,j);
}
tmp[j]=sum;
}
RETURN_ARRAYS_DECREMENT();
return(tmp);
}
void param_init_bounded_matrix_vector::set_scalefactor(const dvector& s)
{
int mmin=indexmin();
int mmax=indexmax();
if (s.indexmin()!=mmin || s.indexmax() != mmax)
{
cerr << "non matching vector bounds in"
" init_bounded_matrix_vector::set_scalefactor" << endl;
ad_exit(1);
}
for (int i=mmin;i<=mmax;i++)
{
(*this)(i).set_scalefactor(s(i));
}
}
/**
* Description not yet available.
* \param
*/
dvar_vector::dvar_vector(const dvector& t)
{
if (!t)
{
allocate();
}
else
{
va=NULL;
allocate(t.indexmin(),t.indexmax());
initialize();
for (int i = indexmin(); i <= indexmax(); i++)
{
va[i].x=(t.v)[i];
}
}
}
void pvm_number::assign(const dvector& u)
{
if(ad_comm::pvm_manager)
{
int nsp=ad_comm::pvm_manager->num_slave_processes;
if (u.indexmin() !=0 || u.indexmax() != nsp)
{
cerr << "Error in pvm_number::assign valid index bounds must be 0 "
<< ad_comm::pvm_manager->num_slave_processes << endl;
ad_exit(1);
}
if (allocated(v))
v.deallocate();
v.allocate(0,nsp);
v=u;
d=u(0);
}
}
/**
* Description not yet available.
* \param
*/
dvector solve(const lower_triangular_dmatrix& m,const dvector&v)
{
int imin=m.indexmin();
int imax=m.indexmax();
if (v.indexmin() != imin || v.indexmax() != imax)
{
cerr << " Incompatible vector and matrix sizes in solve " << endl;
ad_exit(1);
}
dvector x(imin,imax);
x(imin)=v(imin)/m(imin,imin);
for (int i=2;i<=imax;i++)
{
int jmin=imin;
double ssum=0.0;
for (int j=jmin;j<=i-1;j++)
{
ssum+=m(i,j)*x(j);
}
x(i)=(v(i)-ssum)/m(i,i);
}
return x;
}
/**
* Description not yet available.
* \param
*/
void ivector::allocate(const dvector& dv)
{
allocate(dv.indexmin(),dv.indexmax());
}
/**
Allocate dvar_vector using indexes from v1.
*/
void dvar_vector::allocate(const dvector& v1)
{
allocate(v1.indexmin(), v1.indexmax());
}
/** Quicksort.
\param v Vector of doubles to be sorted
\param NSTACK Lenth of intermediate storage vector. Default is NSTACK = 60.
\return dvector object containing the input vector sorted in ascending order.
\n\n The implementation of this algorithm was inspired by
"Numerical Recipes in C", 2nd edition,
Press, Teukolsky, Vetterling, Flannery, chapter 8
*/
dvector sort(const dvector& v, int NSTACK)
{
const int M=7;
const int FM=7875;
const int FA=211;
const int FC=1663;
int n=v.size();
dvector arr(v.indexmin(),v.indexmax());
arr=v;
arr.shift(1);
int l=1,jstack=0,j,ir,iq,i;
ivector istack(1,NSTACK+1);
long int fx=0L;
double a;
ir=n;
for (;;)
{
if (ir-l < M)
{
for (j=l+1;j<=ir;j++)
{
a=arr[j];
for (i=j-1;i>0 && arr[i]>a;i--) arr[i+1]=arr[i];
arr[i+1]=a;
}
if (jstack == 0)
{
arr.shift(v.indexmin());
return arr;
}
ir=istack[jstack--];
l=istack[jstack--];
}
else
{
i=l;
j=ir;
fx=(fx*FA+FC) % FM;
iq=l+((ir-l+1)*fx)/FM;
if (iq<=0)
{
iq=l+((ir-l+1.0)*fx)/FM;
}
a=arr[iq];
arr[iq]=arr[l];
for (;;)
{
while (j > 0 && a < arr[j]) j--;
if (j <= i)
{
arr[i]=a;
break;
}
arr[i++]=arr[j];
while (i <= n && a > arr[i] ) i++;
if (j <= i)
{
arr[(i=j)]=a;
break;
}
arr[j--]=arr[i];
}
if (ir-i >= i-l)
{
istack[++jstack]=i+1;
istack[++jstack]=ir;
ir=i-1;
} else
{
istack[++jstack]=l;
istack[++jstack]=i-1;
l=i+1;
}
if (jstack > NSTACK)
{
cerr << "Need to increase the stack in sort(const dvector&)\n";
ad_exit(1);
}
}
}
}
/**
Copy index and pointer to values from vv.
\param vv a dvector
*/
dvector_position::dvector_position(const dvector& vv)
{
min=vv.indexmin();
max=vv.indexmax();
v=vv.get_v();
}
int nvar(void) {return udot.indexmax();}
