[d84c2d]: / R / utils.R

Download this file

103 lines (96 with data), 2.9 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
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
}