--- a +++ b/R/utils.R @@ -0,0 +1,102 @@ +#' S4 class union data.frame_OR_EList +#' +#' @description Virtual class union containing members of \code{data.frame} and +#' \code{limma::Elist}, used internally to handle situations when a returned +#' object has a type that cannot be guessed from the function call. +#' +#' @return fusion of classes \code{data.frame} and \code{EList}, used within +#' \code{.biotmle} by class \code{bioTMLE} to handle uncertainty in the object +#' passed to slot "tmleOut". +#' +#' @importFrom methods setClassUnion new +#' @importClassesFrom methods data.frame +#' @importClassesFrom limma EList +#' @importClassesFrom S4Vectors Vector Annotated +#' +#' @export +setClassUnion( + name = "data.frame_OR_EList", + members = c("data.frame", "EList") +) + +############################################################################### + +#' Constructor for class bioTMLE +#' +#' @return class \code{biotmle} object, sub-classed from SummarizedExperiment. +#' +#' @import BiocGenerics +#' @importClassesFrom SummarizedExperiment SummarizedExperiment +#' @importFrom methods setClass +#' +#' @export .biotmle +#' @exportClass bioTMLE +#' +#' @rdname bioTMLE-class +#' +#' @examples +#' library(SummarizedExperiment) +#' library(biotmleData) +#' data(illuminaData) +#' +#' example_biotmle_class <- function(se) { +#' call <- match.call(expand.dots = TRUE) +#' biotmle <- .biotmle( +#' SummarizedExperiment( +#' assays = assay(se), +#' rowData = rowData(se), +#' colData = colData(se) +#' ), +#' call = call, +#' ateOut = as.numeric(rep(NA, 10)), +#' tmleOut = as.data.frame(matrix(NA, 10, 10)), +#' topTable = as.data.frame(matrix(NA, 10, 10)) +#' ) +#' return(biotmle) +#' } +#' +#' example_class <- example_biotmle_class(se = illuminaData) +.biotmle <- methods::setClass( + Class = "bioTMLE", + slots = list( + call = "call", + ateOut = "vector", + tmleOut = "data.frame_OR_EList", + topTable = "data.frame" + ), + contains = "SummarizedExperiment" +) + +############################################################################### + +#' Accessor for Table of Raw Efficient Influence Function Values +#' +#' @param object S4 object of class \code{bioTMLE}. +#' +#' @importFrom methods is +#' @importFrom assertthat assert_that +#' +#' @return contents of \code{tmleOut} slot of object of class \code{biotmle}. +#' +#' @export +eif <- function(object) { + assertthat::assert_that(is(object, "bioTMLE")) + object@tmleOut +} + +############################################################################### + +#' Accessor for Results of Moderated Influence Function Hypothesis Testing +#' +#' @param object S4 object of class \code{bioTMLE}. +#' +#' @importFrom methods is +#' @importFrom assertthat assert_that +#' +#' @return contents of \code{topTable} slot of object of class \code{biotmle}. +#' +#' @export +toptable <- function(object) { + assertthat::assert_that(is(object, "bioTMLE")) + object@topTable +}