R/RcppExports.R

In jeremyrcoyle/mangolassi: The Scalable Highly Adaptive Lasso

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

#' Find Copies of Columns
#'
#' Index vector that, for each column in X, indicates the index of the first
#' copy of that column
#'
#' @param X Sparse matrix containing columns of indicator functions.
#'
index_first_copy <- function(X) {
    .Call('_hal9001_index_first_copy', PACKAGE = 'hal9001', X)
}

#' Apply copy map
#'
#' OR duplicate training set columns together
#'
#' @param X Sparse matrix containing columns of indicator functions.
#' @param copy_map the copy map
#'
#' @export
#'
#' @examples
#' \donttest{
#' gendata <- function(n) {
#'   W1 <- runif(n, -3, 3)
#'   W2 <- rnorm(n)
#'   W3 <- runif(n)
#'   W4 <- rnorm(n)
#'   g0 <- plogis(0.5 * (-0.8 * W1 + 0.39 * W2 + 0.08 * W3 - 0.12 * W4))
#'   A <- rbinom(n, 1, g0)
#'   Q0 <- plogis(0.15 * (2 * A + 2 * A * W1 + 6 * A * W3 * W4 - 3))
#'   Y <- rbinom(n, 1, Q0)
#'   data.frame(A, W1, W2, W3, W4, Y)
#' }
#' set.seed(1234)
#' data <- gendata(100)
#' covars <- setdiff(names(data), "Y")
#' X <- as.matrix(data[, covars, drop = FALSE])
#' basis_list <- enumerate_basis(X)
#' x_basis <- make_design_matrix(X, basis_list)
#' copy_map <- make_copy_map(x_basis)
#' x_basis_uniq <- apply_copy_map(x_basis, copy_map)
#' }
#'
#' @return A \code{dgCMatrix} sparse matrix corresponding to the design matrix
#'  for a zero-th order highly adaptive lasso, but with all duplicated columns
#'  (basis functions) removed.
apply_copy_map <- function(X, copy_map) {
    .Call('_hal9001_apply_copy_map', PACKAGE = 'hal9001', X, copy_map)
}

#' Sort Basis Functions
#'
#' Build a sorted list of unique basis functions based on columns, where each
#' basis function is a list
#'
#' @details Note that sorting of columns is performed such that the basis order
#' equals cols.length() and each basis function is a list(cols, cutoffs).
#'
#' @param X_sub A subset of the columns of X, the original design matrix.
#' @param cols An index of the columns that were reduced to by sub-setting.
#' @param order_map A vector with length the original unsubsetted matrix X which specifies the smoothness of the function in each covariate.
make_basis_list <- function(X_sub, cols, order_map) {
    .Call('_hal9001_make_basis_list', PACKAGE = 'hal9001', X_sub, cols, order_map)
}

#' Compute Values of Basis Functions
#'
#' Computes and returns the indicator value for the basis described by
#' cols and cutoffs for a given row of X
#'
#' @param X The design matrix, containing the original data.
#' @param row_num Numeri for  a row index over which to evaluate.
#' @param cols Numeric for the column indices of the basis function.
#' @param cutoffs Numeric providing thresholds.
#' @param orders Numeric providing smoothness orders
#'
meets_basis <- function(X, row_num, cols, cutoffs, orders) {
    .Call('_hal9001_meets_basis', PACKAGE = 'hal9001', X, row_num, cols, cutoffs, orders)
}

#' Generate Basis Functions
#'
#' Populates a column (indexed by basis_col) of x_basis with basis indicators.
#'
#' @param basis The basis function.
#' @param X The design matrix, containing the original data.
#' @param x_basis The HAL design matrix, containing indicator functions.
#' @param basis_col Numeric indicating which column to populate.
#'
evaluate_basis <- function(basis, X, x_basis, basis_col) {
    invisible(.Call('_hal9001_evaluate_basis', PACKAGE = 'hal9001', basis, X, x_basis, basis_col))
}

#' Build HAL Design Matrix
#'
#' Make a HAL design matrix based on original design matrix X and a list of
#' basis functions in argument blist
#'
#' @param X Matrix of covariates containing observed data in the columns.
#' @param blist List of basis functions with which to build HAL design matrix.
#' @param p_reserve Sparse matrix pre-allocation proportion. Default value is 0.5. 
#' If one expects a dense HAL design matrix, it is useful to set p_reserve to a higher value.
#' @export
#'
#' @examples
#' \donttest{
#' gendata <- function(n) {
#'   W1 <- runif(n, -3, 3)
#'   W2 <- rnorm(n)
#'   W3 <- runif(n)
#'   W4 <- rnorm(n)
#'   g0 <- plogis(0.5 * (-0.8 * W1 + 0.39 * W2 + 0.08 * W3 - 0.12 * W4))
#'   A <- rbinom(n, 1, g0)
#'   Q0 <- plogis(0.15 * (2 * A + 2 * A * W1 + 6 * A * W3 * W4 - 3))
#'   Y <- rbinom(n, 1, Q0)
#'   data.frame(A, W1, W2, W3, W4, Y)
#' }
#' set.seed(1234)
#' data <- gendata(100)
#' covars <- setdiff(names(data), "Y")
#' X <- as.matrix(data[, covars, drop = FALSE])
#' basis_list <- enumerate_basis(X)
#' x_basis <- make_design_matrix(X, basis_list)
#' }
#'
#' @return A \code{dgCMatrix} sparse matrix of indicator basis functions
#'  corresponding to the design matrix in a zero-order highly adaptive lasso.
make_design_matrix <- function(X, blist, p_reserve = 0.5) {
    .Call('_hal9001_make_design_matrix', PACKAGE = 'hal9001', X, blist, p_reserve)
}

#' Fast Coercion to Sparse Matrix
#'
#' Fast and efficient coercion of standard matrix objects to sparse matrices.
#' Borrowed from http://gallery.rcpp.org/articles/sparse-matrix-coercion/.
#' INTERNAL USE ONLY.
#'
#' @param XX_ An object of class \code{Matrix} that has a sparse structure
#'  suitable for coercion to a sparse matrix format of \code{dgCMatrix}.
#'
#' @return An object of class \code{dgCMatrix}, coerced from input \code{XX_}.
#'
as_dgCMatrix <- function(XX_) {
    .Call('_hal9001_as_dgCMatrix', PACKAGE = 'hal9001', XX_)
}

#' Calculate Proportion of Nonzero Entries
#'
#' @keywords internal
#'
calc_pnz <- function(X) {
    .Call('_hal9001_calc_pnz', PACKAGE = 'hal9001', X)
}

#' Calculating Centered and Scaled Matrices
#'
#' @param X A sparse matrix, to be centered.
#' @param xcenter A vector of column means to be used for centering X. 
#'
#' @keywords internal
#'
calc_xscale <- function(X, xcenter) {
    .Call('_hal9001_calc_xscale', PACKAGE = 'hal9001', X, xcenter)
}