R/RcppExports.R

In adamkucharski/serosolver: Inference Framework for Serological Data

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

#' Overall model function, fast implementation
#'
#' @param theta NumericVector, the named vector of model parameters
#' @param infection_history_mat IntegerMatrix, the matrix of 1s and 0s showing presence/absence of infection for each possible time for each individual. 
#' @param possible_exposure_times NumericVector, the time periods that the infection history vector corresponds to
#' @param possible_exposure_times_indices IntegerVector, which entry in the melted antigenic map that each possible infection time corresponds to
#' @param sample_times NumericVector, the times that each blood sample was taken
#' @param type_data_start IntegerVector, one entry for each unique individual. Each entry gives the starting index for each individual of the data frame `unique(antibody_data[,c("individual","biomarker_group")])`.
#' @param biomarker_groups IntegerVector, result of `unique(antibody_data[,c("individual","biomarker_group")])$biomarker_group`
#' @param sample_data_start IntegerVector, one entry for each unique individual and observation type combination. Each entry dictates how many indices through sample_times to iterate per individual and observation type (ie. how many sample times does each individual have?)
#' @param antibody_data_start IntegerVector, How many cumulative rows in the antibody data correspond to each unique individual and observation type combination? 
#' @param nrows_per_sample IntegerVector, one entry per sample taken. Dictates how many entries to iterate through cum_nrows_per_individual_in_data for each sampling time considered
#' @param biomarker_id_indices IntegerVector, the indices of all measured biomarkers in the melted antigenic map, with one entry per measured biomarker
#' @param antigenic_map_long arma::mat, the collapsed cross reactivity map for long term boosting, after multiplying by cr_long see \code{\link{create_cross_reactivity_vector}}
#' @param antigenic_map_short arma::mat, the collapsed cross reactivity map for short term boosting, after multiplying by cr_short, see \code{\link{create_cross_reactivity_vector}}
#' @param antigenic_distances NumericVector, the collapsed cross reactivity map giving euclidean antigenic distances, see \code{\link{create_cross_reactivity_vector}}
#' @param boost_before_infection bool to indicate if calculated antibody level for that time should be before the infection has occurred, used to calculate antibody-mediated immunity
#' @return NumericVector of predicted antibody levels for each entry in biomarker_id_indices
#' @export
#' @family antibody_models
antibody_model <- function(theta, unique_theta_indices, unique_biomarker_groups, infection_history_mat, infection_history_mat_indices, possible_exposure_times, possible_exposure_times_indices, sample_times, type_data_start, biomarker_groups, sample_data_start, antibody_data_start, nrows_per_sample, biomarker_id_indices, start_level_indices, starting_antibody_levels, births, antigenic_map_long, antigenic_map_short, antigenic_distances, boost_before_infection = FALSE) {
    .Call('_serosolver_antibody_model', PACKAGE = 'serosolver', theta, unique_theta_indices, unique_biomarker_groups, infection_history_mat, infection_history_mat_indices, possible_exposure_times, possible_exposure_times_indices, sample_times, type_data_start, biomarker_groups, sample_data_start, antibody_data_start, nrows_per_sample, biomarker_id_indices, start_level_indices, starting_antibody_levels, births, antigenic_map_long, antigenic_map_short, antigenic_distances, boost_before_infection)
}

#' Antibody model for one individual
#' 
#' A fast implementation of the basic boosting function, giving predicted antibody_levels for a number of samples for one individual. Note that this version attempts to minimise memory allocations.
#' @family antibody_models
#' @export
#' @seealso \code{\link{antibody_model}}
NULL

#' Antibody dependent boosting model, one individual
#' 
#' A fast implementation of the antibody dependent boosting function, giving predicted antibody levels for a number of samples for one individual. Note that this version attempts to minimise memory allocations.
#' @family antibody_models
#' @seealso \code{\link{antibody_model}}
NULL

antibody_model_individual_wrapper <- function(boost_long, boost_short, boost_delay, wane_short, wane_long, antigenic_seniority, birth, start_antibody_levels, number_possible_exposures, possible_exposure_times, exposure_indices, biomarker_id_indices, sample_times, antigenic_map_long, antigenic_map_short) {
    .Call('_serosolver_antibody_model_individual_wrapper', PACKAGE = 'serosolver', boost_long, boost_short, boost_delay, wane_short, wane_long, antigenic_seniority, birth, start_antibody_levels, number_possible_exposures, possible_exposure_times, exposure_indices, biomarker_id_indices, sample_times, antigenic_map_long, antigenic_map_short)
}

#' Takes a subset of a Nullable NumericVector, but only if it isn't NULL
subset_nullable_vector <- function(x, index1, index2) {
    .Call('_serosolver_subset_nullable_vector', PACKAGE = 'serosolver', x, index1, index2)
}

#' @export
get_starting_antibody_levels <- function(n_measurements, min_measurement, starting_antibody_levels = NULL) {
    .Call('_serosolver_get_starting_antibody_levels', PACKAGE = 'serosolver', n_measurements, min_measurement, starting_antibody_levels)
}

#' Sum likelihoods into buckets
#' 
#' Given a large vector of likelihood values and a vector, indices, of length n_indivs, sums the likelihoods to give one value per individual, where indices indicates which individual each index of liks corresponds to.
#' @param liks NumericVector of likelihoods
#' @param indices IntegerVector of indices of same length as liks, where the max value of this should be the same as n_indivs - 1
#' @param n_indivs int, number of individuals to generate bucketed likelihoods for
#' @export
sum_likelihoods <- function(liks, indices, n_indivs) {
    .Call('_serosolver_sum_likelihoods', PACKAGE = 'serosolver', liks, indices, n_indivs)
}

#' Convert melted antigenic map to cross reactivity
#'
#' Multiplies all elements of the provided vector, x such that y = 1 - cr_gradient*x. Also makes sure that no calculated value is less than 0
#' @param x the melted antigenic map
#' @param cr_gradient the cross reactivity waning parameter
#' @return a vector of cross reactivity
create_cross_reactivity_vector <- function(x, cr_gradient) {
    .Call('_serosolver_create_cross_reactivity_vector', PACKAGE = 'serosolver', x, cr_gradient)
}

#' Sums a vector based on bucket sizes
#'
#' Given a vector (a) and another vector of bucket sizes, returns the summed vector (a)
#' @param a the vector to be bucketed
#' @param buckets the vector of bucket sizes to sum a over
#' @return the vector of summed a
#' @export
sum_buckets <- function(a, buckets) {
    .Call('_serosolver_sum_buckets', PACKAGE = 'serosolver', a, buckets)
}

#' Count infections by group and time
#'
#' @export
sum_infections_by_group <- function(inf_hist, group_ids_vec, n_groups) {
    .Call('_serosolver_sum_infections_by_group', PACKAGE = 'serosolver', inf_hist, group_ids_vec, n_groups)
}

#' Add measurement shifts to predictions
#'
#' Adds observation error shifts to predicted antibody levels.
#' @param predicted_antibody_levels NumericVector, the predicted antibody levels. Note that this vector will be changed!
#' @param to_add NumericVector the vector of all measurement shifts to apply
#' @param start_index_in_data int the first index of to_add and predicted_antibody_levels to combine
#' @param end_index_in_data int the end index of to_add and predicted_antibody_levels to combine
#' @return nothing
#' @export
add_measurement_shifts <- function(predicted_antibody_levels, to_add, start_index_in_data, end_index_in_data) {
    invisible(.Call('_serosolver_add_measurement_shifts', PACKAGE = 'serosolver', predicted_antibody_levels, to_add, start_index_in_data, end_index_in_data))
}

#' Marginal prior probability (p(Z)) of a particular infection history matrix single prior
#'  Prior is independent contribution from each year
#' @param infection_history IntegerMatrix, the infection history matrix
#' @param n_alive IntegerVector, vector giving the number of individuals alive in each time unit
#' @param shape1 double, shape1 (alpha) parameter for beta distribution prior
#' @param shape2 double, shape2 (beta) parameter for beta distribution prior
#' @return a single prior probability
#' @export
#' @family inf_mat_prior
inf_mat_prior_cpp <- function(infection_history, n_alive, shape1, shape2) {
    .Call('_serosolver_inf_mat_prior_cpp', PACKAGE = 'serosolver', infection_history, n_alive, shape1, shape2)
}

#' Marginal prior probability (p(Z)) of a particular infection history matrix vector prior
#'  Prior is independent contribution from each year, but each year has its own shape parameters
#' @param infection_history IntegerMatrix, the infection history matrix
#' @param n_alive IntegerVector, vector giving the number of individuals alive in each time unit
#' @param shape1s NumericVector, shape1 (alpha) parameters for beta distribution prior, one for each time unit
#' @param shape2s NumericVector, shape2 (beta) parameters for beta distribution prior, one for each time unit
#' @return a single prior probability
#' @export
#' @family inf_mat_prior
inf_mat_prior_cpp_vector <- function(infection_history, n_alive, shape1s, shape2s) {
    .Call('_serosolver_inf_mat_prior_cpp_vector', PACKAGE = 'serosolver', infection_history, n_alive, shape1s, shape2s)
}

#' Marginal prior probability (p(Z)) of infection history matrix with groups
#'  Prior is independent contribution from each year and group
#' @param n_infections IntegerMatrix, the total number of infections in each time point/group
#' @param n_alive IntegerMatrix, matrix giving the number of individuals alive in each time unit in each group
#' @param shape1 double, shape1 (alpha) parameter for beta distribution prior
#' @param shape2 double, shape2 (beta) parameter for beta distribution prior
#' @return a single prior probability
#' @export
#' @family inf_mat_prior
inf_mat_prior_group_cpp <- function(n_infections, n_alive, shape1, shape2) {
    .Call('_serosolver_inf_mat_prior_group_cpp', PACKAGE = 'serosolver', n_infections, n_alive, shape1, shape2)
}

#' Marginal prior probability (p(Z)) of a particular infection history matrix vector prior by group
#'  Prior is independent contribution from each time, but each time has its own shape parameters
#' @param n_infections IntegerMatrix, the total number of infections in each time point/group
#' @param n_alive IntegerMatrix, matrix giving the number of individuals alive in each time unit in each group
#' @param shape1s NumericVector, shape1 (alpha) parameters for beta distribution prior, one for each time unit
#' @param shape2s NumericVector, shape2 (beta) parameters for beta distribution prior, one for each time unit
#' @return a single prior probability
#' @export
#' @family inf_mat_prior
inf_mat_prior_group_cpp_vector <- function(n_infections, n_alive, shape1s, shape2s) {
    .Call('_serosolver_inf_mat_prior_group_cpp_vector', PACKAGE = 'serosolver', n_infections, n_alive, shape1s, shape2s)
}

#' Marginal prior probability (p(Z)) of a particular infection history matrix total prior
#'  Prior here is on the total number of infections across all individuals and times
#' @param n_infections_group IntegerVector, the total number of infections in each group
#' @param n_alive_group IntegerVector, vector giving total number of potential infection events per group
#' @param shape1 double, shape1 (alpha) parameter for beta distribution prior
#' @param shape2 double, shape2 (beta) parameter for beta distribution prior
#' @return a single prior probability
#' @export
#' @family inf_mat_prior
inf_mat_prior_total_group_cpp <- function(n_infections_group, n_alive_group, shape1, shape2) {
    .Call('_serosolver_inf_mat_prior_total_group_cpp', PACKAGE = 'serosolver', n_infections_group, n_alive_group, shape1, shape2)
}

#' Fast observation error function
#'  Calculate the probability of a set of observed antibody levels given a corresponding set of predicted antibody levels. 
#' @param theta NumericVector, a named parameter vector giving the normal distribution standard deviation and the max observable antibody level
#' @param obs NumericVector, the vector of observed log antibody levels
#' @param predicted_antibody_levels NumericVector, the vector of predicted log antibody levels
#' @param a vector of same length as the input data giving the probability of observing each observation given the predictions
#' @return a likelihood for each observed antibody level
#' @export
#' @family likelihood_functions
likelihood_func_fast <- function(theta, obs, predicted_antibody_levels) {
    .Call('_serosolver_likelihood_func_fast', PACKAGE = 'serosolver', theta, obs, predicted_antibody_levels)
}

#' Fast observation error function continuous
#'  Calculate the probability of a set of observed antibody levels given a corresponding set of predicted antibody levels assuming continuous, bounded observations.
#' @name Fast observation error function continuous
#' @param theta NumericVector, a named parameter vector giving the normal distribution standard deviation and the max observable antibody level
#' @param obs NumericVector, the vector of observed log antibody levels
#' @param predicted_antibody_levels NumericVector, the vector of predicted log antibody levels
#' @param a vector of same length as the input data giving the probability of observing each observation given the predictions
#' @return a likelihood for each observed antibody level
#' @export
#' @family likelihood_functions
likelihood_func_fast_continuous <- function(theta, obs, predicted_antibody_levels) {
    .Call('_serosolver_likelihood_func_fast_continuous', PACKAGE = 'serosolver', theta, obs, predicted_antibody_levels)
}

#' Infection history proposal function
#' 
#' Proposes a new matrix of infection histories using a beta binomial proposal distribution. This particular implementation allows for n_infs epoch times to be changed with each function call. Furthermore, the size of the swap step is specified for each individual by proposal_inf_hist_distances.
#' @param infection_history_mat and RcppArmadillo matrix of infection histories, where rows represent individuals and columns represent potential infection times. The contents should be a set of 1s (presence of infection) and 0s (absence of infection)
#' @param sampled_indivs IntegerVector, indices of which individuals to resample. Note that this is indexed from 1 (ie. as if passing straight from R)
#' @param age_mask IntegerVector, for each individual gives the first column in the infection history matrix that an individual could have been exposed to indexed from 1. ie. if alive for the whole period, entry would be 1. If alive for the 11th epoch, entry would be 11.
#' @param strain_mask IntegerVector, for each individual gives the last column in the infection history matrix that an individual could have been exposed to indexed from 1. ie. if their last serum sample was in the 40th epoch, entry would be 40
#' @param proposal_inf_hist_distances IntegerVector, how far can a swap step sample from specified for each individual
#' @param n_infs IntegerVector, how many infections to add/remove/swap with each proposal step for each individual
#' @param shape1 double, shape1 (alpha) parameter of the beta binomial
#' @param shape2 double, shape2 (beta) parameter of the beta binomial
#' @param rand_ns NumericVector, a vector of random numbers for each sampled individual. The idea is to pre-specify whether an individual experiences an add/remove step or a swap step to avoid random number sampling in C++
#' @return a matrix of 1s and 0s corresponding to the infection histories for all individuals
#' @export
#' @family infection_history_proposal
inf_hist_prop_prior_v3 <- function(infection_history_mat, sampled_indivs, age_mask, sample_mask, proposal_inf_hist_distances, n_infs, shape1, shape2, rand_ns, proposal_inf_hist_indiv_swap_ratio) {
    .Call('_serosolver_inf_hist_prop_prior_v3', PACKAGE = 'serosolver', infection_history_mat, sampled_indivs, age_mask, sample_mask, proposal_inf_hist_distances, n_infs, shape1, shape2, rand_ns, proposal_inf_hist_indiv_swap_ratio)
}

#' Infection history gibbs proposal
#'
#' Generates a new infection history matrix and corresponding individual likelihoods, using a gibbs sampler from the infection history prior. See \code{\link{inf_hist_prop_prior_v3}}, as inputs are very similar.
#' @param theta NumericVector, the named model parameters used to solve the model
#' @param infection_history_mat IntegerMatrix the matrix of 1s and 0s corresponding to individual infection histories
#' @param likelihoods_pre_proposal NumericVector, the current likelihoods for each individual before proposing new infection histories
#' @param sampled_indivs IntegerVector, indices of sampled individuals
#' @param n_times_samp_vec int, for each individual, how many time periods to resample infections for?
#' @param age_mask IntegerVector, length of the number of individuals, with indices specifying first time period that an individual can be infected (indexed from 1, such that a value of 1 allows an individual to be infected in any time period)
#' @param sample_mask IntegerVector, length of the number of individuals, with indices specifying last time period that an individual can be infected (ie. last time a sample was taken)
#' @param n_alive IntegerMatrix, number of columns is the number of time periods that an individual could be infected, giving the number of individual alive in each time period. Number of rows is the number of distinct groups.
#' @param n_infections IntegerMatrix, the number of infections in each year (columns) for each group (rows)
#' @param n_infected_group IntegerVector, the total number of infections across all times in each group
#' @param prior_lookup arma::cube, the pre-computed lookup table for the beta prior on infection histories, dimensions are number of infections, time, and group
#' @param proposal_inf_hist_indiv_swap_ratio double, gives the proportion of proposals that will be swap steps (ie. swap contents of two cells in infection_history rather than adding/removing infections)
#' @param swap_distance int, in a swap step, how many time steps either side of the chosen time period to swap with
#' @param shape1 double, shape1 (alpha) parameter for beta prior on infection probability
#' @param shape2 double, shape2 (beta) parameter for beta prior on infection probability
#' @param possible_exposure_times NumericVector, the times that individuals could be infected
#' @param possible_exposure_times_indices IntegerVector, indexing vector from 0:(number of exposure times-1)
#' @param sample_times NumericVector, the vector of real times that samples were taken
#' @param rows_per_indiv_in_samples IntegerVector, How many rows in antibody data correspond to each individual, sample and repeat?
#' @param cum_nrows_per_individual_in_data IntegerVector, How many rows in the antibody data correspond to each individual?
#' @param cum_nrows_per_individual_in_repeat_data IntegerVector, For the repeat data (ie. already calculated these antibody levels), how many rows in the antibody data correspond to each individual?
#' @param nrows_per_blood_sample IntegerVector, Split the sample times and runs for each individual
#' @param group_id_vec IntegerVector, vector with 1 entry per individual, giving the group ID of that individual
#' @param biomarker_id_indices IntegerVector, For each antibody measurement, corresponding entry in antigenic map
#' @param antigenic_map_long arma::mat, the collapsed cross reactivity map for long term boosting, after multiplying by sigma1, see \code{\link{create_cross_reactivity_vector}}
#' @param antigenic_map_short arma::mat, the collapsed cross reactivity map for short term boosting, after multiplying by sigma2, see \code{\link{create_cross_reactivity_vector}}
#' @param antigenic_distances NumericVector matching the dimensions of antigenic_map_long and antigenic_map_short, but with the raw antigenic distances between strains
#' @param antibody_data NumericVector, data for all individuals for the first instance of each calculated antibody level
#' @param antibody_data_repeats NumericVector, the repeat antibody data for all individuals (ie. do not solve the same antibody level twice)
#' @param repeat_indices IntegerVector, which index in the main data vector does each entry in repeat_data correspond to ie. which calculated antibody level in predicted_antibody_levels should be used for each observation?
#' @param measurement_shifts NumericVector, if length matches the length of \code{data}, adds these as measurement shifts to the antibody levels. If lengths do not match, is not used.
#' @param proposal_iter IntegerVector, vector with entry for each individual, storing the number of infection history add/remove proposals for each individual.
#' @param accepted_iter IntegerVector, vector with entry for each individual, storing the number of accepted infection history add/remove proposals for each individual.
#' @param proposal_swap IntegerVector, vector with entry for each individual, storing the number of proposed infection history swaps
#' @param accepted_swap IntegerVector, vector with entry for each individual, storing the number of accepted infection history swaps
#' @param total_alive IntegerVector, giving the total number of potential infection events for each group. This only applies to prior version 4. If set to a vector of values -1, then this is ignored.
#' @param temp double, temperature for parallel tempering MCMC
#' @param solve_likelihood bool, if FALSE does not solve likelihood when calculating acceptance probability
#' @param data_type int, defaults to 1 for discretized, bounded data. Set to 2 for continuous, bounded data
#' @return an R list with 6 entries: 1) the vector replacing likelihoods_pre_proposal, corresponding to the new likelihoods per individual; 2) the matrix of 1s and 0s corresponding to the new infection histories for all individuals; 3-6) the updated entries for proposal_iter, accepted_iter, proposal_swap and accepted_swap.
#' @export
#' @family infection_history_proposal
inf_hist_prop_prior_v2_and_v4 <- function(theta, unique_theta_indices, unique_biomarker_groups, infection_history_mat, infection_history_mat_indices, likelihoods_pre_proposal, sampled_indivs, n_times_samp_vec, age_mask, sample_mask, n_alive, n_infections, n_infected_group, prior_lookup, proposal_inf_hist_indiv_swap_ratio, swap_distance, propose_from_prior, shape1, shape2, possible_exposure_times, possible_exposure_times_indices, sample_times, type_data_start, biomarker_groups, sample_data_start, antibody_data_start, nrows_per_sample, cum_nrows_per_individual_in_data, cum_nrows_per_individual_in_repeat_data, group_id_vec, biomarker_id_indices, start_level_indices, starting_antibody_levels, births, antigenic_map_long, antigenic_map_short, antigenic_distances, antibody_data, antibody_data_repeats, n_measurements_total, repeat_indices, repeat_data_exist, measurement_shifts, proposal_iter, accepted_iter, proposal_swap, accepted_swap, overall_swap_proposals, overall_add_proposals, time_sample_probs, total_alive, data_types, obs_weights, temp = 1, solve_likelihood = TRUE) {
    .Call('_serosolver_inf_hist_prop_prior_v2_and_v4', PACKAGE = 'serosolver', theta, unique_theta_indices, unique_biomarker_groups, infection_history_mat, infection_history_mat_indices, likelihoods_pre_proposal, sampled_indivs, n_times_samp_vec, age_mask, sample_mask, n_alive, n_infections, n_infected_group, prior_lookup, proposal_inf_hist_indiv_swap_ratio, swap_distance, propose_from_prior, shape1, shape2, possible_exposure_times, possible_exposure_times_indices, sample_times, type_data_start, biomarker_groups, sample_data_start, antibody_data_start, nrows_per_sample, cum_nrows_per_individual_in_data, cum_nrows_per_individual_in_repeat_data, group_id_vec, biomarker_id_indices, start_level_indices, starting_antibody_levels, births, antigenic_map_long, antigenic_map_short, antigenic_distances, antibody_data, antibody_data_repeats, n_measurements_total, repeat_indices, repeat_data_exist, measurement_shifts, proposal_iter, accepted_iter, proposal_swap, accepted_swap, overall_swap_proposals, overall_add_proposals, time_sample_probs, total_alive, data_types, obs_weights, temp, solve_likelihood)
}