tapply: Apply a Function Over a Ragged Array

In fritools: Utilities for the Forest Research Institute of the State Baden-Wuerttemberg

Apply a Function Over a Ragged Array

Description

This is a modified version of base::tapply to allow for data.frames to be passed as X.

Usage

tapply(object, index, func = NULL, ..., default = NA, simplify = TRUE)

Arguments

object	See base::tapply X.
index	See base::tapply INDEX.
func	See base::tapply FUN.
...	See base::tapply.
default	See base::tapply.
simplify	See base::tapply.

Value

See base::tapply.

See Also

Other bits and pieces: golden_ratio(), is_difftime_less(), is_valid_primary_key(), r_cmd_install(), str2num(), strip_off_attributes(), throw()

Examples

result <- fritools::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum)
expectation <- base::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum)
RUnit::checkIdentical(result, expectation)
data("mtcars")
s <- stats::aggregate(x = mtcars[["mpg"]],
                      by = list(mtcars[["cyl"]], mtcars[["vs"]]),
                      FUN = mean)
t <- base::tapply(X = mtcars[["mpg"]],
                  INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]),
                  FUN = mean)
if (require("reshape", quietly = TRUE)) {
    suppressWarnings(tm <- na.omit(reshape::melt(t)))
    if (RUnit::checkEquals(s, tm, check.attributes = FALSE))
        message("Works!")
}
message("If you don't pass weigths, this is equal to:")
w <- base::tapply(X = mtcars[["mpg"]], INDEX = list(mtcars[["cyl"]],
                                                    mtcars[["vs"]]),
                  FUN = stats::weighted.mean)
all.equal(w, t, check.attributes = FALSE)
message("But how do you pass those weights?")
# we define a wrapper to pass the column names for a data.frame:
weighted_mean <- function(df, x, w) {
    stats::weighted.mean(df[[x]], df[[w]])
}
if (RUnit::checkIdentical(stats::weighted.mean(mtcars[["mpg"]],
                                               mtcars[["wt"]]),
                          weighted_mean(mtcars, "mpg", "wt")))
    message("Works!")
message("base::tapply can't deal with data.frames:")
try(base::tapply(X = mtcars, INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]),
                 FUN = weighted_mean, x = "mpg", w = "wt"))
wm <- fritools::tapply(object = mtcars, index = list(mtcars[["cyl"]],
                                                mtcars[["vs"]]),
                       func = weighted_mean, x = "mpg", w = "wt")
subset <- mtcars[mtcars[["cyl"]] == 6 & mtcars[["vs"]] == 0, c("mpg", "wt")]
stats::weighted.mean(subset[["mpg"]], subset[["wt"]]) == wm

fritools documentation built on Nov. 19, 2023, 1:06 a.m.