Nothing
#' New tsibble data and append new observations to a tsibble
#'
#' `r lifecycle::badge('stable')`
#'
#' @param .data A `tbl_ts`.
#' @param n An integer indicates the number of key-index pair to append. If
#' * `n > 0`, future observations
#' * `n < 0`, past observations
#' @param ... Passed to individual S3 method.
#'
#' @rdname new-data
#' @export
new_data <- function(.data, n = 1L, ...) {
UseMethod("new_data")
}
#' @param keep_all If `TRUE` keep all the measured variables as well as index
#' and key, otherwise only index and key.
#' @rdname new-data
#' @export
#' @examples
#' new_data(pedestrian)
#' new_data(pedestrian, keep_all = TRUE)
#' new_data(pedestrian, n = 3)
#' new_data(pedestrian, n = -2)
new_data.tbl_ts <- function(.data, n = 1L, keep_all = FALSE, ...) {
if (!is_integerish(n, 1)) {
abort("Argument `n` must be an integer.")
}
abort_if_irregular(.data)
abort_unknown_interval(int <- interval(.data))
idx <- index(.data)
tunit <- default_time_units(int)
key_data <- key_data(.data)
grped_df <- new_grouped_df(.data, groups = key_data)
if (n >= 0) {
is_ord <- TRUE
last_entry <- summarise(grped_df, !!idx := max(!!idx))
} else {
is_ord <- NULL
last_entry <- summarise(grped_df, !!idx := min(!!idx))
tunit <- -tunit
}
if (length(key_data) == 1) { # no key
regrped_df <- last_entry
} else {
meta_grps <- mutate(key_data, .rows = list2(!!!vec_seq_along(last_entry)))
regrped_df <- new_grouped_df(last_entry, groups = meta_grps)
}
new_lst <- mutate(regrped_df,
!!idx := list2(
!!idx := seq_generator(!!idx, tunit, length_out = abs(n) + 1)[-1]))
out <- unwrap(ungroup(new_lst), .col = !!idx)
if (keep_all) {
out <- vec_rbind(vec_slice(.data, 0L), out)
} else { # reorder column names according to the data input
out <- out[setdiff(names(.data), measured_vars(.data))]
}
update_meta(out, .data, ordered = is_ord, interval = interval(.data))
}
#' @export
new_data.grouped_ts <- function(.data, n = 1L, keep_all = FALSE, ...) {
inform(c(
"Grouping structure is ignored.",
i = "`ungroup()` to silence this message."
))
NextMethod()
}
#' @description
#' `append_row()`: add new rows to the start/end of a tsibble by filling a key-index
#' pair and `NA` for measured variables.
#'
#' `append_case()` is an alias of `append_row()`.
#' @rdname new-data
#' @export
#' @examples
#'
#' tsbl <- tsibble(
#' date = rep(as.Date("2017-01-01") + 0:2, each = 2),
#' group = rep(letters[1:2], 3),
#' value = rnorm(6),
#' key = group
#' )
#' append_row(tsbl)
#' append_row(tsbl, n = 2)
#' append_row(tsbl, n = -2)
append_row <- function(.data, n = 1L, ...) {
UseMethod("append_row")
}
#' @export
append_row.tbl_ts <- function(.data, n = 1L, ...) {
new_data <- new_data(.data, n = n)
out <- vec_rbind(as_tibble(.data), as_tibble(new_data))
ord <- is_ordered(.data)
if (ord) ord <- NULL # re-order
update_meta(out, .data, ordered = ord, interval = interval(.data))
}
#' @export
append_row.data.frame <- function(.data, n = 1L, ...) {
abort("Do you need `tibble::add_row()` for a `tbl_df`/`data.frame`?")
}
#' @rdname new-data
#' @export
#' @usage NULL
append_case <- append_row
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.