R/RcppExports.R

Defines functions get_proportion_vaccinated_nimue_internal mult_2matrix_rowsum matrix_2vec_mult_cpp matrix_vec_mult_cpp get_vector_cpp get_contact_matrix_cpp tab_bins_weighted tab_bins cross_tab_margins_internal cross_tab_compartments_age cross_tab_doses_age cross_tab_margins compare_floats infection_process_vaccine_cpp_internal infection_process_nimue_cpp_internal infection_process_cpp_internal vaccination_process_nimue_cpp_internal create_hospital_scheduler_listener_cpp_internal evaluate_listener_cpp vaccine_efficacy_transmission_cpp vaccine_efficacy_severe_cpp vaccine_efficacy_infection_cpp

Documented in create_hospital_scheduler_listener_cpp_internal cross_tab_compartments_age cross_tab_doses_age cross_tab_margins get_contact_matrix_cpp get_vector_cpp infection_process_cpp_internal infection_process_nimue_cpp_internal infection_process_vaccine_cpp_internal matrix_2vec_mult_cpp matrix_vec_mult_cpp mult_2matrix_rowsum tab_bins tab_bins_weighted vaccination_process_nimue_cpp_internal vaccine_efficacy_infection_cpp vaccine_efficacy_severe_cpp vaccine_efficacy_transmission_cpp

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

#' @title Compute vaccine efficacy against infection from Ab titre (C++)
#' @param ab_titre a vector of Ab titres
#' @param parameters model parameters
#' @param day current day
#' @return a numeric vector, 0 is maximally proective, 1 is maximally unprotective
#' @export
vaccine_efficacy_infection_cpp <- function(ab_titre, parameters, day) {
    .Call('_safir_vaccine_efficacy_infection_cpp', PACKAGE = 'safir', ab_titre, parameters, day)
}

#' @title Compute vaccine efficacy against severe disease from Ab titre (C++)
#' @description This needs the efficacy against infection because efficacy against severe disease,
#' conditional on breakthrough infection is what safir needs, which is computed as  1 - ((1 - efficacy_disease)/(1 - efficacy_infection)).
#' @param ab_titre a vector of Ab titres
#' @param ef_infection a vector of efficacy against infection from \code{\link{vaccine_efficacy_infection}}
#' @param parameters model parameters
#' @param day current day
#' @return a numeric vector, 0 is maximally proective, 1 is maximally unprotective
#' @export
vaccine_efficacy_severe_cpp <- function(ab_titre, ef_infection, parameters, day) {
    .Call('_safir_vaccine_efficacy_severe_cpp', PACKAGE = 'safir', ab_titre, ef_infection, parameters, day)
}

#' @title Compute vaccine efficacy against onward transmission from Ab titre (C++)
#' @param ab_titre a vector of Ab titres
#' @param parameters model parameters.
#' @param day current day
#' @return a numeric vector, 0 is maximally protective, 1 is maximally unprotective
#' @export
vaccine_efficacy_transmission_cpp <- function(ab_titre, parameters, day) {
    .Call('_safir_vaccine_efficacy_transmission_cpp', PACKAGE = 'safir', ab_titre, parameters, day)
}

#' @noRd
evaluate_listener_cpp <- function(listener, target, t) {
    invisible(.Call('_safir_evaluate_listener_cpp', PACKAGE = 'safir', listener, target, t))
}

#' @title Internal C++ function factory for scheduling events upon hospitilisation
#' @param parameters a named [list]
#' @param states a [individual::CategoricalVariable] object
#' @param discrete_age a [individual::IntegerVariable] object
#' @param imv_get_die a [individual::TargetedEvent] object
#' @param imv_get_live a [individual::TargetedEvent] object
#' @param imv_not_get_die a [individual::TargetedEvent] object
#' @param imv_not_get_live a [individual::TargetedEvent] object
#' @param iox_get_die a [individual::TargetedEvent] object
#' @param iox_get_live a [individual::TargetedEvent] object
#' @param iox_not_get_die a [individual::TargetedEvent] object
#' @param iox_not_get_live a [individual::TargetedEvent] object
create_hospital_scheduler_listener_cpp_internal <- function(parameters, states, discrete_age, imv_get_die, imv_get_live, imv_not_get_die, imv_not_get_live, iox_get_die, iox_get_live, iox_not_get_die, iox_not_get_live) {
    .Call('_safir_create_hospital_scheduler_listener_cpp_internal', PACKAGE = 'safir', parameters, states, discrete_age, imv_get_die, imv_get_live, imv_not_get_die, imv_not_get_live, iox_get_die, iox_get_live, iox_not_get_die, iox_not_get_live)
}

#' @title C++ infection process (nimue vaccine model)
#' @description this is an internal function, you should use the R interface
#' for type checking, \code{\link{infection_process_cpp}}
#' @param parameters a list of parameters from \code{\link{get_parameters_nimue}}
#' @param states a \code{\link[individual]{CategoricalVariable}}
#' @param eligible a \code{\link[individual]{Bitset}}
#' @param vaccinated a \code{\link[individual]{Bitset}}
#' @param empty a \code{\link[individual]{Bitset}}
#' @param discrete_age a \code{\link[individual]{IntegerVariable}}
#' @param v0_to_v1v2 a \code{\link[individual]{TargetedEvent}}
#' @param dt size of time step
#' @export
vaccination_process_nimue_cpp_internal <- function(parameters, states, eligible, vaccinated, empty, discrete_age, v0_to_v1v2, dt) {
    .Call('_safir_vaccination_process_nimue_cpp_internal', PACKAGE = 'safir', parameters, states, eligible, vaccinated, empty, discrete_age, v0_to_v1v2, dt)
}

#' @title C++ infection process (squire transmission model)
#' @description this is an internal function, you should use the R interface
#' for type checking, \code{\link{infection_process_cpp}}
#' @param parameters a list of parameters from \code{\link{get_parameters}}
#' @param states a \code{\link[individual]{CategoricalVariable}}
#' @param discrete_age a \code{\link[individual]{IntegerVariable}}
#' @param exposure a \code{\link[individual]{TargetedEvent}}
#' @param dt size of time step
infection_process_cpp_internal <- function(parameters, states, discrete_age, exposure, dt) {
    .Call('_safir_infection_process_cpp_internal', PACKAGE = 'safir', parameters, states, discrete_age, exposure, dt)
}

#' @title C++ infection process (nimue vaccine model)
#' @description this is an internal function, you should use the R interface
#' for type checking, \code{\link{infection_process_cpp}}
#' @param parameters a list of parameters from \code{\link{get_parameters_nimue}}
#' @param states a \code{\link[individual]{CategoricalVariable}}
#' @param vaccine_states a \code{\link[individual]{IntegerVariable}}
#' @param discrete_age a \code{\link[individual]{IntegerVariable}}
#' @param exposure a \code{\link[individual]{TargetedEvent}}
#' @param dt size of time step
#' @export
infection_process_nimue_cpp_internal <- function(parameters, states, vaccine_states, discrete_age, exposure, dt) {
    .Call('_safir_infection_process_nimue_cpp_internal', PACKAGE = 'safir', parameters, states, vaccine_states, discrete_age, exposure, dt)
}

#' @title C++ infection process for vaccine model (multi-dose, no types)
#' @description this is an internal function, you should use the R interface
#' for type checking, \code{\link{infection_process_cpp}}
#' @param parameters a list of parameters from \code{\link{get_parameters}}
#' @param variables a named list
#' @param exposure a \code{\link[individual]{TargetedEvent}}
#' @param dt size of time step
infection_process_vaccine_cpp_internal <- function(parameters, variables, exposure, dt) {
    .Call('_safir_infection_process_vaccine_cpp_internal', PACKAGE = 'safir', parameters, variables, exposure, dt)
}

compare_floats <- function(a, b) {
    .Call('_safir_compare_floats', PACKAGE = 'safir', a, b)
}

#' @title Cross tabulate two vectors with given margins
#' @description this is a replacement for \code{\link[base]{table}} that allows empty
#' cells because the margins have been specified. The input vectors \code{a} and \code{b}
#' must be the same length, this function does no argument checking.
#' @param a one set of observations
#' @param b another set of observations
#' @param a_margin number of distinct values of a (rows)
#' @param b_margin number of distinct values of b (cols)
#' @examples
#' a <- 1:5
#' b <- c(1,2,3,1,2)
#' cross_tab_margins(a,b,5,3)
#' table(a,b)
#' @export
cross_tab_margins <- function(a, b, a_margin, b_margin) {
    .Call('_safir_cross_tab_margins', PACKAGE = 'safir', a, b, a_margin, b_margin)
}

#' @title Cross tabulate doses and age
#' @description The input vectors \code{doses} and \code{age}
#' must have the same number of values, this function does no argument checking.
#' @param doses a \code{\link[individual]{IntegerVariable}}
#' @param age a \code{\link[individual]{IntegerVariable}}
#' @param num_doses number of doses
#' @param num_ages number of age groups
#' @examples
#' \dontrun{
#' a <- IntegerVariable$new(0:4)
#' b <- IntegerVariable$new(c(1,2,3,1,2))
#' cross_tab_doses_age(a$.variable,b$.variable,4,3)
#' table(a$get_values(), b$get_values())
#' }
#' @export
cross_tab_doses_age <- function(doses, age, num_doses, num_ages) {
    .Call('_safir_cross_tab_doses_age', PACKAGE = 'safir', doses, age, num_doses, num_ages)
}

#' @title Cross tabulate compartments and age
#' @param compartments a [individual::CategoricalVariable]
#' @param age a [individual::IntegerVariable]
#' @param num_ages number of age groups
#' @param compartment_names a vector giving category names of the [individual::CategoricalVariable]
cross_tab_compartments_age <- function(compartments, age, num_ages, compartment_names) {
    .Call('_safir_cross_tab_compartments_age', PACKAGE = 'safir', compartments, age, num_ages, compartment_names)
}

cross_tab_margins_internal <- function(a, b, a_margin, b_margin) {
    .Call('_safir_cross_tab_margins_internal', PACKAGE = 'safir', a, b, a_margin, b_margin)
}

#' @title Tabulate a vector of observations
#' @description Tabulate a vector \code{a} whose values fall into a set of integers
#' of maximum value \code{nbins}. This function does no argument checking so please
#' ensure the maximum value of observations is not greater than \code{nbins}.
#' @param a a set of observations
#' @param nbins number of bins
#' @examples
#' nbin <- 10
#' a <- sample.int(n = nbin,size = 100,replace = TRUE)
#' tabulate(bin = a,nbins = nbin)
#' tab_bins(a = a,nbins = nbin)
#' @export
tab_bins <- function(a, nbins) {
    .Call('_safir_tab_bins', PACKAGE = 'safir', a, nbins)
}

#' @title Tabulate a weighted vector of observations
#' @description Similar to [safir::tab_bins] but instead of each observation
#' being implicitly given weight 1, it now has weight given by `wt[i]`.
#' @param a a set of observations
#' @param wt a set of weights
#' @param nbins number of bins
#' @export
tab_bins_weighted <- function(a, wt, nbins) {
    .Call('_safir_tab_bins_weighted', PACKAGE = 'safir', a, wt, nbins)
}

#' @title Get contact matrix
#' @description Get the contact matrix at some specific day (1st dimension of array).
#' @param array the mixing matrix array (days x age x age)
#' @param i the day (indexes the first dimension, assumes zero indexing)
#' @export
get_contact_matrix_cpp <- function(array, i) {
    .Call('_safir_get_contact_matrix_cpp', PACKAGE = 'safir', array, i)
}

#' @title Get a value from a vector
#' @description Get a value at some specific day
#' @param vector_set the set of values
#' @param i the day (assumes zero indexing)
#' @export
get_vector_cpp <- function(vector_set, i) {
    .Call('_safir_get_vector_cpp', PACKAGE = 'safir', vector_set, i)
}

#' @title Multiply a matrix by a integer vector
#' @param m a matrix
#' @param a a vector (must have length equal to number of columns of \code{m})
#' @export
matrix_vec_mult_cpp <- function(m, a) {
    .Call('_safir_matrix_vec_mult_cpp', PACKAGE = 'safir', m, a)
}

#' @title Multiply a matrix by a integer vector and a double vector
#' @param m a matrix
#' @param a a vector of double (must have length equal to number of columns of \code{m})
#' @param b a vector of double (must have length equal to number of columns of \code{m})
#' @export
matrix_2vec_mult_cpp <- function(m, a, b) {
    .Call('_safir_matrix_2vec_mult_cpp', PACKAGE = 'safir', m, a, b)
}

#' @title Element-wise multiply two matrices and take row sums
#' @description This function does no argument checking, please make sure \code{a} and \code{b}
#' are matrices of the same dimension.
#' @param a a matrix
#' @param b a matrix
#' @export
mult_2matrix_rowsum <- function(a, b) {
    .Call('_safir_mult_2matrix_rowsum', PACKAGE = 'safir', a, b)
}

get_proportion_vaccinated_nimue_internal <- function(discrete_age, vaccinated, age) {
    .Call('_safir_get_proportion_vaccinated_nimue_internal', PACKAGE = 'safir', discrete_age, vaccinated, age)
}
mrc-ide/safir documentation built on Aug. 2, 2022, 10:47 a.m.