R/RcppExports.R

In MJomaba/flu-evidence-synthesis: Flu Evidence Synthesis: Analysing Effectiveness of Vaccine Strategies

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

.inference_cpp_with_covariance <- function(demography, age_group_limits, ili, mon_pop, n_pos, n_samples, vaccine_calendar, polymod_data, initial_parameters, initial_contact_ids, means, covariance, covariance_weight, mapping, risk_ratios, epsilon_index, psi_index, transmissibility_index, susceptibility_index, initial_infected_index, lprior, pass_prior, lpeak_prior, pass_peak, no_age_groups, no_risk_groups, uk_prior, nburn = 0L, nbatch = 1000L, blen = 1L, abs_err = 1e-5) {
    .Call('_fluEvidenceSynthesis_inference_cppWithCovariance', PACKAGE = 'fluEvidenceSynthesis', demography, age_group_limits, ili, mon_pop, n_pos, n_samples, vaccine_calendar, polymod_data, initial_parameters, initial_contact_ids, means, covariance, covariance_weight, mapping, risk_ratios, epsilon_index, psi_index, transmissibility_index, susceptibility_index, initial_infected_index, lprior, pass_prior, lpeak_prior, pass_peak, no_age_groups, no_risk_groups, uk_prior, nburn, nbatch, blen, abs_err)
}

#' MCMC based inference of the parameter values given the different data sets
#'
#' @param demography A vector with the population size by each age {0,1,..}
#' @param ili The number of Influenza-like illness cases per week
#' @param mon_pop The number of people monitored for ili
#' @param n_pos The number of positive samples for the given strain (per week)
#' @param n_samples The total number of samples tested 
#' @param vaccine_calendar A vaccine calendar valid for that year
#' @param polymod_data Contact data for different age groups
#' @param initial Vector with starting parameter values
#' @param mapping Group mapping from model groups to data groups
#' @param risk_ratios Risk ratios to convert to and from population groups
#' @param no_age_groups Number of age groups
#' @param no_risk_groups Number of risk groups
#' @param mapping Group mapping from model groups to data groups
#' @param nburn Number of iterations of burn in
#' @param nbatch Number of batches to run (number of samples to return)
#' @param blen Length of each batch
#' 
#' @return Returns a list with the accepted samples and the corresponding llikelihood values and a matrix (contact.ids) containing the ids (row number) of the contacts data used to build the contact matrix.
.inference_cpp <- function(demography, age_group_limits, ili, mon_pop, n_pos, n_samples, vaccine_calendar, polymod_data, initial, mapping, risk_ratios, epsilon_index, psi_index, transmissibility_index, susceptibility_index, initial_infected_index, lprior, pass_prior, lpeak_prior, pass_peak, no_age_groups, no_risk_groups, uk_prior, nburn = 0L, nbatch = 1000L, blen = 1L, abs_err = 1e-5) {
    .Call('_fluEvidenceSynthesis_inference_cpp', PACKAGE = 'fluEvidenceSynthesis', demography, age_group_limits, ili, mon_pop, n_pos, n_samples, vaccine_calendar, polymod_data, initial, mapping, risk_ratios, epsilon_index, psi_index, transmissibility_index, susceptibility_index, initial_infected_index, lprior, pass_prior, lpeak_prior, pass_peak, no_age_groups, no_risk_groups, uk_prior, nburn, nbatch, blen, abs_err)
}

#' Probability density function for multinomial distribution
#'
#' @param x The counts
#' @param size The total size from which is being samples
#' @param prob Probabilities of each different outcome
#' @param use_log Whether to return logarithm probability
#'
#' @return The probability of getting the counts, given the total size and probability of drawing each.
#'
dmultinom.cpp <- function(x, size, prob, use_log = FALSE) {
    .Call('_fluEvidenceSynthesis_dmultinomialCPP', PACKAGE = 'fluEvidenceSynthesis', x, size, prob, use_log)
}

#' Update means when a new posterior sample is calculated
#'
#' @param means the current means of the parameters
#' @param v the new parameter values
#' @param n The number of posterior (mcmc) samples taken till now
#' @return The updated means given the new parameter sample
#'
.updateMeans <- function(means, v, n) {
    .Call('_fluEvidenceSynthesis_updateMeans', PACKAGE = 'fluEvidenceSynthesis', means, v, n)
}

#' Update covariance matrix of posterior parameters
#'
#' Used to enable faster mixing of the mcmc chain
#' @param cov The current covariance matrix
#' @param v the new parameter values
#' @param means the current means of the parameters
#' @param n The number of posterior (mcmc) samples taken till now
#' @return The updated covariance matrix given the new parameter sample
#'
.updateCovariance <- function(cov, v, means, n) {
    .Call('_fluEvidenceSynthesis_updateCovariance', PACKAGE = 'fluEvidenceSynthesis', cov, v, means, n)
}

#' Convert given week in given year into an exact date corresponding to the Monday of that week
#'
#' @param week The number of the week we need the date of
#' @param year The year
#' @return The date of the Monday in that week 
#'
getTimeFromWeekYear <- function(week, year) {
    .Call('_fluEvidenceSynthesis_getTimeFromWeekYear', PACKAGE = 'fluEvidenceSynthesis', week, year)
}

#' Run the SEIR model for the given parameters
#'
#' @param age_sizes A vector with the population size by each age {1,2,..}
#' @param vaccine_calendar A vaccine calendar valid for that year
#' @param polymod_data Contact data for different age groups
#' @param susceptibility Vector with susceptibilities of each age group
#' @param transmissibility The transmissibility of the strain
#' @param init_pop The (log of) initial infected population
#' @param infection_delays Vector with the time of latent infection and time infectious
#' @param interval Interval (in days) between data points
#' @return A data frame with number of new cases after each interval during the year
#'
.infection.model <- function(age_sizes, vaccine_calendar, polymod_data, susceptibility, transmissibility, init_pop, infection_delays, interval = 1L) {
    .Call('_fluEvidenceSynthesis_runSEIRModel', PACKAGE = 'fluEvidenceSynthesis', age_sizes, vaccine_calendar, polymod_data, susceptibility, transmissibility, init_pop, infection_delays, interval)
}

#' Run the SEIR model for the given parameters
#'
#' @param population The population size of the different age groups, subdivided into risk groups 
#' @param initial_infected The corresponding number of initially infected
#' @param vaccine_calendar A vaccine calendar valid for that year
#' @param contact_matrix Contact rates between different age groups
#' @param susceptibility Vector with susceptibilities of each age group
#' @param transmissibility The transmissibility of the strain
#' @param infection_delays Vector with the time of latent infection and time infectious
#' @param dates Dates to return values for.
#' @return A data frame with number of new cases after each interval during the year
#'
infectionODEs.cpp <- function(population, initial_infected, vaccine_calendar, contact_matrix, susceptibility, transmissibility, infection_delays, dates) {
    .Call('_fluEvidenceSynthesis_infectionODEs', PACKAGE = 'fluEvidenceSynthesis', population, initial_infected, vaccine_calendar, contact_matrix, susceptibility, transmissibility, infection_delays, dates)
}

#' Returns log likelihood of the predicted number of cases given the data for that week
#'
#' The model results in a prediction for the given number of new cases in a certain age group and for a certain week. This function calculates the likelihood of that given the data on reported Influenza Like Illnesses and confirmed samples.
#'
#' @param epsilon Parameter for the probability distribution
#' @param psi Parameter for the probability distribution
#' @param predicted Number of cases predicted by your model
#' @param population_size The total population size in the relevant age group
#' @param ili_cases The number of Influenza Like Illness cases
#' @param ili_monitored The size of the population monitored for ILI
#' @param confirmed_positive The number of samples positive for the Influenza strain
#' @param confirmed_samples Number of samples tested for the Influenza strain
#'
#' @seealso{\link{total_log_likelihood_cases}}
#'
.log_likelihood_cases <- function(epsilon, psi, predicted, population_size, ili_cases, ili_monitored, confirmed_positive, confirmed_samples) {
    .Call('_fluEvidenceSynthesis_log_likelihood', PACKAGE = 'fluEvidenceSynthesis', epsilon, psi, predicted, population_size, ili_cases, ili_monitored, confirmed_positive, confirmed_samples)
}

#' Returns log likelihood of the predicted number of cases given the data
#'
#' The model results in a prediction for the number of new cases in a certain
#' age group and for a certain week. This function sum the log likelihood for
#' the predicted cases for each week and age group given the data on reported
#' Influenza Like Illnesses and confirmed samples.
#'
#' @param epsilon Parameter for the probability distribution by age group
#' @param psi Parameter for the probability distribution
#' @param predicted Number of cases predicted by your model for each week and
#'   age group
#' @param population_size The total population size in the age groups
#' @param ili_cases The number of Influenza Like Illness cases by week and age
#'   group
#' @param ili_monitored The size of the population monitored for ILI  by
#'   week and age group
#' @param confirmed_positive The number of samples positive
#'   for the Influenza strain  by week and age group
#' @param confirmed_samples Number of samples tested for the Influenza strain
#'   by week and age group '
#' @param abs_err Absolute error of the likelihood approximation. By default a
#'   value of 1e-5 is used, lower is more precise, but slower.
#'
#'
log_likelihood_cases <- function(epsilon, psi, predicted, population_size, ili_cases, ili_monitored, confirmed_positive, confirmed_samples, abs_err = 1e-5) {
    .Call('_fluEvidenceSynthesis_total_log_likelihood', PACKAGE = 'fluEvidenceSynthesis', epsilon, psi, predicted, population_size, ili_cases, ili_monitored, confirmed_positive, confirmed_samples, abs_err)
}

#' Run an ODE model with the runge-kutta solver for testing purposes
#'
#' @param step_size The size of the step between returned time points
#' @param h_step The starting integration delta size
#'
.runRKF <- function(step_size = 0.1, h_step = 0.01) {
    .Call('_fluEvidenceSynthesis_runPredatorPrey', PACKAGE = 'fluEvidenceSynthesis', step_size, h_step)
}

#' Run an ODE model with the simple step wise solver for testing purposes
#'
#' @param step_size The size of the step between returned time points
#' @param h_step The starting integration delta size
#'
.runStep <- function(step_size = 0.1, h_step = 1e-5) {
    .Call('_fluEvidenceSynthesis_runPredatorPreySimple', PACKAGE = 'fluEvidenceSynthesis', step_size, h_step)
}

#' Adaptive MCMC algorithm implemented in C++
#'
#' MCMC which adapts its proposal distribution for faster convergence following:
#' Sherlock, C., Fearnhead, P. and Roberts, G.O. The Random Walk Metrolopois: Linking Theory and Practice Through a Case Study. Statistical Science 25, no.2 (2010): 172-190.
#'
#' @param lprior A function returning the log prior probability of the parameters 
#' @param llikelihood A function returning the log likelihood of the parameters given the data
#' @param outfun A function that is called for each batch. Can be useful to log certain values. 
#' @param acceptfun A function that is called whenever a sample is accepted. 
#' @param nburn Number of iterations of burn in
#' @param initial Vector with starting parameter values
#' @param nbatch Number of batches to run (number of samples to return)
#' @param blen Length of each batch
#' @param verbose Output debugging information
#' 
#' @return Returns a list with the accepted samples and the corresponding llikelihood values
#'
#' @seealso \code{\link{adaptive.mcmc}} For a more flexible R frontend to this function.
#'
adaptive.mcmc.cpp <- function(lprior, llikelihood, outfun, acceptfun, nburn, initial, nbatch, blen = 1L, verbose = FALSE) {
    .Call('_fluEvidenceSynthesis_adaptiveMCMCR', PACKAGE = 'fluEvidenceSynthesis', lprior, llikelihood, outfun, acceptfun, nburn, initial, nbatch, blen, verbose)
}

#' Adaptive MCMC algorithm implemented in C++
#'
#' MCMC which adapts its proposal distribution for faster convergence following:
#' Sherlock, C., Fearnhead, P. and Roberts, G.O. The Random Walk Metrolopois: Linking Theory and Practice Through a Case Study. Statistical Science 25, no.2 (2010): 172-190.
#'
#' @param lprior A function returning the log prior probability of the parameters 
#' @param llikelihood A function returning the log likelihood of the parameters given the data
#' @param outfun A function that is called for each batch. Can be useful to log certain values. 
#' @param acceptfun A function that is called whenever a sample is accepted. 
#' @param nburn Number of iterations of burn in
#' @param means Vector with estimated/guess mean parameter values of the posterior distribution
#' @param covariance Estimated covariance of the posterior distribution
#' @param covariance_weight The weight to give the initial estimate for the means and covariance
#' @param nbatch Number of batches to run (number of samples to return)
#' @param blen Length of each batch
#' @param verbose Output debugging information
#' 
#' @return Returns a list with the accepted samples and the corresponding llikelihood values
#'
#' @seealso \code{\link{adaptive.mcmc}} For a more flexible R frontend to this function.
#'
.adaptive.mcmc.proposal <- function(lprior, llikelihood, outfun, acceptfun, nburn, means, covariance, covariance_weight, nbatch, blen = 1L, verbose = FALSE) {
    .Call('_fluEvidenceSynthesis_adaptiveMCMCRCovariance', PACKAGE = 'fluEvidenceSynthesis', lprior, llikelihood, outfun, acceptfun, nburn, means, covariance, covariance_weight, nbatch, blen, verbose)
}

#' Create a contact matrix based on polymod data.
#'
#' @param polymod_data Contact data for different age groups
#' @param demography A vector with the population size by each age {0,1,2,..}
#' @param age_group_limits The upper limits of the different age groups (by default: c(1,5,15,25,45,65), which corresponds to age groups: <1, 1-14, 15-24, 25-44, 45-64, >=65.
#'
#' @return Returns a symmetric matrix with the frequency of contact between each age group
#'
contact_matrix <- function(polymod_data, demography, age_group_limits = as.numeric( c(             1, 5, 15, 25, 45, 65 ))) {
    .Call('_fluEvidenceSynthesis_contact_matrix', PACKAGE = 'fluEvidenceSynthesis', polymod_data, demography, age_group_limits)
}

#' Create age group level description based on passed upper limits
#'
#' @description Returns a vector of age group levels given the upper age group limits. These levels can be used as the named levels in a factor
#'
#' @param limits The upper limit to each age groups (not included) (1,5,15,25,45,65) corresponds to the following age groups: <1, 1-4, 5-14, 15-24, 25-44, 45-64 and >=65.
#'
#' @return Vector representing the age group(s)
#'
age_group_levels <- function(limits = as.numeric( c())) {
    .Call('_fluEvidenceSynthesis_age_group_levels', PACKAGE = 'fluEvidenceSynthesis', limits)
}

#' Extract upper age group limits from age group level description
#'
#' @description Returns a vector of age group limits given the age group level descriptions. This is a helper function, which is essentially the reverse of \code{\link{age_group_levels}}.
#'
#' @param levels The levels representing each age groups.
#'
#' @return Vector representing the age group(s) limits
#'
#' @seealso \code{\link{age_group_levels}} For the reverse of this function.
#'
age_group_limits <- function(levels) {
    .Call('_fluEvidenceSynthesis_age_group_limits', PACKAGE = 'fluEvidenceSynthesis', levels)
}

#' Age as age group
#'
#' @description Returns the age group a certain age belongs to given the upper age group limits 
#'
#' @param age The relevant age. This can be a vector.
#' @param limits The upper limit to each age groups (not included) (1,5,15,25,45,65) corresponds to the following age groups: <1, 1-4, 5-14, 15-24, 25-44, 45-64 and >=65.
#'
#' @return Factors representing the age group(s)
#'
as_age_group <- function(age, limits = as.numeric( c(             1, 5, 15, 25, 45, 65 ))) {
    .Call('_fluEvidenceSynthesis_as_age_group', PACKAGE = 'fluEvidenceSynthesis', age, limits)
}

#' @title Stratify the population by age
#'
#' @description Stratifies the population and returns the population size of each age group.
#'
#' @param age_sizes A vector containing the population size by age (first element is number of people of age 1 and below)
#' @param limits The upper limit to each age groups (not included) (1,5,15,25,45,65) corresponds to the following age groups: <1, 1-4, 5-14, 15-24, 25-44, 45-64 and >=65.
#'
#' @return A vector with the population in each age group.
#'
stratify_by_age <- function(age_sizes, limits = as.numeric( c(             1, 5, 15, 25, 45, 65 ))) {
    .Call('_fluEvidenceSynthesis_separate_into_age_groups', PACKAGE = 'fluEvidenceSynthesis', age_sizes, limits)
}

#' @title Stratify age groups into different risk groups
#' 
#' @description Stratifies the age groups and returns the population size of each age group and risk group.
#'
#' @param age_groups A vector containing the population size of each age group
#' @param risk_ratios A matrix with the fraction in the risk groups. The leftover fraction is assumed to be low risk
#'
#' @return A vector with the population in the low risk groups, followed by the other risk groups. The length is equal to the number of age groups times the number of risk groups (including the low risk group).
#'
.stratify_by_risk <- function(age_groups, risk_ratios, no_risk_groups) {
    .Call('_fluEvidenceSynthesis_stratify_by_risk', PACKAGE = 'fluEvidenceSynthesis', age_groups, risk_ratios, no_risk_groups)
}

#' @title Calculate R0 from transmission rate
#'
#' @description Uses the transmission rate (\eqn{\lambda}), contact matrix (\eqn{c}), population (\eqn{N}), and infectious period (\eqn{\gamma}) 
#' to calculate the R0 using the following equation.
#' \deqn{\lambda max(EV(C)) \gamma}
#' where \eqn{EV(C)} denotes the eigenvalues of the matrix \eqn{C} which is calculated from the contact matrix and the population 
#' (\eqn{C[i,j] = c[i,j] N[j]}).
#'
#' @param transmission_rate The transmission rate of the disease
#' @param contact_matrix The contact matrix between age groups
#' @param age_groups The population size of the different age groups
#' @param duration Duration of the infectious period. Default value is 1.8 days
#'
#' @return Returns the R0
as_R0 <- function(transmission_rate, contact_matrix, age_groups, duration = 1.8) {
    .Call('_fluEvidenceSynthesis_as_R0', PACKAGE = 'fluEvidenceSynthesis', transmission_rate, contact_matrix, age_groups, duration)
}

#' @title Calculate transmission rate from R0 
#'
#' @description Uses the R0 (\eqn{R0}), contact matrix (\eqn{c}), population (\eqn{N}), and infectious period (\eqn{\gamma}) 
#' to calculate the transmission rate using the following equation.
#' \deqn{R0/(max(EV(C)) \gamma)}
#' where \eqn{EV(C)} denotes the eigenvalues of the matrix \eqn{C} which is calculated from the contact matrix and the population 
#' (\eqn{C[i,j] = c[i,j] N[j]}).
#'
#' @param R0 The R0 of the disease
#' @param contact_matrix The contact matrix between age groups
#' @param age_groups The population size of the different age groups
#' @param duration Duration of the infectious period. Default value is 1.8 days
#'
#' @return Returns the transmission rate 
as_transmission_rate <- function(R0, contact_matrix, age_groups, duration = 1.8) {
    .Call('_fluEvidenceSynthesis_as_transmission_rate', PACKAGE = 'fluEvidenceSynthesis', R0, contact_matrix, age_groups, duration)
}

#' Test multinormal implementation 
#'
#' @param means Means
#' @param cov Covariance matrix 
#'
#' @return A random draw 
.testRMultinormal <- function(mean, cov) {
    .Call('_fluEvidenceSynthesis_testRMultinormal', PACKAGE = 'fluEvidenceSynthesis', mean, cov)
}

#' Calculate number of influenza cases given a vaccination strategy
#'
#' @description Superseded by \code{vaccination_scenario}
#'
#' @param age_sizes A vector with the population size by each age {1,2,..}
#' @param vaccine_calendar A vaccine calendar valid for that year
#' @param polymod_data Contact data for different age groups
#' @param contact_ids IDs (row numbers) of the contact data used when modelling this scenario 
#' @param parameters The parameters to use
#' 
#' @keywords internal
#'
#' @seealso \code{\link{vaccination_scenario}}
#' 
#' @return A data frame with the total number of influenza cases in that year
#'
vaccinationScenario <- function(age_sizes, vaccine_calendar, polymod_data, contact_ids, parameters) {
    .Call('_fluEvidenceSynthesis_vaccinationScenario', PACKAGE = 'fluEvidenceSynthesis', age_sizes, vaccine_calendar, polymod_data, contact_ids, parameters)
}