Nothing
#' Slide
#'
#' `slide()` iterates through `.x` using a sliding window, applying `.f` to each
#' sub-window of `.x`.
#'
#' @param .x `[vector]`
#'
#' The vector to iterate over and apply `.f` to.
#'
#' @param .f `[function / formula]`
#'
#' If a __function__, it is used as is.
#'
#' If a __formula__, e.g. `~ .x + 2`, it is converted to a function. There
#' are three ways to refer to the arguments:
#'
#' * For a single argument function, use `.`
#' * For a two argument function, use `.x` and `.y`
#' * For more arguments, use `..1`, `..2`, `..3` etc
#'
#' This syntax allows you to create very compact anonymous functions.
#'
#' @param ... Additional arguments passed on to the mapped function.
#'
#' @param .step `[positive integer(1)]`
#'
#' The number of elements to shift the window forward between function calls.
#'
#' @param .complete `[logical(1)]`
#'
#' Should the function be evaluated on complete windows only? If `FALSE`,
#' the default, then partial computations will be allowed.
#'
#' @param .ptype `[vector(0) / NULL]`
#'
#' A prototype corresponding to the type of the output.
#'
#' If `NULL`, the default, the output type is determined by computing the
#' common type across the results of the calls to `.f`.
#'
#' If supplied, the result of each call to `.f` will be cast to that type,
#' and the final output will have that type.
#'
#' If `getOption("vctrs.no_guessing")` is `TRUE`, the `.ptype` must be
#' supplied. This is a way to make production code demand fixed types.
#'
#' @template param-before-after-slide
#'
#' @details
#'
#' Unlike `lapply()` or `purrr::map()`, which construct calls like
#'
#' ```
#' .f(.x[[i]], ...)
#' ```
#'
#' the equivalent with `slide()` looks like
#'
#' ```
#' .f(vctrs::vec_slice(.x, i), ...)
#' ```
#'
#' which is approximately
#'
#' ```
#' .f(.x[i], ...)
#' ```
#'
#' except in the case of data frames or arrays, which are iterated
#' over row-wise.
#'
#' If `.x` has names, then the output will preserve those names.
#'
#' Using [vctrs::vec_cast()], the output of `.f` will be automatically cast
#' to the type required by the variant of `slide_*()` being used.
#'
#' @return
#' A vector fulfilling the following invariants:
#'
#' \subsection{`slide()`}{
#'
#' * `vec_size(slide(.x)) == vec_size(.x)`
#'
#' * `vec_ptype(slide(.x)) == list()`
#'
#' }
#'
#' \subsection{`slide_vec()` and `slide_*()` variants}{
#'
#' * `vec_size(slide_vec(.x)) == vec_size(.x)`
#'
#' * `vec_size(slide_vec(.x)[[1]]) == 1L`
#'
#' * `vec_ptype(slide_vec(.x, .ptype = ptype)) == ptype`
#'
#' }
#'
#' @examples
#' # The defaults work similarly to `map()`
#' slide(1:5, ~.x)
#'
#' # Use `.before`, `.after`, and `.step` to control the window
#' slide(1:5, ~.x, .before = 1)
#'
#' # This can be used for rolling means
#' slide_dbl(rnorm(5), mean, .before = 2)
#'
#' # Or more flexible rolling operations
#' slide(rnorm(5), ~ .x - mean(.x), .before = 2)
#'
#' # `.after` allows you to "align to the left" rather than the right
#' slide(1:5, ~.x, .after = 2)
#'
#' # And a mixture of `.before` and `.after`
#' # allows you complete control over the exact alignment.
#' # Below, "center alignment" is used.
#' slide(1:5, ~.x, .before = 1, .after = 1)
#'
#' # The `.step` controls how the window is shifted along `.x`,
#' # allowing you to "skip" iterations if you only need a less granular result
#' slide(1:10, ~.x, .before = 2, .step = 3)
#'
#' # `.complete` controls whether or not partial results are computed.
#' # By default, they are, but setting `.complete = TRUE` restricts
#' # `slide()` to only evaluate the function where a complete window exists.
#' slide(1:5, ~.x, .before = 2, .after = 1)
#' slide(1:5, ~.x, .before = 2, .after = 1, .complete = TRUE)
#'
#' # ---------------------------------------------------------------------------
#' # Data frames
#'
#' # Data frames are iterated over rowwise
#' mtcars_rowwise <- slide(mtcars, ~.x)
#' mtcars_rowwise[1:3]
#'
#' # This means that any column name is easily accessible
#' slide_dbl(mtcars, ~.x$mpg + .x$cyl)
#'
#' # More advanced rowwise iteration is available as well by using the
#' # other arguments
#' mtcars_rowwise_window <- slide(mtcars, ~.x, .before = 1, .after = 1)
#' mtcars_rowwise_window[1:3]
#'
#' # ---------------------------------------------------------------------------
#' # Cumulative sliding
#'
#' # Using the special cased value, `Inf`, you can ask `slide()` to pin the
#' # start of the sliding window to the first element, effectively creating
#' # a cumulative window
#' slide(1:5, ~.x, .before = Inf)
#'
#' # Same with `.after`, this creates a window where you start with all of the
#' # elements, but decrease the total number over each iteration
#' slide(1:5, ~.x, .after = Inf)
#'
#' # ---------------------------------------------------------------------------
#' # Negative `.before` / `.after`
#'
#' # `.before` is allowed to be negative, allowing you to "look forward" in
#' # your vector. Note that `abs(.before) <= .after` must hold if `.before` is
#' # negative. In this example, we look forward to elements in locations 2 and 3
#' # but place the result in position 1 in the output.
#' slide(1:5, ~.x, .before = -1, .after = 2)
#'
#' # `.after` can be negative as well to "look backwards"
#' slide(1:5, ~.x, .before = 2, .after = -1)
#'
#' # ---------------------------------------------------------------------------
#' # Removing padding
#'
#' # If you are looking for a way to remove the `NA` values from something like
#' # this, then it doesn't exist as a built in option.
#' x <- rnorm(10)
#' slide_dbl(x, mean, .before = 3, .step = 2, .complete = TRUE)
#'
#' # Adding an option to `slide_dbl()` to remove the `NA` values would destroy
#' # its size stability. Instead, you can use a combination of `slide_dfr()`
#' # to get the start/stop indices with `hop_index_vec()`.
#' i <- seq_along(x)
#' idx <- slide_dfr(
#' i,
#' ~data.frame(start = .x[1], stop = .x[length(.x)]),
#' .before = 3,
#' .step = 2,
#' .complete = TRUE
#' )
#'
#' idx
#'
#' hop_index_vec(x, i, idx$start, idx$stop, mean, .ptype = double())
#'
#' @seealso [slide2()], [slide_index()], [hop()]
#' @export
slide <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE) {
slide_impl(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = list(),
.constrain = FALSE,
.atomic = FALSE
)
}
#' @rdname slide
#' @export
slide_vec <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE,
.ptype = NULL) {
out <- slide_impl(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = list(),
.constrain = FALSE,
.atomic = TRUE
)
vec_simplify(out, .ptype)
}
slide_vec_direct <- function(.x,
.f,
...,
.before,
.after,
.step,
.complete,
.ptype,
.slider_error_call = caller_env()) {
slide_impl(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = .ptype,
.constrain = TRUE,
.atomic = TRUE,
.slider_error_call = .slider_error_call
)
}
#' @rdname slide
#' @export
slide_dbl <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE) {
slide_vec_direct(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = double()
)
}
#' @rdname slide
#' @export
slide_int <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE) {
slide_vec_direct(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = integer()
)
}
#' @rdname slide
#' @export
slide_lgl <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE) {
slide_vec_direct(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = logical()
)
}
#' @rdname slide
#' @export
slide_chr <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE) {
slide_vec_direct(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete,
.ptype = character()
)
}
#' @inheritParams vctrs::vec_rbind
#' @rdname slide
#' @export
slide_dfr <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE,
.names_to = rlang::zap(),
.name_repair = c("unique", "universal", "check_unique")) {
out <- slide(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete
)
vec_rbind(!!!out, .names_to = .names_to, .name_repair = .name_repair)
}
#' @inheritParams vctrs::vec_cbind
#' @rdname slide
#' @export
slide_dfc <- function(.x,
.f,
...,
.before = 0L,
.after = 0L,
.step = 1L,
.complete = FALSE,
.size = NULL,
.name_repair = c("unique", "universal", "check_unique", "minimal")) {
out <- slide(
.x,
.f,
...,
.before = .before,
.after = .after,
.step = .step,
.complete = .complete
)
vec_cbind(!!!out, .size = .size, .name_repair = .name_repair)
}
# ------------------------------------------------------------------------------
slide_impl <- function(.x,
.f,
...,
.before,
.after,
.step,
.complete,
.ptype,
.constrain,
.atomic,
.slider_error_call = caller_env()) {
vec_assert(.x, call = .slider_error_call)
.f <- as_function(.f, call = .slider_error_call)
f_call <- expr(.f(.x, ...))
type <- -1L
params <- list(
type = type,
constrain = .constrain,
atomic = .atomic,
before = .before,
after = .after,
step = .step,
complete = .complete
)
slide_common(
x = .x,
f_call = f_call,
ptype = .ptype,
env = environment(),
params = params
)
}
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.