static void traverse(scheduler::statement const & statement, scheduler::statement_node const & root_node, Fun const & fun, bool recurse_structurewise_function /* see forwards.h for default argument */){
bool recurse = recurse_structurewise_function || root_node.op.type_subfamily!=scheduler::OPERATION_FUNCTION_TYPE_SUBFAMILY;
fun.call_before_expansion(&root_node);
//Lhs:
if(recurse){
if(root_node.lhs.type_family==scheduler::COMPOSITE_OPERATION_FAMILY)
traverse(statement, statement.array()[root_node.lhs.node_index], fun, recurse_structurewise_function);
if(root_node.lhs.type_family != scheduler::INVALID_TYPE_FAMILY)
fun(&statement, &root_node, LHS_NODE_TYPE);
}
//Self:
fun(&statement, &root_node, PARENT_NODE_TYPE);
//Rhs:
if(recurse){
if(root_node.rhs.type_family==scheduler::COMPOSITE_OPERATION_FAMILY)
traverse(statement, statement.array()[root_node.rhs.node_index], fun, recurse_structurewise_function);
if(root_node.rhs.type_family != scheduler::INVALID_TYPE_FAMILY)
fun(&statement, &root_node, RHS_NODE_TYPE);
}
fun.call_after_expansion(&root_node);
}
int main(int argc, char const *argv[])
{
/* code */
int A[] = {1, 3, 1, 1, 1};
Fun test;
cout << test.mySolution(A, 5, 0) << endl;
return 0;
}
Type objective_function<Type>::operator() ()
{
DATA_VECTOR(times);
DATA_VECTOR(obs);
PARAMETER(log_R0);
PARAMETER(log_a);
PARAMETER(log_theta);
PARAMETER(log_sigma);
Type sigma=exp(log_sigma);
Type theta=exp(log_theta);
Type R0=exp(log_R0);
Type a=exp(log_a)+Type(1e-4);
int n1=times.size();
int n2=2;//mean and variance
matrix<Type> xdist(n1,n2); //Ex and Vx
Type m=(a-Type(1))*R0/times(n1-1);
Type pen;
xdist(0,0)=obs[0];
xdist(0,1)=Type(0);
Type nll=0;
Fun<Type> F;
F.setpars(R0, m, theta, sigma);
CppAD::vector<Type> xi(n2);
xi[1]=Type(0); //Bottinger's code started variance at 0 for all lsoda calls
Type ti;
Type tf;
for(int i=0; i<n1-1; i++)
{
xi[0] = Type(obs[i]);
ti=times[i];
tf=times[i+1];
xdist.row(i+1) = vector<Type>(CppAD::Runge45(F, 1, ti, tf, xi));
xdist(i+1,1)=posfun(xdist(i+1,1), Type(1e-3), pen);//to keep the variance positive
nll-= dnorm(obs[i+1], xdist(i+1,0), sqrt(xdist(i+1,1)), true);
}
nll+=pen; //penalty if the variance is near eps
return nll;
}
int opt_val_hes(
const BaseVector& x ,
const BaseVector& y ,
Fun fun ,
BaseVector& jac ,
BaseVector& hes )
{ // determine the base type
typedef typename BaseVector::value_type Base;
// check that BaseVector is a SimpleVector class with Base elements
CheckSimpleVector<Base, BaseVector>();
// determine the AD vector type
typedef typename Fun::ad_vector ad_vector;
// check that ad_vector is a SimpleVector class with AD<Base> elements
CheckSimpleVector< AD<Base> , ad_vector >();
// size of the x and y spaces
size_t n = size_t(x.size());
size_t m = size_t(y.size());
// number of terms in the summation
size_t ell = fun.ell();
// check size of return values
CPPAD_ASSERT_KNOWN(
size_t(jac.size()) == n || jac.size() == 0,
"opt_val_hes: size of the vector jac is not equal to n or zero"
);
CPPAD_ASSERT_KNOWN(
size_t(hes.size()) == n * n || hes.size() == 0,
"opt_val_hes: size of the vector hes is not equal to n * n or zero"
);
// some temporary indices
size_t i, j, k;
// AD version of S_k(x, y)
ad_vector s_k(1);
// ADFun version of S_k(x, y)
ADFun<Base> S_k;
// AD version of x
ad_vector a_x(n);
// AD version of y
ad_vector a_y(n);
if( jac.size() > 0 )
{ // this is the easy part, computing the V^{(1)} (x) which is equal
// to \partial_x F (x, y) (see Thoerem 2 of the reference).
// copy x and y to AD version
for(j = 0; j < n; j++)
a_x[j] = x[j];
for(j = 0; j < m; j++)
a_y[j] = y[j];
// initialize summation
for(j = 0; j < n; j++)
jac[j] = Base(0.);
// add in \partial_x S_k (x, y)
for(k = 0; k < ell; k++)
{ // start recording
Independent(a_x);
// record
s_k[0] = fun.s(k, a_x, a_y);
// stop recording and store in S_k
S_k.Dependent(a_x, s_k);
// compute partial of S_k with respect to x
BaseVector jac_k = S_k.Jacobian(x);
// add \partial_x S_k (x, y) to jac
for(j = 0; j < n; j++)
jac[j] += jac_k[j];
}
}
// check if we are done
if( hes.size() == 0 )
return 0;
/*
In this case, we need to compute the Hessian. Using Theorem 1 of the
reference:
Y^{(1)}(x) = - F_yy (x, y)^{-1} F_yx (x, y)
Using Theorem 2 of the reference:
V^{(2)}(x) = F_xx (x, y) + F_xy (x, y) Y^{(1)}(x)
*/
// Base and AD version of xy
BaseVector xy(n + m);
ad_vector a_xy(n + m);
for(j = 0; j < n; j++)
a_xy[j] = xy[j] = x[j];
for(j = 0; j < m; j++)
a_xy[n+j] = xy[n+j] = y[j];
// Initialization summation for Hessian of F
size_t nm_sq = (n + m) * (n + m);
BaseVector F_hes(nm_sq);
for(j = 0; j < nm_sq; j++)
F_hes[j] = Base(0.);
BaseVector hes_k(nm_sq);
// add in Hessian of S_k to hes
for(k = 0; k < ell; k++)
{ // start recording
Independent(a_xy);
// split out x
for(j = 0; j < n; j++)
a_x[j] = a_xy[j];
// split out y
for(j = 0; j < m; j++)
a_y[j] = a_xy[n+j];
// record
s_k[0] = fun.s(k, a_x, a_y);
// stop recording and store in S_k
S_k.Dependent(a_xy, s_k);
// when computing the Hessian it pays to optimize the tape
S_k.optimize();
// compute Hessian of S_k
hes_k = S_k.Hessian(xy, 0);
// add \partial_x S_k (x, y) to jac
for(j = 0; j < nm_sq; j++)
F_hes[j] += hes_k[j];
}
// Extract F_yx
BaseVector F_yx(m * n);
for(i = 0; i < m; i++)
{ for(j = 0; j < n; j++)
F_yx[i * n + j] = F_hes[ (i+n)*(n+m) + j ];
}
// Extract F_yy
BaseVector F_yy(n * m);
for(i = 0; i < m; i++)
{ for(j = 0; j < m; j++)
F_yy[i * m + j] = F_hes[ (i+n)*(n+m) + j + n ];
}
// compute - Y^{(1)}(x) = F_yy (x, y)^{-1} F_yx (x, y)
BaseVector neg_Y_x(m * n);
Base logdet;
int signdet = CppAD::LuSolve(m, n, F_yy, F_yx, neg_Y_x, logdet);
if( signdet == 0 )
return signdet;
// compute hes = F_xx (x, y) + F_xy (x, y) Y^{(1)}(x)
for(i = 0; i < n; i++)
{ for(j = 0; j < n; j++)
{ hes[i * n + j] = F_hes[ i*(n+m) + j ];
for(k = 0; k < m; k++)
hes[i*n+j] -= F_hes[i*(n+m) + k+n] * neg_Y_x[k*n+j];
}
}
return signdet;
}
Vector Rosen34(
Fun &F ,
size_t M ,
const Scalar &ti ,
const Scalar &tf ,
const Vector &xi ,
Vector &e )
{
CPPAD_ASSERT_FIRST_CALL_NOT_PARALLEL;
// check numeric type specifications
CheckNumericType<Scalar>();
// check simple vector class specifications
CheckSimpleVector<Scalar, Vector>();
// Parameters for Shampine's Rosenbrock method
// are static to avoid recalculation on each call and
// do not use Vector to avoid possible memory leak
static Scalar a[3] = {
Scalar(0),
Scalar(1),
Scalar(3) / Scalar(5)
};
static Scalar b[2 * 2] = {
Scalar(1),
Scalar(0),
Scalar(24) / Scalar(25),
Scalar(3) / Scalar(25)
};
static Scalar ct[4] = {
Scalar(1) / Scalar(2),
- Scalar(3) / Scalar(2),
Scalar(121) / Scalar(50),
Scalar(29) / Scalar(250)
};
static Scalar cg[3 * 3] = {
- Scalar(4),
Scalar(0),
Scalar(0),
Scalar(186) / Scalar(25),
Scalar(6) / Scalar(5),
Scalar(0),
- Scalar(56) / Scalar(125),
- Scalar(27) / Scalar(125),
- Scalar(1) / Scalar(5)
};
static Scalar d3[3] = {
Scalar(97) / Scalar(108),
Scalar(11) / Scalar(72),
Scalar(25) / Scalar(216)
};
static Scalar d4[4] = {
Scalar(19) / Scalar(18),
Scalar(1) / Scalar(4),
Scalar(25) / Scalar(216),
Scalar(125) / Scalar(216)
};
CPPAD_ASSERT_KNOWN(
M >= 1,
"Error in Rosen34: the number of steps is less than one"
);
CPPAD_ASSERT_KNOWN(
e.size() == xi.size(),
"Error in Rosen34: size of e not equal to size of xi"
);
size_t i, j, k, l, m; // indices
size_t n = xi.size(); // number of components in X(t)
Scalar ns = Scalar(double(M)); // number of steps as Scalar object
Scalar h = (tf - ti) / ns; // step size
Scalar zero = Scalar(0); // some constants
Scalar one = Scalar(1);
Scalar two = Scalar(2);
// permutation vectors needed for LU factorization routine
CppAD::vector<size_t> ip(n), jp(n);
// vectors used to store values returned by F
Vector E(n * n), Eg(n), f_t(n);
Vector g(n * 3), x3(n), x4(n), xf(n), ftmp(n), xtmp(n), nan_vec(n);
// initialize e = 0, nan_vec = nan
for(i = 0; i < n; i++)
{ e[i] = zero;
nan_vec[i] = nan(zero);
}
xf = xi; // initialize solution
for(m = 0; m < M; m++)
{ // time at beginning of this interval
Scalar t = ti * (Scalar(int(M - m)) / ns)
+ tf * (Scalar(int(m)) / ns);
// value of x at beginning of this interval
x3 = x4 = xf;
// evaluate partial derivatives at beginning of this interval
F.Ode_ind(t, xf, f_t);
F.Ode_dep(t, xf, E); // E = f_x
if( hasnan(f_t) || hasnan(E) )
{ e = nan_vec;
return nan_vec;
}
// E = I - f_x * h / 2
for(i = 0; i < n; i++)
{ for(j = 0; j < n; j++)
E[i * n + j] = - E[i * n + j] * h / two;
E[i * n + i] += one;
}
// LU factor the matrix E
# ifndef NDEBUG
int sign = LuFactor(ip, jp, E);
# else
LuFactor(ip, jp, E);
# endif
CPPAD_ASSERT_KNOWN(
sign != 0,
"Error in Rosen34: I - f_x * h / 2 not invertible"
);
// loop over integration steps
for(k = 0; k < 3; k++)
{ // set location for next function evaluation
xtmp = xf;
for(l = 0; l < k; l++)
{ // loop over previous function evaluations
Scalar bkl = b[(k-1)*2 + l];
for(i = 0; i < n; i++)
{ // loop over elements of x
xtmp[i] += bkl * g[i*3 + l] * h;
}
}
// ftmp = F(t + a[k] * h, xtmp)
F.Ode(t + a[k] * h, xtmp, ftmp);
if( hasnan(ftmp) )
{ e = nan_vec;
return nan_vec;
}
// Form Eg for this integration step
for(i = 0; i < n; i++)
Eg[i] = ftmp[i] + ct[k] * f_t[i] * h;
for(l = 0; l < k; l++)
{ for(i = 0; i < n; i++)
Eg[i] += cg[(k-1)*3 + l] * g[i*3 + l];
}
// Solve the equation E * g = Eg
LuInvert(ip, jp, E, Eg);
// save solution and advance x3, x4
for(i = 0; i < n; i++)
{ g[i*3 + k] = Eg[i];
x3[i] += h * d3[k] * Eg[i];
x4[i] += h * d4[k] * Eg[i];
}
}
// Form Eg for last update to x4 only
for(i = 0; i < n; i++)
Eg[i] = ftmp[i] + ct[3] * f_t[i] * h;
for(l = 0; l < 3; l++)
{ for(i = 0; i < n; i++)
Eg[i] += cg[2*3 + l] * g[i*3 + l];
}
// Solve the equation E * g = Eg
LuInvert(ip, jp, E, Eg);
// advance x4 and accumulate error bound
for(i = 0; i < n; i++)
{ x4[i] += h * d4[3] * Eg[i];
// cant use abs because cppad.hpp may not be included
Scalar diff = x4[i] - x3[i];
if( diff < zero )
e[i] -= diff;
else e[i] += diff;
}
// advance xf for this step using x4
xf = x4;
}
return xf;
}
void BenderQuad(
const BAvector &x ,
const BAvector &y ,
Fun fun ,
BAvector &g ,
BAvector &gx ,
BAvector &gxx )
{ // determine the base type
typedef typename BAvector::value_type Base;
// check that BAvector is a SimpleVector class
CheckSimpleVector<Base, BAvector>();
// declare the ADvector type
typedef CPPAD_TESTVECTOR(AD<Base>) ADvector;
// size of the x and y spaces
size_t n = size_t(x.size());
size_t m = size_t(y.size());
// check the size of gx and gxx
CPPAD_ASSERT_KNOWN(
g.size() == 1,
"BenderQuad: size of the vector g is not equal to 1"
);
CPPAD_ASSERT_KNOWN(
size_t(gx.size()) == n,
"BenderQuad: size of the vector gx is not equal to n"
);
CPPAD_ASSERT_KNOWN(
size_t(gxx.size()) == n * n,
"BenderQuad: size of the vector gxx is not equal to n * n"
);
// some temporary indices
size_t i, j;
// variable versions x
ADvector vx(n);
for(j = 0; j < n; j++)
vx[j] = x[j];
// declare the independent variables
Independent(vx);
// evaluate h = H(x, y)
ADvector h(m);
h = fun.h(vx, y);
// evaluate dy (x) = Newton step as a function of x through h only
ADvector dy(m);
dy = fun.dy(x, y, h);
// variable version of y
ADvector vy(m);
for(j = 0; j < m; j++)
vy[j] = y[j] + dy[j];
// evaluate G~ (x) = F [ x , y + dy(x) ]
ADvector gtilde(1);
gtilde = fun.f(vx, vy);
// AD function object that corresponds to G~ (x)
// We will make heavy use of this tape, so optimize it
ADFun<Base> Gtilde;
Gtilde.Dependent(vx, gtilde);
Gtilde.optimize();
// value of G(x)
g = Gtilde.Forward(0, x);
// initial forward direction vector as zero
BAvector dx(n);
for(j = 0; j < n; j++)
dx[j] = Base(0);
// weight, first and second order derivative values
BAvector dg(1), w(1), ddw(2 * n);
w[0] = 1.;
// Jacobian and Hessian of G(x) is equal Jacobian and Hessian of Gtilde
for(j = 0; j < n; j++)
{ // compute partials in x[j] direction
dx[j] = Base(1);
dg = Gtilde.Forward(1, dx);
gx[j] = dg[0];
// restore the dx vector to zero
dx[j] = Base(0);
// compute second partials w.r.t x[j] and x[l] for l = 1, n
ddw = Gtilde.Reverse(2, w);
for(i = 0; i < n; i++)
gxx[ i * n + j ] = ddw[ i * 2 + 1 ];
}
return;
}
Vector Runge45(
Fun &F ,
size_t M ,
const Scalar &ti ,
const Scalar &tf ,
const Vector &xi ,
Vector &e )
{
CPPAD_ASSERT_FIRST_CALL_NOT_PARALLEL;
// check numeric type specifications
CheckNumericType<Scalar>();
// check simple vector class specifications
CheckSimpleVector<Scalar, Vector>();
// Cash-Karp parameters for embedded Runge-Kutta method
// are static to avoid recalculation on each call and
// do not use Vector to avoid possible memory leak
static Scalar a[6] = {
Scalar(0),
Scalar(1) / Scalar(5),
Scalar(3) / Scalar(10),
Scalar(3) / Scalar(5),
Scalar(1),
Scalar(7) / Scalar(8)
};
static Scalar b[5 * 5] = {
Scalar(1) / Scalar(5),
Scalar(0),
Scalar(0),
Scalar(0),
Scalar(0),
Scalar(3) / Scalar(40),
Scalar(9) / Scalar(40),
Scalar(0),
Scalar(0),
Scalar(0),
Scalar(3) / Scalar(10),
-Scalar(9) / Scalar(10),
Scalar(6) / Scalar(5),
Scalar(0),
Scalar(0),
-Scalar(11) / Scalar(54),
Scalar(5) / Scalar(2),
-Scalar(70) / Scalar(27),
Scalar(35) / Scalar(27),
Scalar(0),
Scalar(1631) / Scalar(55296),
Scalar(175) / Scalar(512),
Scalar(575) / Scalar(13824),
Scalar(44275) / Scalar(110592),
Scalar(253) / Scalar(4096)
};
static Scalar c4[6] = {
Scalar(2825) / Scalar(27648),
Scalar(0),
Scalar(18575) / Scalar(48384),
Scalar(13525) / Scalar(55296),
Scalar(277) / Scalar(14336),
Scalar(1) / Scalar(4),
};
static Scalar c5[6] = {
Scalar(37) / Scalar(378),
Scalar(0),
Scalar(250) / Scalar(621),
Scalar(125) / Scalar(594),
Scalar(0),
Scalar(512) / Scalar(1771)
};
CPPAD_ASSERT_KNOWN(
M >= 1,
"Error in Runge45: the number of steps is less than one"
);
CPPAD_ASSERT_KNOWN(
e.size() == xi.size(),
"Error in Runge45: size of e not equal to size of xi"
);
size_t i, j, k, m; // indices
size_t n = xi.size(); // number of components in X(t)
Scalar ns = Scalar(int(M)); // number of steps as Scalar object
Scalar h = (tf - ti) / ns; // step size
Scalar zero_or_nan = Scalar(0); // zero (nan if Ode returns has a nan)
for(i = 0; i < n; i++) // initialize e = 0
e[i] = zero_or_nan;
// vectors used to store values returned by F
Vector fh(6 * n), xtmp(n), ftmp(n), x4(n), x5(n), xf(n);
xf = xi; // initialize solution
for(m = 0; m < M; m++)
{ // time at beginning of this interval
// (convert to int to avoid MS compiler warning)
Scalar t = ti * (Scalar(int(M - m)) / ns)
+ tf * (Scalar(int(m)) / ns);
// loop over integration steps
x4 = x5 = xf; // start x4 and x5 at same point for each step
for(j = 0; j < 6; j++)
{ // loop over function evaluations for this step
xtmp = xf; // location for next function evaluation
for(k = 0; k < j; k++)
{ // loop over previous function evaluations
Scalar bjk = b[ (j-1) * 5 + k ];
for(i = 0; i < n; i++)
{ // loop over elements of x
xtmp[i] += bjk * fh[i * 6 + k];
}
}
// ftmp = F(t + a[j] * h, xtmp)
F.Ode(t + a[j] * h, xtmp, ftmp);
// if ftmp has a nan, set zero_or_nan to nan
for(i = 0; i < n; i++)
zero_or_nan *= ftmp[i];
for(i = 0; i < n; i++)
{ // loop over elements of x
Scalar fhi = ftmp[i] * h;
fh[i * 6 + j] = fhi;
x4[i] += c4[j] * fhi;
x5[i] += c5[j] * fhi;
x5[i] += zero_or_nan;
}
}
// accumulate error bound
for(i = 0; i < n; i++)
{ // cant use abs because cppad.hpp may not be included
Scalar diff = x5[i] - x4[i];
e[i] += fabs(diff);
e[i] += zero_or_nan;
}
// advance xf for this step using x5
xf = x5;
}
return xf;
}
void OdeGear(
Fun &F ,
size_t m ,
size_t n ,
const Vector &T ,
Vector &X ,
Vector &e )
{
// temporary indices
size_t i, j, k;
typedef typename Vector::value_type Scalar;
// check numeric type specifications
CheckNumericType<Scalar>();
// check simple vector class specifications
CheckSimpleVector<Scalar, Vector>();
CPPAD_ASSERT_KNOWN(
m >= 1,
"OdeGear: m is less than one"
);
CPPAD_ASSERT_KNOWN(
n > 0,
"OdeGear: n is equal to zero"
);
CPPAD_ASSERT_KNOWN(
size_t(T.size()) >= (m+1),
"OdeGear: size of T is not greater than or equal (m+1)"
);
CPPAD_ASSERT_KNOWN(
size_t(X.size()) >= (m+1) * n,
"OdeGear: size of X is not greater than or equal (m+1) * n"
);
for(j = 0; j < m; j++) CPPAD_ASSERT_KNOWN(
T[j] < T[j+1],
"OdeGear: the array T is not monotone increasing"
);
// some constants
Scalar zero(0);
Scalar one(1);
// vectors required by method
Vector alpha(m + 1);
Vector beta(m + 1);
Vector f(n);
Vector f_x(n * n);
Vector x_m0(n);
Vector x_m(n);
Vector b(n);
Vector A(n * n);
// compute alpha[m]
alpha[m] = zero;
for(k = 0; k < m; k++)
alpha[m] += one / (T[m] - T[k]);
// compute beta[m-1]
beta[m-1] = one / (T[m-1] - T[m]);
for(k = 0; k < m-1; k++)
beta[m-1] += one / (T[m-1] - T[k]);
// compute other components of alpha
for(j = 0; j < m; j++)
{ // compute alpha[j]
alpha[j] = one / (T[j] - T[m]);
for(k = 0; k < m; k++)
{ if( k != j )
{ alpha[j] *= (T[m] - T[k]);
alpha[j] /= (T[j] - T[k]);
}
}
}
// compute other components of beta
for(j = 0; j <= m; j++)
{ if( j != m-1 )
{ // compute beta[j]
beta[j] = one / (T[j] - T[m-1]);
for(k = 0; k <= m; k++)
{ if( k != j && k != m-1 )
{ beta[j] *= (T[m-1] - T[k]);
beta[j] /= (T[j] - T[k]);
}
}
}
}
// evaluate f(T[m-1], x_{m-1} )
for(i = 0; i < n; i++)
x_m[i] = X[(m-1) * n + i];
F.Ode(T[m-1], x_m, f);
// solve for x_m^0
for(i = 0; i < n; i++)
{ x_m[i] = f[i];
for(j = 0; j < m; j++)
x_m[i] -= beta[j] * X[j * n + i];
x_m[i] /= beta[m];
}
x_m0 = x_m;
// evaluate partial w.r.t x of f(T[m], x_m^0)
F.Ode_dep(T[m], x_m, f_x);
// compute the matrix A = ( alpha[m] * I - f_x )
for(i = 0; i < n; i++)
{ for(j = 0; j < n; j++)
A[i * n + j] = - f_x[i * n + j];
A[i * n + i] += alpha[m];
}
// LU factor (and overwrite) the matrix A
int sign;
CppAD::vector<size_t> ip(n) , jp(n);
sign = LuFactor(ip, jp, A);
CPPAD_ASSERT_KNOWN(
sign != 0,
"OdeGear: step size is to large"
);
// Iterations of Newton's method
for(k = 0; k < 3; k++)
{
// only evaluate f( T[m] , x_m ) keep f_x during iteration
F.Ode(T[m], x_m, f);
// b = f + f_x x_m - alpha[0] x_0 - ... - alpha[m-1] x_{m-1}
for(i = 0; i < n; i++)
{ b[i] = f[i];
for(j = 0; j < n; j++)
b[i] -= f_x[i * n + j] * x_m[j];
for(j = 0; j < m; j++)
b[i] -= alpha[j] * X[ j * n + i ];
}
LuInvert(ip, jp, A, b);
x_m = b;
}
// return estimate for x( t[k] ) and the estimated error bound
for(i = 0; i < n; i++)
{ X[m * n + i] = x_m[i];
e[i] = x_m[i] - x_m0[i];
if( e[i] < zero )
e[i] = - e[i];
}
}
