R/RcppExports.R

In fintzij/stemr: Stochastic Epidemic Model Simulation and Estimation

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Evaluate the log-density of the measurement process by calling measurement
#' process density functions via external Xptr.
#'
#' @param emitmat matrix of emission probabilities
#' @param emit_inds logical vector of measurement compartments to simulate
#' @param record_ind row in the observation and emission matrices
#' @param record vector of observed counts
#' @param state numeric vector of latent comaprtment counts
#' @param parameters numeric vector of parameter values
#' @param constants numeric vector of constants
#' @param tcovar numeric vector of time-varying covariate values
#' @param d_meas_ptr external pointer to measurement process simulation function
#'
#' @export
CALL_D_MEASURE <- function(emitmat, emit_inds, record_ind, record, state, parameters, constants, tcovar, d_meas_ptr) {
    invisible(.Call(`_stemr_CALL_D_MEASURE`, emitmat, emit_inds, record_ind, record, state, parameters, constants, tcovar, d_meas_ptr))
}

#' Integrate a system of ODEs via external Xptr.
#'
#' @param init initial condition
#' @param start time at left endpoint of interval
#' @param end time at right endpoint
#' @param step_size set automatically by caller, required argument not specified by user
#' @param stem_ode_ptr external pointer for calling the ODE integrator
#'
#' @export
CALL_INTEGRATE_STEM_ODE <- function(init, start, end, step_size, stem_ode_ptr) {
    invisible(.Call(`_stemr_CALL_INTEGRATE_STEM_ODE`, init, start, end, step_size, stem_ode_ptr))
}

#' Update rates by calling rate functions via Xptr.
#'
#' @param rates vector of rates to be modified
#' @param inds logical vector of indices of rates to be modified
#' @param state numeric vector of comaprtment counts
#' @param parameters numeric vector of parameter values
#' @param constants numeric vector of constants
#' @param tcovar numeric vector of time-varying covariate values
#' @param rate_ptr external pointer to rate function
#'
#' @export
CALL_RATE_FCN <- function(rates, inds, state, parameters, constants, tcovar, rate_ptr) {
    invisible(.Call(`_stemr_CALL_RATE_FCN`, rates, inds, state, parameters, constants, tcovar, rate_ptr))
}

#' Simulate from the measurement process by calling measurement process
#' functions via external Xptr.
#'
#' @param obsmat observation matrix
#' @param emit_inds logical vector of measurement compartments to simulate
#' @param record_ind row in the observation matrix
#' @param state numeric vector of comaprtment counts
#' @param parameters numeric vector of parameter values
#' @param constants numeric vector of constants
#' @param tcovar numeric vector of time-varying covariate values
#' @param r_meas_ptr external pointer to measurement process simulation function
#'
#' @export
CALL_R_MEASURE <- function(obsmat, emit_inds, record_ind, state, parameters, constants, tcovar, r_meas_ptr) {
    invisible(.Call(`_stemr_CALL_R_MEASURE`, obsmat, emit_inds, record_ind, state, parameters, constants, tcovar, r_meas_ptr))
}

#' Set the parameters for a system of ODEs via XPtr.
#'
#' @param p vector of parameters
#' @param set_ode_params_ptr external pointer to the ODE parameter setting function.
#'
#' @export
CALL_SET_ODE_PARAMS <- function(p, set_ode_params_ptr) {
    invisible(.Call(`_stemr_CALL_SET_ODE_PARAMS`, p, set_ode_params_ptr))
}

#' Construct a matrix containing the compartment counts at a sequence of census times.
#'
#' @param path matrix containing the path to be censused.
#' @param census_times vector of census times.
#' @param census_columns vector of column indices to be censused (C++ indexing
#'   beginning at 0).
#'
#' @return matrix containing the compartment counts at census times.
#' @export
build_census_path <- function(path, census_times, census_columns) {
    .Call(`_stemr_build_census_path`, path, census_times, census_columns)
}

#' Construct a matrix containing the incidence counts at a sequence of census times.
#'
#' @param incid_mat matrix with incidence counts
#' @param census_times vector of census times
#' @param interval_inds interval indices, generated by a call to findInterval with left.open=T
#'
#' @return matrix containing the incidence counts at census times.
#' @export
census_incidence <- function(incid_mat, census_times, interval_inds) {
    .Call(`_stemr_census_incidence`, incid_mat, census_times, interval_inds)
}

#' Construct a matrix containing the compartment counts and the incidence at a sequence of census times.
#'
#' @param path matrix containing the path to be censused (cumulative incidence).
#' @param census_path matrix to be filled out with the path.
#' @param census_inds vector of indices for census interval endpoints.
#' @param event_inds vector of column indices in the path matrix for events that
#'   should be censused.
#' @param flow_matrix matrix containing the flow matrix for the LNA (no incidence)
#' @param do_prevalence should the prevalence be computed
#' @param init_state the initial compartment counts
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param parmat matrix with parameters, constants, and time varying
#'   covariates and parameters.
#'
#' @return matrix containing the compartment counts at census times.
#' @export
census_latent_path <- function(path, census_path, census_inds, event_inds, flow_matrix, do_prevalence, parmat, initdist_inds, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, row0 = 0L) {
    invisible(.Call(`_stemr_census_latent_path`, path, census_path, census_inds, event_inds, flow_matrix, do_prevalence, parmat, initdist_inds, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, row0))
}

#' Difference an incidence variable in a census matrix.
#'
#' @param censusmat matrix of compartment counts at census times, to be updated
#' @param col_inds column indices for which incidence should be computed
#' @param row_inds list of vectors of row indices for each of the incidence variables
#'
#'
#' @return update the census matrix in place
#' @export
compute_incidence <- function(censusmat, col_inds, row_inds) {
    invisible(.Call(`_stemr_compute_incidence`, censusmat, col_inds, row_inds))
}

#' Convert an LNA path from the counting process on transition events to the
#' compartment densities on their natural scale, making the conversion in place
#' for an existing census matrix.
#'
#' @param path matrix containing the LNA path in terms of the counting
#'   processes on transition events
#' @param flow_matrix stoichiometry matrix (the transpose of the flow matrix)
#' @param init_state initial compartment counts on the natural scale
#' @param statemat matrix where the compartment counts should be written
#'
#' The process can be re-expressed by left-multiplying each row in the path
#' matrix by the stoichiometry matrix: \eqn{X_t = A'\phi(t, N_t)}.
#'
#' @export
convert_lna2 <- function(path, flow_matrix, init_state, statemat) {
    invisible(.Call(`_stemr_convert_lna2`, path, flow_matrix, init_state, statemat))
}

#' Insert parameters into each row of a parameter matrix
#'
#' @param lnapars matrix of lna parameters, constants, and time-varying covars
#' @param parameters vector of parameters to be copied into the matrix
#'
#' @return modifies the lna parameter matrix in place
#' @export
pars2lnapars <- function(lnapars, parameters) {
    invisible(.Call(`_stemr_pars2lnapars`, lnapars, parameters))
}

#' Insert parameters into the first row of a parameter matrix
#'
#' @param lnapars matrix of lna/ode parameters, constants, and time-varying covars
#' @param parameters vector of parameters to be copied into the matrix
#' @param c_start index of the initial column
#'
#' @return modifies the lna parameter matrix in place
#' @export
pars2lnapars2 <- function(lnapars, parameters, c_start) {
    invisible(.Call(`_stemr_pars2lnapars2`, lnapars, parameters, c_start))
}

#' Insert parameters into the first row of a parameter matrix
#' 
#' @param parmat parameter matrics
#' @param pars vector of parameters to insert
#' @param colinds vector of column indices
#' @param rowinds vector of row indices, just the first row by default.
#' 
#' @return modifies the parameter matrix in place
#' @export
pars2parmat <- function(parmat, pars, colinds, rowind = 0L) {
    invisible(.Call(`_stemr_pars2parmat`, parmat, pars, colinds, rowind))
}

#' insert an element into a vector
#'
#' @param dest destination row vector
#' @param orig elem
#' @param ind C++ style index for the element to be copied
#'
#' @return copy an element of one row vector into another.
#' @export
insert_elem <- function(dest, elem, ind) {
    invisible(.Call(`_stemr_insert_elem`, dest, elem, ind))
}

#' Copy an element from one vector into another
#'
#' @param dest destination row vector
#' @param orig origin row vector
#' @param ind C++ style index for the element to be copied
#'
#' @return copy an element of one row vector into another.
#' @export
copy_elem <- function(dest, orig, ind) {
    invisible(.Call(`_stemr_copy_elem`, dest, orig, ind))
}

#' Copy an multiple elements from one vector into another
#'
#' @param dest destination row vector
#' @param orig origin row vector
#' @param ind C++ style index for the element to be copied
#'
#' @return copy an element of one row vector into another.
#' @export
copy_elem2 <- function(dest, orig, inds) {
    invisible(.Call(`_stemr_copy_elem2`, dest, orig, inds))
}

#' Increment an element of a vector by 1
#'
#' @param vec destination row vector
#' @param ind C++ style index for the element to be copied
#'
#' @return Add 1 to an element of a vector
#' @export
increment_elem <- function(vec, ind) {
    invisible(.Call(`_stemr_increment_elem`, vec, ind))
}

#' Copy the contents of one vector into another
#'
#' @param dest destination row vector
#' @param orig origin row vector
#'
#' @return copy the elements of one row vector into another.
#' @export
copy_vec <- function(dest, orig) {
    invisible(.Call(`_stemr_copy_vec`, dest, orig))
}

#' Copy the contents of one vector into another
#'
#' @param dest destination row vector
#' @param orig origin row vector
#' @param inds vector of indices in the destination
#'
#' @return copy the elements of one row vector into another.
#' @export
copy_vec2 <- function(dest, orig, inds) {
    invisible(.Call(`_stemr_copy_vec2`, dest, orig, inds))
}

#' Copy the contents of one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#'
#' @return copy the elements of one matrix into another.
#' @export
copy_mat <- function(dest, orig) {
    invisible(.Call(`_stemr_copy_mat`, dest, orig))
}

#' Insert one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#' @param rowinds vector of row indices
#' @param colinds vector of column indices
#'
#' @return copy the elements of one matrix into another.
#' @export
insert_block <- function(dest, orig, rowinds, colinds) {
    invisible(.Call(`_stemr_insert_block`, dest, orig, rowinds, colinds))
}

#' Copy the contents of one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#' @param ind column index
#'
#' @return copy the elements of one matrix into another.
#' @export
copy_col <- function(dest, orig, ind) {
    invisible(.Call(`_stemr_copy_col`, dest, orig, ind))
}

#' Copy the contents of one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#' @param ind row index
#'
#' @return copy the elements of one matrix into another.
#' @export
copy_row <- function(dest, orig, ind) {
    invisible(.Call(`_stemr_copy_row`, dest, orig, ind))
}

#' Copy the columns of one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#' @param ind column index
#'
#' @return copy the elements of one matrix into another.
#' @export
copy_pathmat <- function(dest, orig) {
    invisible(.Call(`_stemr_copy_pathmat`, dest, orig))
}

#' Copy some of the rows of one matrix into another
#'
#' @param dest destination matrix
#' @param orig origin matrix
#' @param inds row indices
#'
#' @return copy the elements of one matrix into another.
#' @export
copy_2_rows <- function(dest, orig, inds) {
    invisible(.Call(`_stemr_copy_2_rows`, dest, orig, inds))
}

#' Copy a matrix into a slice of an array
#'
#' @param dest array into which to copy
#' @param orig matrix to copy
#' @param ind slice index (C++)
#'
#' @return copy a matrix into an array.
#' @export
mat_2_arr <- function(dest, orig, ind) {
    invisible(.Call(`_stemr_mat_2_arr`, dest, orig, ind))
}

#' Copy a matrix into a column of a slice of an array
#'
#' @param dest array into which to copy
#' @param orig matrix to copy
#' @param col_ind column index (C++)
#' @param slice_ind slice index (C++)
#'
#' @return copy a matrix into an array.
#' @export
vec_2_arr <- function(dest, orig, col_ind, slice_ind) {
    invisible(.Call(`_stemr_vec_2_arr`, dest, orig, col_ind, slice_ind))
}

#' Copy a vector into a matrix
#'
#' @param dest array into which to copy
#' @param orig matrix to copy
#' @param ind column index (C++)
#'
#' @return copy a matrix into an array.
#' @export
vec_2_mat <- function(dest, orig, ind) {
    invisible(.Call(`_stemr_vec_2_mat`, dest, orig, ind))
}

#' Reset a vector by filling it with an element
#'
#' @param v vector to fill with zeros
#' @param value to insert
#'
#' @return reset vector in place
#' @export
reset_vec <- function(v, value = 0) {
    invisible(.Call(`_stemr_reset_vec`, v, value))
}

#' Add the contents of one vector to another vector
#'
#' @param dest target vector
#' @param orig vector to be added
#' @param indices in the target
#'
#' @return add the elements of one row vector to another.
#' @export
add2vec <- function(target, increments, inds) {
    invisible(.Call(`_stemr_add2vec`, target, increments, inds))
}

#' Add one vector to another
#'
#' @param dest target vector
#' @param orig vector to be added
#'
#' @return add the elements of one row vector to another.
#' @export
increment_vec <- function(target, increments) {
    invisible(.Call(`_stemr_increment_vec`, target, increments))
}

#' Draw new N(0,1) values and fill a vector.
#'
#' @param v vector to fill with new N(0,1) draws
#'
#' @return draw new values in place
#' @export
draw_normals <- function(v) {
    invisible(.Call(`_stemr_draw_normals`, v))
}

#' Draw new N(0,1) values and fill a matrix.
#'
#' @param M matrix to fill with new N(0,1) draws
#'
#' @return draw new values in place
#' @export
draw_normals2 <- function(M) {
    invisible(.Call(`_stemr_draw_normals2`, M))
}

#' Sample the unit sphere.
#'
#' @param v vector to fill with a vector of draws on the unit sphere
#'
#' @return draw new values in place
#' @export
sample_unit_sphere <- function(v) {
    invisible(.Call(`_stemr_sample_unit_sphere`, v))
}

#' Evaluate the log-density of the measurement process by calling measurement
#' process density functions via external Xptr.
#'
#' @param emitmat matrix of emission probabilities
#' @param obsmat matrix containing the data
#' @param statemat matrix containing the compartment counts at the observation
#'   times
#' @param measproc_indmat logical matrix indicating which compartments are
#'   observed at every observation time
#' @param parameters numeric vector of parameter values
#' @param constants numeric vector of constants
#' @param tcovar_censusmat numeric vector of time-varying covariate values
#' @param d_meas_ptr external pointer to measurement process density function
#'
#' @export
evaluate_d_measure <- function(emitmat, obsmat, statemat, measproc_indmat, parameters, constants, tcovar_censusmat, d_meas_ptr) {
    invisible(.Call(`_stemr_evaluate_d_measure`, emitmat, obsmat, statemat, measproc_indmat, parameters, constants, tcovar_censusmat, d_meas_ptr))
}

#' Evaluate the log-density of a possibly time-verying measurement process
#' by calling measurement process density functions via external Xptr.
#'
#' @param emitmat matrix of emission probabilities
#' @param obsmat matrix containing the data
#' @param censusmat matrix containing the state of the latent process at
#'   observation times
#' @param measproc_indmat logical matrix indicating which compartments are
#'   observed at every observation time
#' @param parameters matrix containing the LNA parameters, constants and
#'   time-varying coariates.
#' @param param_vec container for storing the LNA parameters at each
#'   observation time.
#' @param param_inds indices for the model parameters.
#' @param const_inds indices for the constants.
#' @param tcovar_inds indices for the time-varying covariates.
#' @param param_update_inds logical vector indicating when model parameters
#'   should be updated.
#' @param census_indices vector of indices when the LNA path has been censused.
#' @param param_vec vector for keeping the current lna parameters
#' @param d_meas_ptr external pointer to measurement process density function
#'
#' @export
evaluate_d_measure_LNA <- function(emitmat, obsmat, censusmat, measproc_indmat, parameters, param_inds, const_inds, tcovar_inds, param_update_inds, census_indices, param_vec, d_meas_ptr) {
    invisible(.Call(`_stemr_evaluate_d_measure_LNA`, emitmat, obsmat, censusmat, measproc_indmat, parameters, param_inds, const_inds, tcovar_inds, param_update_inds, census_indices, param_vec, d_meas_ptr))
}

#' Given a vector of interval endpoints \code{breaks}, determine in which
#' intervals the elements of a vector \code{x} fall.
#'
#' @param x vector for whose elements the corresponding intervals are
#'   identified
#' @param breaks vector containing the elements
#' @param rightmost_closed logical; if true, the results for x[j]=breaks[N] is
#'   N-1.
#' @param all_inside logical; if true, 0 is mapped to 1, and N is mapped to N-1
#'
#' The rightmost interval is assumed to be closed. Compares to the behavior of
#' the \code{findInterval} function in \code{R}, when \code{rightmost.closed =
#'  TRUE}
#'
#' @return matrix containing the compartment counts at census times.
#' @export
find_interval <- function(x, breaks, rightmost_closed, all_inside) {
    .Call(`_stemr_find_interval`, x, breaks, rightmost_closed, all_inside)
}

#' Insert time-varying parameters into a tcovar matrix.
#'
#' @param tcovar matrix into which the parameter values should be copied
#' @param values vector of values that should be copied in
#' @param col_ind C++ index for the column where the values should go
#' @param tpar_inds C++ indices for the vector elements that go in each row
#'
#' @return copy the values in place
#' @export
insert_tparam <- function(tcovar, values, col_ind, tpar_inds) {
    invisible(.Call(`_stemr_insert_tparam`, tcovar, values, col_ind, tpar_inds))
}

#' Obtain the path of the deterministic mean of a stochastic epidemic model by
#' integrating the corresponding ODE functions.
#'
#' @param ode_times vector of interval endpoint times
#' @param ode_pars numeric matrix of parameters, constants, and time-varying
#'   covariates at each of the ode_times
#' @param init_start index in the parameter vector where the initial compartment
#'   volumes start
#' @param param_update_inds logical vector indicating at which of the times the
#'   ode parameters need to be updated.
#' @param stoich_matrix stoichiometry matrix giving the changes to compartments
#'   from each reaction
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param step_size initial step size for the ODE solver (adapted internally,
#' but too large of an initial step can lead to failure in stiff systems).
#' @param ode_pointer external pointer to ode integration function.
#' @param set_pars_pointer external pointer to the function for setting the ode
#'   parameters.
#'
#' @return List containing the ODE incidence and prevalence paths.
#'
#' @export
integrate_odes <- function(ode_times, ode_pars, ode_param_inds, ode_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, step_size, ode_pointer, set_pars_pointer) {
    .Call(`_stemr_integrate_odes`, ode_times, ode_pars, ode_param_inds, ode_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, step_size, ode_pointer, set_pars_pointer)
}

#' Convert an LNA path from the counting process on transition events to the
#' compartment densities on their natural scale.
#'
#' @param path matrix containing the LNA path in terms of the counting
#'   processes on transition events (incidence)
#' @param flow_matrix stoichiometry matrix (the transpose of the flow matrix)
#' @param init_state initial compartment counts on the natural scale
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#'
#' The process can be re-expressed by left-multiplying each row in the path
#' matrix by the stoichiometry matrix: \eqn{X_t = X_0 + A'N_t}.
#'
#' @export
lna_incid2prev <- function(path, flow_matrix, init_state, forcing_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers) {
    .Call(`_stemr_lna_incid2prev`, path, flow_matrix, init_state, forcing_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers)
}

#' Map N(0,1) stochastic perturbations to an LNA path.
#'
#' @param pathmat matrix where the LNA path should be stored
#' @param draws matrix of N(0,1) draws to be mapped to an LNA path
#' @param lna_times vector of interval endpoint times
#' @param lna_pars numeric matrix of parameters, constants, and time-varying
#'   covariates at each of the lna_times
#' @param init_start index in the parameter vector where the initial compartment
#'   volumes start
#' @param param_update_inds logical vector indicating at which of the times the
#'   LNA parameters need to be updated.
#' @param stoich_matrix stoichiometry matrix giving the changes to compartments
#'   from each reaction
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#' @param svd_d vector in which to store SVD singular values
#' @param svd_U matrix in which to store the U matrix of the SVD
#' @param svd_V matrix in which to store the V matrix of the SVD
#' @param step_size initial step size for the ODE solver (adapted internally,
#' but too large of an initial step can lead to failure in stiff systems).
#' @param lna_pointer external pointer to LNA integration function.
#' @param set_pars_pointer external pointer to the function for setting the LNA
#'   parameters.
#'
#' @return fill out pathmat with the LNA path corresponding to the stochastic
#'   perturbations.
#'
#' @export
map_draws_2_lna <- function(pathmat, draws, lna_times, lna_pars, lna_param_vec, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, svd_d, svd_U, svd_V, step_size, lna_pointer, set_pars_pointer) {
    invisible(.Call(`_stemr_map_draws_2_lna`, pathmat, draws, lna_times, lna_pars, lna_param_vec, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, svd_d, svd_U, svd_V, step_size, lna_pointer, set_pars_pointer))
}

#' Map parameters to the deterministic mean incidence increments for a stochastic
#' epidemic model.
#'
#' @param pathmat matrix where the ODE path should be stored
#' @param ode_times vector of interval endpoint times
#' @param ode_pars numeric matrix of parameters, constants, and time-varying
#'   covariates at each of the ode_times
#' @param init_start index in the parameter vector where the initial compartment
#'   volumes start
#' @param param_update_inds logical vector indicating at which of the times the
#'   ode parameters need to be updated.
#' @param stoich_matrix stoichiometry matrix giving the changes to compartments
#'   from each reaction
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#' @param step_size initial step size for the ODE solver (adapted internally,
#' but too large of an initial step can lead to failure in stiff systems).
#' @param ode_pointer external pointer to ode integration function.
#' @param set_pars_pointer external pointer to the function for setting the ode
#'   parameters.
#'
#' @return List containing the ODE incidence and prevalence paths.
#'
#' @export
map_pars_2_ode <- function(pathmat, ode_times, ode_pars, ode_param_vec, ode_param_inds, ode_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, step_size, ode_pointer, set_pars_pointer) {
    invisible(.Call(`_stemr_map_pars_2_ode`, pathmat, ode_times, ode_pars, ode_param_vec, ode_param_inds, ode_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, step_size, ode_pointer, set_pars_pointer))
}

#' Cholesky decomposition
#'
#' @param C matrix to be filled out with the cholesky of M
#' @param M symmetric positive definite matrix for which the upper triangle of the cholesky 
#'   is to be computed
#' @param nugget small positive constant to be added to the diagonal for numerical stability
#' 
#' @return set C equal to the matrix square root of M 
#' @export
comp_chol <- function(C, M) {
    invisible(.Call(`_stemr_comp_chol`, C, M))
}

#' Produce samples from a multivariate normal density using the Cholesky
#' decomposition
#'
#' @param n number of samples
#' @param mu mean vector
#' @param sigma covariance matrix
#'
#' (source: http://gallery.rcpp.org/articles/simulate-multivariate-normal/)
#'
#' @export
rmvtn <- function(n, mu, sigma) {
    .Call(`_stemr_rmvtn`, n, mu, sigma)
}

#' Multivariate normal density
#'
#' @param x matrix of draws for which to evaluate the density
#' @param mu mean vector of the distribution
#' @param sigma covariance matrix
#' @param logd should the log be returned
#'
#' (source: http://gallery.rcpp.org/articles/dmvnorm_arma/)
#'
#' @export
dmvtn <- function(x, mu, sigma, logd = FALSE) {
    .Call(`_stemr_dmvtn`, x, mu, sigma, logd)
}

#' normalise a vector in place
#'
#' @param v vector to be normalised
#' @param p norm
#' 
#' @return normalise vector in place
#' @export
normalise <- function(v, p) {
    invisible(.Call(`_stemr_normalise`, v, p))
}

#' return a normalised vector
#'
#' @param v vector to be normalised
#' @param p norm
#' 
#' @return normalised vector 
#' @export
normalise2 <- function(v, p) {
    .Call(`_stemr_normalise2`, v, p)
}

#' Simulate an LNA path using a non-centered parameterization for the
#' log-transformed counting process LNA.
#'
#' @param lna_times vector of interval endpoint times
#' @param lna_draws vector of N(0,1) draws to be mapped to the path
#' @param lna_pars numeric matrix of parameters, constants, and time-varying
#'   covariates at each of the lna_times
#' @param init_start index in the parameter vector where the initial compartment
#'   volumes start
#' @param param_update_inds logical vector indicating at which of the times the
#'   LNA parameters need to be updated.
#' @param stoich_matrix stoichiometry matrix giving the changes to compartments
#'   from each reaction
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#' @param max_attempts maximum number of tries if the first increment is rejected
#' @param step_size initial step size for the ODE solver (adapted internally,
#' but too large of an initial step can lead to failure in stiff systems).
#' @param lna_pointer external pointer to the compiled LNA integration function.
#' @param set_pars_pointer external pointer to the function for setting LNA pars.
#' @return list containing the stochastic perturbations (i.i.d. N(0,1) draws) and
#' the LNA path on its natural scale which is determined by the perturbations.
#'
#' @export
propose_lna <- function(lna_times, lna_draws, lna_pars, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, max_attempts, step_size, lna_pointer, set_pars_pointer) {
    .Call(`_stemr_propose_lna`, lna_times, lna_draws, lna_pars, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, max_attempts, step_size, lna_pointer, set_pars_pointer)
}

#' Simulate an approximate LNA path using a non-centered parameterization for the
#' log-transformed counting process LNA. Resample the initial path in place, then
#' update with elliptical slice sampling.
#'
#' @param lna_times vector of interval endpoint times
#' @param lna_pars numeric matrix of parameters, constants, and time-varying
#'   covariates at each of the lna_times
#' @param init_start index in the parameter vector where the initial compartment
#'   volumes start
#' @param param_update_inds logical vector indicating at which of the times the
#'   LNA parameters need to be updated.
#' @param stoich_matrix stoichiometry matrix giving the changes to compartments
#'   from each reaction
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#' @param max_attempts maximum number of tries to restart negative increments if 
#' reject_negatives is false.
#' @param ess_updates number of elliptical slice sampling updates between samples.
#' @param ess_warmup number of elliptical slice sampling updates before the first
#' sample.
#' @param step_size initial step size for the ODE solver (adapted internally,
#' but too large of an initial step can lead to failure in stiff systems).
#' @param lna_pointer external pointer to the compiled LNA integration function.
#' @param set_pars_pointer external pointer to the function for setting LNA pars.
#' @return list containing the stochastic perturbations (i.i.d. N(0,1) draws) and
#' the LNA path on its natural scale which is determined by the perturbations.
#'
#' @export
propose_lna_approx <- function(lna_times, lna_draws, lna_pars, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, max_attempts, ess_updates, ess_warmup, lna_bracket_width, step_size, lna_pointer, set_pars_pointer) {
    .Call(`_stemr_propose_lna_approx`, lna_times, lna_draws, lna_pars, lna_param_inds, lna_tcovar_inds, init_start, param_update_inds, stoich_matrix, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, max_attempts, ess_updates, ess_warmup, lna_bracket_width, step_size, lna_pointer, set_pars_pointer)
}

#' Multivariate normal Metropolis-Hastings proposal
#'
#' @param params_prop vector in which the proposed parameters should be stored
#' @param params_cur vector containing the current parameter vector
#' @param kernel_cov_chol cholesky of the kernel covariance
#' @param nugget zero if adaptation is not ongoing
#'
#' @return propose new parameter values in place
#' @export
propose_mvnmh <- function(params_prop, params_cur, kernel_cov_chol, nugget) {
    invisible(.Call(`_stemr_propose_mvnmh`, params_prop, params_cur, kernel_cov_chol, nugget))
}

#' Identify which rates to update when a state transition event occurs.
#'
#' @param rate_inds vector of rate indices to be modified
#' @param M adjacency matrix for which rates need to be updated in response to a transition
#' @param event_code column in the rate adjacency matrix
#'
#' @return modifies logical vector stating which rates need to be updated
#' @export
rate_update_event <- function(rate_inds, M, event_code) {
    invisible(.Call(`_stemr_rate_update_event`, rate_inds, M, event_code))
}

#' Identify which rates to update based on changes in the time-varying covariates.
#'
#' @param rate_inds vector of rate indices to be modified
#' @param M time-varying covariate adjacency matrix
#' @param I logical vector indicating which covariates changed at a particular time.
#'
#' @return logical vector stating which rates need to be updated
#' @export
rate_update_tcovar <- function(rate_inds, M, I) {
    invisible(.Call(`_stemr_rate_update_tcovar`, rate_inds, M, I))
}

#' Insert the compartment counts at a sequence of census times into an existing census matrix.
#'
#' @param censusmat matrix of compartment counts at census times, to be updated
#' @param path matrix containing the path to be censused.
#' @param census_times vector of census times.
#' @param census_columns vector of column indices to be censused (C++ indexing
#'   beginning at 0).
#'
#' @return matrix containing the compartment counts at census times.
#' @export
retrieve_census_path <- function(censusmat, path, census_times, census_columns) {
    invisible(.Call(`_stemr_retrieve_census_path`, censusmat, path, census_times, census_columns))
}

#' Simulate a stochastic epidemic model path via Gillespie's direct method and
#' returns a matrix containing a simulated path from a stochastic epidemic
#' model.
#'
#' @param flow Flow matrix
#' @param parameters Vector of parameters
#' @param constants vector of constants
#' @param tcovar matrix of time-varying covariates
#' @param init_states vector of initial compartment counts
#' @param rate_adjmat adjacency matrix for updating rates after each event
#' @param tcovar_adjmat adjacency matrix for updating rates after each time a
#'   covariate changes
#' @param tcovar_changemat indicator matrix identifying which covariates change
#'   at each time
#' @param init_dims initial estimate for dimensions of the bookkeeping matrix,
#'   calculated as sum_strata(stratum size x number states x 3), rounded to the
#'   next greatest power of 2.
#' @param forcing_inds logical vector of indicating at which times in the
#'   time-varying covariance matrix a forcing is applied.
#' @param forcing_matrix matrix containing the forcings.
#' @param rate_ptr external function pointer to the lumped rate functions.
#'
#' @return matrix with a simulated path from a stochastic epidemic model.
#' @export
simulate_gillespie <- function(flow, parameters, constants, tcovar, t_max, init_states, rate_adjmat, tcovar_adjmat, tcovar_changemat, init_dims, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, rate_ptr) {
    .Call(`_stemr_simulate_gillespie`, flow, parameters, constants, tcovar, t_max, init_states, rate_adjmat, tcovar_adjmat, tcovar_changemat, init_dims, forcing_inds, forcing_tcov_inds, forcings_out, forcing_transfers, rate_ptr)
}

#' Simulate a data matrix from the measurement process of a stochastic epidemic
#' model.
#'
#' @param censusmat matrix of compartment counts at observation times
#' @param measproc_indmat logical matrix for which measure variables are
#'        observed at which times
#' @param parameters numeric vector of model parameters
#' @param constants numeric vector of constants
#' @param tcovar numeric matrix of time-varying covariate values at observation
#'        times.
#' @param r_measure_ptr external pointer to measurement process simulation fcn
#'
#' @return matrix with a simulated dataset from a stochastic epidemic model.
#' @export
simulate_r_measure <- function(censusmat, measproc_indmat, parameters, constants, tcovar, r_measure_ptr) {
    .Call(`_stemr_simulate_r_measure`, censusmat, measproc_indmat, parameters, constants, tcovar, r_measure_ptr)
}