What’s it doing?
What’s it buying us?
library(tidyverse)
detrend <- function(data, method = "loess", span = 0.75) {
if (method == "loess") {
data$y <- resid(loess(y ~ x, span = span, data = data))
} else {
data$y <- resid(lm(y ~ x, data = data))
}
as.data.frame(data)
}
compute_group_generic = function(data, scales, fun = detrend, fun.args = NULL) {
# Change default arguments of the function to the
# values in fun.args
args <- formals(fun)
for (i in seq_along(fun.args)) {
if (names(fun.args[i]) %in% names(fun.args)) {
args[[names(fun.args[i])]] <- fun.args[[i]]
}
}
formals(fun) <- args
# Apply function to data
fun(data)
}
args <- formals(detrend)
fun.args = NULL
for (i in seq_along(fun.args)) {
if (names(fun.args[i]) %in% names(fun.args)) {
args[[names(fun.args[i])]] <- fun.args[[i]]
}
}
args## $data
##
##
## $method
## [1] "loess"
##
## $span
## [1] 0.75cars |>
select(x = speed, y = dist) ->
cars_prep ; head(cars_prep)## x y
## 1 4 2
## 2 4 10
## 3 7 4
## 4 7 22
## 5 8 16
## 6 9 10cars_prep |>
compute_group_generic(fun = detrend) |>
head()## x y
## 1 4 -3.8936280
## 2 4 4.1063720
## 3 7 -8.4997857
## 4 7 9.5002143
## 5 8 0.7189178
## 6 9 -8.4465684cars_prep |>
detrend(span = .5) |>
head()## x y
## 1 4 -4.124161
## 2 4 3.875839
## 3 7 -8.329738
## 4 7 9.670262
## 5 8 1.198585
## 6 9 -6.733767# stat function used in ggplot
stat_rasa <- function(mapping = NULL, data = NULL,
geom = "point",
position = "identity",
fun = NULL,
...,
show.legend = NA,
inherit.aes = TRUE) {
# Check arguments
if (!is.function(fun)) stop("fun must be a function")
# Pass dotted arguments to a list
fun.args <- match.call(expand.dots = FALSE)$`...`
ggplot2::layer(
data = data,
mapping = mapping,
stat = StatRasa,
geom = geom,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
check.aes = FALSE,
check.param = FALSE,
params = list(
fun = fun,
fun.args = fun.args,
na.rm = FALSE,
...
)
)
}