Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(age);
DATA_VECTOR(len);
DATA_SCALAR(CV_e);
DATA_INTEGER(num_reads);
// parameters:
PARAMETER(r0); // reference value
PARAMETER(b); // growth displacement
PARAMETER(k); // growth rate
PARAMETER(m); // slope of growth
PARAMETER(CV_Lt);
PARAMETER(gam_shape);
PARAMETER(gam_scale);
PARAMETER_VECTOR(age_re);
// procedures:
Type n = len.size();
Type nll = 0.0; // Initialize negative log-likelihood
Type eps = 1e-5;
CV_e = CV_e < 0.05 ? 0.05 : CV_e;
for (int i = 0; i < n; i++) {
Type x = age_re(i);
if (!isNA(x) && isFinite(x)) {
Type len_pred = pow(r0 + b * exp(k * x), m);
Type sigma_e = CV_e * x + eps;
Type sigma_Lt = CV_Lt * (len_pred + eps);
nll -= dnorm(len(i), len_pred, sigma_Lt, true);
nll -= dgamma(x + eps, gam_shape, gam_scale, true);
for (int j = 0; j < num_reads; j++) {
if (!isNA(age(j, i)) && isFinite(age(j, i)) && age(j, i) >= 0) {
nll -= dnorm(age(j, i), x, sigma_e, true);
}
}
}
}
return nll;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(age);
DATA_VECTOR(len);
DATA_SCALAR(CV_e);
DATA_INTEGER(num_reads);
// parameters:
PARAMETER(a); // upper asymptote
PARAMETER(b); // growth range
PARAMETER(k); // growth rate
PARAMETER(CV_Lt);
PARAMETER(beta);
PARAMETER_VECTOR(age_re);
// procedures:
Type n = len.size();
Type nll = 0.0; // Initialize negative log-likelihood
Type eps = 1e-5;
CV_e = CV_e < 0.05 ? 0.05 : CV_e;
for (int i = 0; i < n; i++) {
Type x = age_re(i);
if (!isNA(x) && isFinite(x)) {
Type len_pred = a / (1 + b * exp(-k * x));
Type sigma_e = CV_e * x + eps;
Type sigma_Lt = CV_Lt * (len_pred + eps);
nll -= dnorm(len(i), len_pred, sigma_Lt, true);
nll -= dexp(x, beta, true);
for (int j = 0; j < num_reads; j++) {
if (!isNA(age(j, i)) && isFinite(age(j, i)) && age(j, i) >= 0) {
nll -= dnorm(age(j, i), x, sigma_e, true);
}
}
}
}
return nll;
}
inline Logical Logical::operator&&(Logical other) const {
if (isFalse() || other.isFalse()) {
return false;
}
if (isNA() || other.isNA()) {
return NA();
}
return true;
}
/* Give the value of the log-pdf at x. */
Real Cauchy::lpdf( Real const& x) const
{
// check NA value
if (isNA(x)) return Arithmetic<Real>::NA();
// trivial case
if (Arithmetic<Real>::isInfinite(x)) return -Arithmetic<Real>::infinity();
// general case
Real y = (x - mu_) / scale_;
return -Real(std::log( double(Const::_PI_ * scale_ * (1. + y * y)) ));
}
/* Give the value of the pdf at x.*/
Real Cauchy::pdf( Real const& x) const
{
// check NA value
if (isNA(x)) return Arithmetic<Real>::NA();
// trivial case
if (Arithmetic<Real>::isInfinite(x)) return 0.0;
// general case
Real y = (x - mu_) / scale_;
return 1. / (Const::_PI_ * scale_ * (1. + y * y));
}
/*
* The inverse cumulative distribution function at p.
*/
Real Cauchy::icdf( Real const& p, Real const& mu, Real const& scale)
{
// check NA value
if (isNA(p)) return Arithmetic<Real>::NA();
// check parameter
if ((p > 1.) || (p < 0.))
STKDOMAIN_ERROR_1ARG(Cauchy::icdf,p,p must be a probability);
// trivial cases
if (p == 0.) return -Arithmetic<Real>::infinity();
if (p == 1.) return Arithmetic<Real>::infinity();
// general case
// tan(pi * (p - 1/2)) = -cot(pi * p) = -1/tan(pi * p)
return mu - scale / Real(std::tan( double(Const::_PI_ * p) ));
}
/* Give the value of the pdf at x.*/
Real Cauchy::pdf( Real const& x, Real const& mu, Real const& scale)
{
#ifdef STK_DEBUG
// check parameters
if ( !Arithmetic<Real>::isFinite(mu) || !Arithmetic<Real>::isFinite(scale) || scale <= 0)
STKDOMAIN_ERROR_2ARG(Cauchy::pdf,mu, scale,argument error);
#endif
// check NA value
if (isNA(x)) return Arithmetic<Real>::NA();
// trivial case
if (Arithmetic<Real>::isInfinite(x)) return 0.0;
// general case
Real y = (x - mu) / scale;
return 1. / (Const::_PI_ * scale * (1. + y * y));
}
/* The cumulative distribution function at t.
*/
Real Cauchy::cdf( Real const& t, Real const& mu, Real const& scale)
{
// check NA value
if (isNA(t)) return Arithmetic<Real>::NA();
// check parameter
if (Arithmetic<Real>::isInfinite(t))
return (t < 0.) ? 0.0 : 1.0;
/* http://www.faqs.org/faqs/fr/maths/maths-faq-3/
* arctan on [0, 1[:
* if x<0 atan(x)= -atan(-x)
* elseif x>1 atan(x)= Pi/2-atan(1/x).
*/
Real td = (t - mu)/scale;
if (std::abs(td) > 1)
{
Real y = Real(std::atan( 1./double(td))) / Const::_PI_;
return (td > 0) ? (1. - y) : (-y);
}
return 0.5 + Real(std::atan( double(td))) / Const::_PI_;
}
/** @brief NA aware equality operator.
*
* Returns NA if either or both operands are NA. Otherwise returns
* whether or not the two values are equal.
*/
Logical equals(Logical other) const {
return (isNA() || other.isNA()) ? NA() : identical(other);
}
explicit operator double() const { return isNA() ? NA_REAL : m_value; }
// Inline definitions of operators.
inline Logical Logical::operator!() const {
if (isNA()) {
return NA();
}
return Logical(1 - m_value);
}
