Nothing
#' DataFrame and methods
#'
#' This is a 'data.table' like implementation of a data.frame. Either dplyr or
#' data.table is used as backend. The only purpose is to have \code{R CMD check}
#' friendly syntax.
#'
#' @include helper.R
#' @include FormulaList.R
#'
#' @param x (DataFrame | data.frame)
#' @param i (logical | numeric | integer | OneSidedFormula | TwoSidedFormula |
#' FormulaList) see the examples.
#' @param j (logical | character | TwoSidedFormula | FormulaList | function)
#' character beginning with '^' are interpreted as regular expression
#' @param ... arbitrary number of args
#' \cr in \code{[} (TwoSidedFormulas)
#' \cr in constructor see \link[tibble]{tibble}
#' @param by,sby (character) variables to group by. by will be used to do
#' transformations within groups. sby will collapse each group to one row.
#' @param drop (ignored) never drops the class.
#'
#' @details
#' \code{OneSidedFormula} is always used for subsetting rows.
#'
#' \code{TwoSidedFormula} is used instead of name-value expressions in
#' \code{summarise} and \code{mutate}.
#'
#' @examples
#' data("airquality")
#' dat <- as.DataFrame(airquality)
#' dat[~ Month > 4, ][meanWind ~ mean(Wind), sby = "Month"]["meanWind"]
#' dat[FL(.n ~ mean(.n), .n = c("Wind", "Temp")), sby = "Month"]
#'
#' @seealso \link{mutar}, \link{FL}
#'
#' @rdname DataFrame
#' @export
DataFrame <- function(...) {
if (!requireNamespace("tibble", quietly = TRUE)) {
stop("The DataFrame class is based on a tibble. Please install 'tibble'",
"using 'install.packages(tibble)' for this to work.")
}
dat <- tibble::tibble(...)
addClass(dat, "DataFrame")
}
#' @name DataFrame
#' @export
#' @rdname DataFrame
setOldClass(c("DataFrame", "tbl_df", "tbl", "data.frame"))
#' @rdname DataFrame
#' @export
as.DataFrame <- function(x, ...) UseMethod("as.DataFrame")
#' @rdname DataFrame
#' @export
as.DataFrame.default <- function(x, ...) {
do.call(DataFrame, as.list(x))
}
#' @rdname DataFrame
#' @export
as.DataFrame.data.frame <- function(x, ...) {
addClass(x, c("DataFrame", "tbl_df", "tbl", "data.frame"))
}
#' @rdname DataFrame
#' @export
"[.DataFrame" <- function(x, i, j, ..., by, sby, drop) {
# this is basically the dispatch function. I do NOT use default values because
# missing arguments have a meaning in the special syntax expected from [
# Assertions:
stopifnot(inherits(x, "data.frame"))
# This is hands on dispatch for missing arguments:
j <- if (missing(j)) NULL else j
j <- if (!missing(i) && nargs() == 2) i else j
i <- if (missing(i) || nargs() == 2) NULL else i
by <- if (missing(by)) NULL else by
sby <- if (missing(sby)) NULL else sby
memClassHandler <- MemClassHandler()
x <- memClassHandler$memClass(x)
x <- memClassHandler$stripClass(x)
x <- handleRows(x, dispatcher(i))
x <- handleCols(x, dispatcher(i), dispatcher(j), ..., by = by, sby = sby)
memClassHandler$wrapClass(x)
}
data.frame : handleRows(x, i) %g% standardGeneric("handleRows")
handleRows(x ~ data.frame, i ~ NULL) %m% x
handleRows(x ~ data.frame, i ~ logical | numeric | integer) %m% {
x[i, , drop = FALSE]
}
handleRows(x ~ data.frame, i ~ OneSidedFormula) %m% {
envir <- environment(i)
expr <- parse(text = sub("~", "", deparse(i)))
handleRows(x, eval(expr, envir = x, enclos = envir))
}
handleRows(x ~ data.frame, i ~ TwoSidedFormula) %m% x
handleRows(x ~ data.frame, i ~ FormulaList) %m% x
################################################################################
data.frame : handleCols(x, i, j, ..., by, sby) %g% standardGeneric("handleCols")
handleCols(x ~ data.frame, i ~ NULL, j ~ NULL, ..., by ~ NULL, sby ~ NULL) %m% x
handleCols(x ~ data.frame, i ~ NULL, j ~ character, ..., by ~ NULL, sby ~ NULL) %m% {
if (useDplyr()) {
dplyr::select_(x, .dots = j)
} else {
.SD <- NULL # to apeace R CMD check
x[, .SD, .SDcols = j]
}
}
handleCols(x ~ data.frame, i ~ NULL, j ~ RegEx, ..., by ~ NULL, sby ~ NULL) %m% {
handleCols(x, NULL, names(x)[grepl(j, names(x))], ..., by = NULL, sby = NULL)
}
handleCols(x ~ data.frame, i ~ NULL, j ~ logical, ..., by ~ NULL, sby ~ NULL) %m% {
handleCols(x, NULL, names(x)[j], ..., by = NULL, sby = NULL)
}
handleCols(x ~ data.frame, i ~ NULL, j ~ "function", ..., by ~ NULL, sby ~ NULL) %m% {
mutar(x, vapply(x, j, logical(1)))
}
handleCols(x ~ data.frame, i ~ NULL, j ~ OneSidedFormula, ..., by ~ NULL, sby ~ NULL) %m% {
handleRows(x, j)
}
handleCols(x ~ data.frame,
i ~ NULL | FormulaList, j ~ NULL | FormulaList, ...,
by ~ ANY, sby ~ ANY) %m% {
i <- update(i, x)
j <- update(j, x)
do.call(
mutar,
c(list(x = x, i = NULL, by = by, sby = sby), i, j, list(...))
)
}
handleCols(x ~ data.frame,
i ~ logical | numeric | integer | OneSidedFormula,
j ~ ANY, ..., by ~ ANY, sby ~ ANY) %m% {
handleCols(x, NULL, j, ..., by = by, sby = sby)
}
handleCols(x ~ data.frame,
i ~ TwoSidedFormula | NULL,
j ~ TwoSidedFormula | NULL,
..., by ~ NULL, sby ~ NULL) %m% {
args <- constructArgs(i, j, ..., dat = x)
if (useDplyr()) {
dplyr::mutate_(x, .dots = args)
} else {
dataTableMutate(x, args)
}
}
handleCols(x ~ data.frame,
i ~ TwoSidedFormula | NULL,
j ~ TwoSidedFormula | NULL,
..., by ~ NULL, sby ~ character) %m% {
args <- constructArgs(i, j, ..., dat = x)
if (useDplyr()) {
x <- dplyr::group_by_(x, .dots = sby)
dplyr::summarise_(x, .dots = args)
} else {
dataTableSummariseBy(x, args, sby)
}
}
handleCols(x ~ data.frame,
i ~ TwoSidedFormula | NULL,
j ~ TwoSidedFormula | NULL,
..., by ~ character, sby ~ NULL) %m% {
args <- constructArgs(i, j, ..., dat = x)
if (useDplyr()) {
dplyr::group_by_(x, .dots = by) %>%
dplyr::mutate_(.dots = args)
} else {
dataTableMutateBy(x, args, by)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.