R/RcppExports.R

In seabbs/SpeedyMarkov: Speed up Discrete Markov Model Cost Effectiveness Simulations

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

#' @title An inner Markov loop implemented using RcppArmadillo
#' @inherit markov_loop
#' @export
#' @useDynLib SpeedyMarkov, .registration=TRUE
#' @examples
#' 
#' transition <- matrix(rnorm(4), 2, 2)
#' sim <- matrix(NA, 100, 2)
#' cohort <- c(1, 0)
#' duration <- 100
#' 
#' # Reference R implementation
#' sim_r <- markov_loop(sim, cohort, transition, duration)
#' 
#' # RcppArmadillo implementation
#' sim_rcppArma <- ArmaMarkovLoop(sim, cohort, transition, duration)
#' 
#' # Check results are within tolerances
#' all.equal(sim_r, sim_rcppArma)
#' 
#' # Benchmark
#' library(microbenchmark)
#' microbenchmark(markov_loop(sim, cohort, transition, duration), 
#'                ArmaMarkovLoop(sim, cohort, transition, duration), 
#'                times = 1000)
ArmaMarkovLoop <- function(sim, cohort, transition, duration) {
    .Call(`_SpeedyMarkov_ArmaMarkovLoop`, sim, cohort, transition, duration)
}

#' @title Simulate a Markov Model Sample using RcppArmadillo
#' 
#' @description This model agnostic function runs a single markov model for the specified duration using a Armadillo implementation.
#'  See `example_two_state_markov` for an example of the required input. Alternatively use `sample_markov(type = "base")`
#'   and the output from `sample_markov`. 
#' @inherit simulate_markov_base
#' @export
#' @useDynLib SpeedyMarkov, .registration=TRUE
#' @examples
#' 
#' ## Sample model
#' markov_sample <- sample_markov(example_two_state_markov())
#' 
#' ## Simulate using R
#' sim_r <- simulate_markov_base(
#'         ## Specify the storage simulation matrix to maintain consistency 
#'         ##here (but not needed for the base implementation).
#'         sim =  matrix(NA, nrow = 10, ncol = nrow(markov_sample$transition[[1]])),
#'         transition = markov_sample$transition[[1]],
#'         cohort = markov_sample$cohort[[1]],
#'         state_cost = markov_sample$state_cost[[1]], 
#'         intervention_cost = markov_sample$intervention_cost[[1]], 
#'         qalys = markov_sample$qalys[[1]], 
#'         duration = 10,
#'         discounting = SpeedyMarkov::calc_discounting(1.035, 10),
#'         markov_loop_fn = SpeedyMarkov::markov_loop
#')  
#' 
#' # RcppArmadillo implementation
#' sim_rcppArma <- ArmaSimulateMarkov(
#'         sim =  matrix(NA, nrow = 10, ncol = nrow(markov_sample$transition[[1]])),
#'         transition = markov_sample$transition[[1]],
#'         cohort = markov_sample$cohort[[1]],
#'         state_cost = markov_sample$state_cost[[1]], 
#'         intervention_cost = markov_sample$intervention_cost[[1]], 
#'         qalys = markov_sample$qalys[[1]], 
#'         duration = 10,
#'         discounting = SpeedyMarkov::calc_discounting(1.035, 10)
#')  
#' 
#' # Check results are within tolerances
#' all.equal(sim_r, sim_rcppArma)
#' 
#' # Benchmark
#' library(microbenchmark)
#' microbenchmark(simulate_markov_base(
#'         sim =  matrix(NA, nrow = 100, ncol = nrow(markov_sample$transition[[1]])),
#'         transition = markov_sample$transition[[1]],
#'         cohort = markov_sample$cohort[[1]],
#'         state_cost = markov_sample$state_cost[[1]], 
#'         intervention_cost = markov_sample$intervention_cost[[1]], 
#'         qalys = markov_sample$qalys[[1]], 
#'         duration = 100,
#'         discounting = SpeedyMarkov::calc_discounting(1.035, 100),
#'         markov_loop_fn = SpeedyMarkov::markov_loop),
#'         ArmaSimulateMarkov(
#'         sim =  matrix(NA, nrow = 100, ncol = nrow(markov_sample$transition[[1]])),
#'         transition = markov_sample$transition[[1]],
#'         cohort = markov_sample$cohort[[1]],
#'         state_cost = markov_sample$state_cost[[1]], 
#'         intervention_cost = markov_sample$intervention_cost[[1]], 
#'         qalys = markov_sample$qalys[[1]], 
#'         duration = 100,
#'         discounting = SpeedyMarkov::calc_discounting(1.035, 100)),
#'         times = 1000)
ArmaSimulateMarkov <- function(sim, cohort, transition, duration, state_cost, discounting, qalys, intervention_cost) {
    .Call(`_SpeedyMarkov_ArmaSimulateMarkov`, sim, cohort, transition, duration, state_cost, discounting, qalys, intervention_cost)
}

#' @title Arrange Vectorised Matrix Samples using Rcpp
#' 
#' @description A convenience function used to arrange vectorised matrix samples into the correct
#' matrix format for several functions used to specify Markov model. See `example_two_state_markov`
#' for an example use case. Implemented using Rcpp.
#' @inherit matrix_arrange_inner
#' @export
#' @useDynLib SpeedyMarkov, .registration=TRUE
#' @importFrom Rcpp evalCpp
#' @examples
#' 
#' 
#' matrix_samples <- list(VGAM::rdiric(1:5, c(88, 12)),
#'                       VGAM::rdiric(1:5, c(8, 92)))
#' 
#' # R implementation
#' samples_r <- matrix_arrange_inner(matrix_samples)
#' 
#' 
#' # Rcpp implementation
#' samples_rcpp <- MatrixArrange(matrix_samples)
#' 
#' all.equal(samples_r, samples_rcpp)
#' 
#' # Benchmark
#' library(microbenchmark)
#' microbenchmark(matrix_arrange_inner(matrix_samples), 
#'                MatrixArrange(matrix_samples), 
#'                times = 1000)
MatrixArrange <- function(samples) {
    .Call(`_SpeedyMarkov_MatrixArrange`, samples)
}