R/RcppExports.R

Defines functions unitTest flatten sobolSequence prob2IntFreq integerise qisi qis ipf

Documented in flatten integerise ipf prob2IntFreq qis qisi sobolSequence unitTest

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

#' Multidimensional IPF
#'
#' C++ multidimensional IPF implementation
#' @param seed an n-dimensional array of seed values
#' @param indices a List of 1-d arrays specifying the dimension indices of each marginal as they apply to the seed values
#' @param marginals a List of arrays containing marginal data. The sum of elements in each array must be identical
#' @return an object containing:
#' \itemize{
#'   \item{a flag indicating if the solution converged}
#'   \item{the population matrix}
#'   \item{the total population}
#'   \item{the number of iterations required}
#'   \item{the maximum error between the generated population and the marginals}
#' }
#' @examples
#' ageByGender = array(c(1,2,5,3,4,3,4,5,1,2), dim=c(5,2))
#' ethnicityByGender = array(c(4,6,5,6,4,5), dim=c(3,2))
#' seed = array(rep(1,30), dim=c(5,2,3))
#' result = ipf(seed, list(c(1,2), c(3,2)), list(ageByGender, ethnicityByGender))
#' @export
ipf <- function(seed, indices, marginals) {
    .Call('_humanleague_ipf', PACKAGE = 'humanleague', seed, indices, marginals)
}

#' Multidimensional QIS
#'
#' C++ multidimensional Quasirandom Integer Sampling implementation
#' @param indices a List of 1-d arrays specifying the dimension indices of each marginal
#' @param marginals a List of arrays containing marginal data. The sum of elements in each array must be identical
#' @param skips (optional, default 0) number of Sobol points to skip before sampling
#' @return an object containing:
#' \itemize{
#'   \item{a flag indicating if the solution converged}
#'   \item{the population matrix}
#'   \item{the exepected state occupancy matrix}
#'   \item{the total population}
#'   \item{chi-square and p-value}
#' }
#' @examples
#' ageByGender = array(c(1,2,5,3,4,3,4,5,1,2), dim=c(5,2))
#' ethnicityByGender = array(c(4,6,5,6,4,5), dim=c(3,2))
#' result = qis(list(c(1,2), c(3,2)), list(ageByGender, ethnicityByGender))
#' @export
qis <- function(indices, marginals, skips = 0L) {
    .Call('_humanleague_qis', PACKAGE = 'humanleague', indices, marginals, skips)
}

#' QIS-IPF
#'
#' C++ QIS-IPF implementation
#' @param seed an n-dimensional array of seed values
#' @param indices a List of 1-d arrays specifying the dimension indices of each marginal
#' @param marginals a List of arrays containing marginal data. The sum of elements in each array must be identical
#' @param skips (optional, default 0) number of Sobol points to skip before sampling
#' @return an object containing:
#' \itemize{
#'   \item{a flag indicating if the solution converged}
#'   \item{the population matrix}
#'   \item{the exepected state occupancy matrix}
#'   \item{the total population}
#'   \item{chi-square and p-value}
#' }
#' @examples
#' ageByGender = array(c(1,2,5,3,4,3,4,5,1,2), dim=c(5,2))
#' ethnicityByGender = array(c(4,6,5,6,4,5), dim=c(3,2))
#' seed = array(rep(1,30), dim=c(5,2,3))
#' result = qisi(seed, list(c(1,2), c(3,2)), list(ageByGender, ethnicityByGender))
#' @export
qisi <- function(seed, indices, marginals, skips = 0L) {
    .Call('_humanleague_qisi', PACKAGE = 'humanleague', seed, indices, marginals, skips)
}

#' Generate integer population from a fractional one where the 1-d partial sums along each axis have an integral total
#'
#' This function will generate the closest integer array to the fractional population provided, preserving the sums in every dimension.
#' @param population a numeric vector of state occupation probabilities. Must sum to unity (to within double precision epsilon)
#' @return an integer vector of frequencies that sums to pop.
#' @examples
#' prob2IntFreq(c(0.1,0.2,0.3,0.4), 11)
#' @export
integerise <- function(population) {
    .Call('_humanleague_integerise', PACKAGE = 'humanleague', population)
}

#' Generate integer frequencies from discrete probabilities and an overall population.
#'
#' This function will generate the closest integer vector to the probabilities scaled to the population.
#' @param pIn a numeric vector of state occupation probabilities. Must sum to unity (to within double precision epsilon)
#' @param pop the total population
#' @return an integer vector of frequencies that sum to pop, and the RMS difference from the original values.
#' @examples
#' prob2IntFreq(c(0.1,0.2,0.3,0.4), 11)
#' @export
prob2IntFreq <- function(pIn, pop) {
    .Call('_humanleague_prob2IntFreq', PACKAGE = 'humanleague', pIn, pop)
}

#' Generate Sobol' quasirandom sequence
#'
#' @param dim dimensions
#' @param n number of variates to sample
#' @param skip number of variates to skip (actual number skipped will be largest power of 2 less than k)
#' @return a n-by-d matrix of uniform probabilities in (0,1).
#' @examples
#' sobolSequence(2, 1000, 1000) # will skip 512 numbers!
#' @export
sobolSequence <- function(dim, n, skip = 0L) {
    .Call('_humanleague_sobolSequence', PACKAGE = 'humanleague', dim, n, skip)
}

#' Convert multidimensional array of counts per state into table form. Each row in the table corresponds to one individual
#'
#' This function
#' @param stateOccupancies an arbitrary-dimension array of (integer) state occupation counts.
#' @param categoryNames a string vector of unique column names.
#' @return a DataFrame with columns corresponding to category values and rows corresponding to individuals.
#' @examples
#' gender=c(51,49)
#' age=c(17,27,35,21)
#' states=qis(list(1,2),list(gender,age))$result
#' table=flatten(states,c("Gender","Age"))
#' print(nrow(table[table$Gender==1,])) # 51
#' print(nrow(table[table$Age==2,])) # 27
flatten <- function(stateOccupancies, categoryNames) {
    .Call('_humanleague_flatten', PACKAGE = 'humanleague', stateOccupancies, categoryNames)
}

#' Entry point to enable running unit tests within R (e.g. in testthat)
#'
#' @return a List containing, number of tests run, number of failures, and any error messages.
#' @examples
#' unitTest()
#' @export
unitTest <- function() {
    .Call('_humanleague_unitTest', PACKAGE = 'humanleague')
}

Try the humanleague package in your browser

Any scripts or data that you put into this service are public.

humanleague documentation built on April 18, 2023, 1:09 a.m.