R/RcppExports.R

In gregorkb/semipadd2pop: Combine two data sets to fit semiparametric additive models

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

#' The soft-thresholding function for a scalar input
#'
#' @param z the value to which to apply soft-thresholding
#' @param a the threshold
#' @return the value of the soft-thresholding function
#'
#' @examples
#' z <- 3
#' a <- 2
#' SoftThresh(z,a)
SoftThresh_scalar <- function(z, a) {
    .Call(`_semipadd2pop_SoftThresh_scalar`, z, a)
}

#' Minimize l2-penalized quadratic function
#'
#' @param h a vector
#' @param L a matrix with number of rows equal to the length of h
#' @param lambda a value greater than zero giving the strength of the penalty
#' @param evals the eigenvalues of \eqn{L^TL}
#' @param evecs the eigenvectors of \eqn{L^TL}
#' @return Returns the unique minimizer of \deqn{(1/2) \|h - L \beta\|_2^2  + \lambda * \|\beta\|_2}
#'
#' See Theorem 2 of Foygel, Rina, and Mathias Drton. "Exact block-wise optimization in group lasso and sparse group lasso for linear regression." arXiv preprint arXiv:1010.3320 (2010).
#'
#' @examples
#' # generate an h and L
#' h <- rnorm(100)
#' L <- matrix(rnorm(100*10),100,10)
#' lambda <- 1
#'
#' # get eigendecomposition of t(L) %*% L
#' LtL <- t(L) %*% L
#' eigen.out <- eigen(LtL)
#' evals <- eigen.out$values
#' evecs <- t(eigen.out$vectors)
#'
#' # find minimizer
#' FoygelDrton_Armadillo(h,L,lambda,evals,evecs)
#'
#' # compare to using optim() to minimize the same function
#' obj <- function(beta,L,h,lambda){
#'  val <- (1/2) * sum(  (h - L %*% beta )^2 ) + lambda * sqrt( sum(beta^2))
#'  return(val)
#' }
#' optim(par=rep(0,d),obj,L = L, h = h, lambda = lambda)$par
FoygelDrton_Armadillo <- function(h, L, lambda, evals, evecs) {
    .Call(`_semipadd2pop_FoygelDrton_Armadillo`, h, L, lambda, evals, evecs)
}

#' Minimize the objective function of the group lasso problem with a continuous response
#'
#' @param Y the response vector
#' @param X matrix containing the design matrices
#' @param groups a vector of integers indicating to which group each covariate belongs
#' @param lambda the level of sparsity penalization
#' @param w vector of group-specific weights for different penalization of groups
#' @param eigen a list of eigen info on groups
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta_init optional starting value for beta
#' @return Returns the minimizer of the group lasso objective function
#'
#' @examples
#' data <- get_grouplasso_data(n = 500,response = "continuous")
#' 
#' grouplasso_linreg.out <- grouplasso_linreg(rY = data$Y,
#'                                            rX = data$X,
#'                                            groups = data$groups,
#'                                            lambda = 10,
#'                                            w = data$w,
#'                                            tol = 1e-4,
#'                                            maxiter = 500)
grouplasso_linreg_slower <- function(rY, rX, groups, lambda, w, tol, maxiter, beta_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso_linreg_slower`, rY, rX, groups, lambda, w, tol, maxiter, beta_init)
}

#' Minimize the objective function of the group lasso problem with a continuous response
#'
#' @param Y the response vector
#' @param X matrix containing the design matrices
#' @param groups a vector of integers indicating to which group each covariate belongs
#' @param lambda the level of sparsity penalization
#' @param w vector of group-specific weights for different penalization of groups
#' @param eigen a list of eigen info on groups
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta_init optional starting value for beta
#' @return Returns the minimizer of the group lasso objective function
#'
#' @examples
#' data <- get_grouplasso_data(n = 500,response = "continuous")
#' 
#' grouplasso_linreg.out <- grouplasso_linreg(rY = data$Y,
#'                                            rX = data$X,
#'                                            groups = data$groups,
#'                                            lambda = 10,
#'                                            w = data$w,
#'                                            tol = 1e-4,
#'                                            maxiter = 500)
grouplasso_linreg <- function(rY, rX, groups, lambda, w, tol, maxiter, beta_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso_linreg`, rY, rX, groups, lambda, w, tol, maxiter, beta_init)
}

#' Minimize the objective function of the 2-population group lasso problem with a continuous response
#'
#' @param Y1 the continuous response vector of data set 1
#' @param X1 matrix containing the design matrices for data set 1
#' @param groups1 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param Y2 the continuous response vector of data set 2
#' @param X2 matrix containing the design matrices for data set 2
#' @param groups2 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param rho1 weight placed on the first data set
#' @param rho2 weight placed on the second data set
#' @param lambda the level of sparsity penalization
#' @param eta the level of penalization towards model similarity
#' @param w1 group-specific weights for different penalization across groups in data set 1
#' @param w2 group-specific weights for different penalization across groups in data set 2
#' @param w group-specific weights for different penalization toward similarity for different groups
#' @param AA1 a list of the matrices A1j
#' @param AA1 a list of the matrices A2j
#' @param eigen1 a list of eigen info on groups from data set 1
#' @param eigen2 a list of eigen info on groups from data set 2
#' @param Com the indices of the covariate groups which are common in the two datasets
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta1_init optional starting value for beta1
#' @param beta2_init optional starting value for beta2
#' @return Returns the minimizers of the 2-population group lasso objective function for the two data sets.
#'
#' @examples
#' data <- get_grouplasso2pop_data(n1 = 400, n2 = 600, response = "continuous")
#'   
#' grouplasso2pop_linreg.out <- grouplasso2pop_linreg(rY1 = data$Y1,
#'                                                    rX1 = data$X1,
#'                                                    groups1 = data$groups1,
#'                                                    rY2 = data$Y2,
#'                                                    rX2 = data$X2,
#'                                                    groups2 = data$groups2,
#'                                                    rho1 = 2,
#'                                                    rho2 = 1,
#'                                                    lambda = 1,
#'                                                    eta = 1,
#'                                                    w1 = data$w1,
#'                                                    w2 = data$w2,
#'                                                    w = data$w,
#'                                                    rAA1 = data$AA1,
#'                                                    rAA2 = data$AA2,
#'                                                    rCom = data$Com,
#'                                                    tol = 1e-4,
#'                                                    maxiter = 500)
grouplasso2pop_linreg_slower <- function(rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init = as.numeric( c()), beta2_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso2pop_linreg_slower`, rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init, beta2_init)
}

#' Minimize the objective function of the 2-population group lasso problem with a continuous response
#'
#' @param Y1 the continuous response vector of data set 1
#' @param X1 matrix containing the design matrices for data set 1
#' @param groups1 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param Y2 the continuous response vector of data set 2
#' @param X2 matrix containing the design matrices for data set 2
#' @param groups2 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param rho1 weight placed on the first data set
#' @param rho2 weight placed on the second data set
#' @param lambda the level of sparsity penalization
#' @param eta the level of penalization towards model similarity
#' @param w1 group-specific weights for different penalization across groups in data set 1
#' @param w2 group-specific weights for different penalization across groups in data set 2
#' @param w group-specific weights for different penalization toward similarity for different groups
#' @param AA1 a list of the matrices A1j
#' @param AA1 a list of the matrices A2j
#' @param eigen1 a list of eigen info on groups from data set 1
#' @param eigen2 a list of eigen info on groups from data set 2
#' @param Com the indices of the covariate groups which are common in the two datasets
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta1_init optional starting value for beta1
#' @param beta2_init optional starting value for beta2
#' @return Returns the minimizers of the 2-population group lasso objective function for the two data sets.
#'
#' @examples
#' data <- get_grouplasso2pop_data(n1 = 400, n2 = 600, response = "continuous")
#'   
#' grouplasso2pop_linreg.out <- grouplasso2pop_linreg(rY1 = data$Y1,
#'                                                    rX1 = data$X1,
#'                                                    groups1 = data$groups1,
#'                                                    rY2 = data$Y2,
#'                                                    rX2 = data$X2,
#'                                                    groups2 = data$groups2,
#'                                                    rho1 = 2,
#'                                                    rho2 = 1,
#'                                                    lambda = 1,
#'                                                    eta = 1,
#'                                                    w1 = data$w1,
#'                                                    w2 = data$w2,
#'                                                    w = data$w,
#'                                                    rAA1 = data$AA1,
#'                                                    rAA2 = data$AA2,
#'                                                    rCom = data$Com,
#'                                                    tol = 1e-4,
#'                                                    maxiter = 500)
grouplasso2pop_linreg <- function(rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init = as.numeric( c()), beta2_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso2pop_linreg`, rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init, beta2_init)
}

#' Minimize the objective function of the group lasso problem with a binary response
#'
#' @param Y the binary response vector
#' @param X matrix containing the design matrices
#' @param groups a vector of integers indicating to which group each covariate belongs
#' @param lambda the level of sparsity penalization
#' @param w vector of group-specific weights for different penalization of groups
#' @param eigen a list of eigen info on groups
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta_init optional starting value for beta
#' @return Returns the minimizer of the group lasso objective function
#'
#' @examples
#' data <- get_grouplasso_data(n = 500, response = "binary")
#' 
#' grouplasso_logreg.out <- grouplasso_logreg(rY = data$Y,
#'                                            rX = data$X,
#'                                            groups = data$groups,
#'                                            lambda = 10,
#'                                            w = data$w,
#'                                            tol = 1e-4,
#'                                            maxiter = 500)
grouplasso_logreg_slower <- function(rY, rX, groups, lambda, w, tol, maxiter, beta_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso_logreg_slower`, rY, rX, groups, lambda, w, tol, maxiter, beta_init)
}

#' Minimize the objective function of the group lasso problem with a binary response
#'
#' @param Y the binary response vector
#' @param X matrix containing the design matrices
#' @param groups a vector of integers indicating to which group each covariate belongs
#' @param lambda the level of sparsity penalization
#' @param w vector of group-specific weights for different penalization of groups
#' @param eigen a list of eigen info on groups
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta_init optional starting value for beta
#' @return Returns the minimizer of the group lasso objective function
#'
#' @examples
#' data <- get_grouplasso_data(n = 500, response = "binary")
#' 
#' grouplasso_logreg.out <- grouplasso_logreg(rY = data$Y,
#'                                            rX = data$X,
#'                                            groups = data$groups,
#'                                            lambda = 10,
#'                                            w = data$w,
#'                                            tol = 1e-4,
#'                                            maxiter = 500)
grouplasso_logreg <- function(rY, rX, groups, lambda, w, tol, maxiter, beta_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso_logreg`, rY, rX, groups, lambda, w, tol, maxiter, beta_init)
}

#' Minimize the objective function of the 2-population group lasso problem with a binary response
#'
#' @param Y1 the binary response vector of data set 1
#' @param X1 matrix containing the design matrices for data set 1
#' @param groups1 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param Y2 the binary response vector of data set 2
#' @param X2 matrix containing the design matrices for data set 2
#' @param groups2 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param rho1 weight placed on the first data set
#' @param rho2 weight placed on the second data set
#' @param lambda the level of sparsity penalization
#' @param eta the level of penalization towards model similarity
#' @param w1 group-specific weights for different penalization across groups in data set 1
#' @param w2 group-specific weights for different penalization across groups in data set 2
#' @param w group-specific weights for different penalization toward similarity for different groups
#' @param AA1 a list of the matrices A1j
#' @param AA1 a list of the matrices A2j
#' @param eigen1 a list of eigen info on groups from data set 1
#' @param eigen2 a list of eigen info on groups from data set 2
#' @param Com the indices of the covariate groups which are common in the two datasets
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta1_init optional starting value for beta1
#' @param beta2_init optional starting value for beta2
#' @return Returns the minimizers of the 2-population group lasso objective function for the two data sets.
#'
#' @examples
#' data <- get_grouplasso2pop_data(n1 = 400,n2 = 600, response = "binary")
#' 
#' grouplasso2pop_logreg.out <- grouplasso2pop_logreg(rY1 = data$Y1,
#'                                                    rX1 = data$X1,
#'                                                    groups1 = data$groups1,
#'                                                    rY2 = data$Y2,
#'                                                    rX2 = data$X2,
#'                                                    groups2 = data$groups2,
#'                                                    rho1 = 2,
#'                                                    rho2 = 1,
#'                                                    lambda = 1,
#'                                                    eta = 1,
#'                                                    w1 = data$w1,
#'                                                    w2 = data$w2,
#'                                                    w = data$w,
#'                                                    rAA1 = data$AA1,
#'                                                    rAA2 = data$AA2,
#'                                                    rCom = data$Com,
#'                                                    tol = 1e-4,
#'                                                    maxiter = 500)
grouplasso2pop_logreg_slower <- function(rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init = as.numeric( c()), beta2_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso2pop_logreg_slower`, rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init, beta2_init)
}

#' Minimize the objective function of the 2-population group lasso problem with a binary response
#'
#' @param Y1 the binary response vector of data set 1
#' @param X1 matrix containing the design matrices for data set 1
#' @param groups1 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param Y2 the binary response vector of data set 2
#' @param X2 matrix containing the design matrices for data set 2
#' @param groups2 a vector of integers indicating to which group each covariate in data set 1 belongs
#' @param rho1 weight placed on the first data set
#' @param rho2 weight placed on the second data set
#' @param lambda the level of sparsity penalization
#' @param eta the level of penalization towards model similarity
#' @param w1 group-specific weights for different penalization across groups in data set 1
#' @param w2 group-specific weights for different penalization across groups in data set 2
#' @param w group-specific weights for different penalization toward similarity for different groups
#' @param AA1 a list of the matrices A1j
#' @param AA1 a list of the matrices A2j
#' @param eigen1 a list of eigen info on groups from data set 1
#' @param eigen2 a list of eigen info on groups from data set 2
#' @param Com the indices of the covariate groups which are common in the two datasets
#' @param tol a convergence criterion
#' @param max.iter the maximum allowed number of iterations
#' @param return_obj a logical indicating whether the value of the objection function should be recorded after every step of the algorithm
#' @param beta1_init optional starting value for beta1
#' @param beta2_init optional starting value for beta2
#' @return Returns the minimizers of the 2-population group lasso objective function for the two data sets.
#'
#' @examples
#' data <- get_grouplasso2pop_data(n1 = 400,n2 = 600, response = "binary")
#'
#' grouplasso2pop_logreg.out <- grouplasso2pop_logreg(rY1 = data$Y1,
#'                                                    rX1 = data$X1,
#'                                                    groups1 = data$groups1,
#'                                                    rY2 = data$Y2,
#'                                                    rX2 = data$X2,
#'                                                    groups2 = data$groups2,
#'                                                    rho1 = 2,
#'                                                    rho2 = 1,
#'                                                    lambda = 1,
#'                                                    eta = 1,
#'                                                    w1 = data$w1,
#'                                                    w2 = data$w2,
#'                                                    w = data$w,
#'                                                    rAA1 = data$AA1,
#'                                                    rAA2 = data$AA2,
#'                                                    rCom = data$Com,
#'                                                    tol = 1e-4,
#'                                                    maxiter = 500)
grouplasso2pop_logreg <- function(rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init = as.numeric( c()), beta2_init = as.numeric( c())) {
    .Call(`_semipadd2pop_grouplasso2pop_logreg`, rY1, rX1, groups1, rY2, rX2, groups2, rho1, rho2, lambda, eta, w1, w2, w, rAA1, rAA2, rCom, tol, maxiter, beta1_init, beta2_init)
}

#' Generate all possible sequences of 0s and 1s of a given length
#' @param a the length of the sequences.
#' @return a matrix containing in its rows the sequences of 0s and 1s.
all_binary_sequences <- function(a) {
    .Call(`_semipadd2pop_all_binary_sequences`, a)
}

#' Computes conditional expectations of individual disease statuses for individual, master pool, or Dorfman testing
#'   
#' @param Z Group testing output from one of the functions \code{individual.assay.gen}, \code{masterpool.assay.gen}, \code{dorfman.assay.gen}.
#' @param Y Group testing output from one of the functions \code{individual.assay.gen}, \code{masterpool.assay.gen}, \code{dorfman.assay.gen}.
#' @param X Design matrix with first column a column of 1s.
#' @param b Parameter values at which to compute the conditional expectations.
#' @param Se A vector of testing sensitivities of length \code{max(Z[,3])}.
#' @param Sp A vector of testing specificities of length \code{max(Z[,3])}.
#' @return The vector of conditional expectations.
#' 
#' This function computes the conditional expectations of each individual disease status, conditional on the observed assay data and the diseasestatuses of all other individuals.
#' 
#' @examples
#' grouplassogt2pop_data <- get_grouplassogt2pop_data( n1 = 400, n2 = 600)
#'   
#' EY <- EYexact(Z = grouplassogt2pop_data$Z1,
#'               Y = grouplassogt2pop_data$Y1,
#'               X = grouplassogt2pop_data$X1,
#'               b = rep(1,ncol(grouplassogt2pop_data$X1)),
#'               Se = grouplassogt2pop_data$Se1,
#'               Sp = grouplassogt2pop_data$Sp1)
EYexact <- function(Z, Y, X, b, Se, Sp) {
    .Call(`_semipadd2pop_EYexact`, Z, Y, X, b, Se, Sp)
}

#' Computes approximate conditional expectations of individual disease statuses for individual, master pool, or Dorfman testing
#'   
#' @param Z Group testing output from one of the functions \code{individual.assay.gen}, \code{masterpool.assay.gen}, \code{dorfman.assay.gen}, or \code{array.assay.gen}.
#' @param Y Group testing output from one of the functions \code{individual.assay.gen}, \code{masterpool.assay.gen}, \code{dorfman.assay.gen}, or \code{array.assay.gen}.
#' @param X Design matrix with first column a column of 1s.
#' @param b Parameter values at which to compute the conditional expectations.
#' @param Se A vector of testing sensitivities of length \code{max(Z[,3])}.
#' @param Sp A vector of testing specificities of length \code{max(Z[,3])}.
#' @return The vector of conditional expectations.
#' 
#' This function computes approximate conditional expectations via Gibbs sampling of each individual disease status, conditional on the observed assay data and the diseasestatuses of all other individuals.
#' 
#' @examples
#' grouplassogt2pop_data <- get_grouplassogt2pop_data( n1 = 400, n2 = 600)
#'   
#' EY <- EYapprox(Z = grouplassogt2pop_data$Z1,
#'                Y = grouplassogt2pop_data$Y1,
#'                X = grouplassogt2pop_data$X1,
#'                b = rep(1,ncol(grouplassogt2pop_data$X1)),
#'                Se = grouplassogt2pop_data$Se1,
#'                Sp = grouplassogt2pop_data$Sp1)
EYgibbs <- function(N, p, Y, Z, se, sp, na, GI) {
    .Call(`_semipadd2pop_EYgibbs`, N, p, Y, Z, se, sp, na, GI)
}