#' Tidy Resampling Object
#'
#' The `tidy` function from the \pkg{broom} package can be used on `rset` and `rsplit` objects to generate tibbles with which rows are in the analysis and assessment sets.
#' @param x A `rset` or `rsplit` object
#' @param unique_ind Should unique row identifiers be returned? For example, if `FALSE` then bootstrapping results will include multiple rows in the sample for the same row in the original data.
#' @param ... Not currently used.
#' @return A tibble with columns `Row` and `Data`. The latter has possible values "Analysis" or "Assessment". For `rset` inputs, identification columns are also returned but their names and values depend on the type of resampling. `vfold_cv` contains a column "Fold" and, if repeats are used, another called "Repeats". `bootstraps` and `mc_cv` use the column "Resample".
#' @details Note that for nested resampling, the rows of the inner resample,
#' named `inner_Row`, are *relative* row indices and do not
#' correspond to the rows in the original data set.
#' @examples
#' library(ggplot2)
#' theme_set(theme_bw())
#'
#' set.seed(4121)
#' cv <- tidy(vfold_cv(mtcars, v = 5))
#' ggplot(cv, aes(x = Fold, y = Row, fill = Data)) +
#' geom_tile() + scale_fill_brewer()
#'
#' set.seed(4121)
#' rcv <- tidy(vfold_cv(mtcars, v = 5, repeats = 2))
#' ggplot(rcv, aes(x = Fold, y = Row, fill = Data)) +
#' geom_tile() + facet_wrap(~Repeat) + scale_fill_brewer()
#'
#' set.seed(4121)
#' mccv <- tidy(mc_cv(mtcars, times = 5))
#' ggplot(mccv, aes(x = Resample, y = Row, fill = Data)) +
#' geom_tile() + scale_fill_brewer()
#'
#' set.seed(4121)
#' bt <- tidy(bootstraps(mtcars, time = 5))
#' ggplot(bt, aes(x = Resample, y = Row, fill = Data)) +
#' geom_tile() + scale_fill_brewer()
#'
#' dat <- data.frame(day = 1:30)
#' # Resample by week instead of day
#' ts_cv <- rolling_origin(dat, initial = 7, assess = 7,
#' skip = 6, cumulative = FALSE)
#' ts_cv <- tidy(ts_cv)
#' ggplot(ts_cv, aes(x = Resample, y = factor(Row), fill = Data)) +
#' geom_tile() + scale_fill_brewer()
#' @importFrom broom tidy
#' @importFrom dplyr bind_rows arrange_
#' @importFrom tibble tibble
#' @export
tidy.rsplit <- function(x, unique_ind = TRUE, ...) {
if(unique_ind) x$in_id <- unique(x$in_id)
out <- tibble(Row = c(x$in_id, complement(x)),
Data = rep(c("Analysis", "Assessment"),
c(length(x$in_id), length(complement(x)))))
out <- dplyr::arrange_(.data = out, .dots=c("Data","Row"))
out
}
#' @rdname tidy.rsplit
#' @export
#' @inheritParams tidy.rsplit
#' @importFrom dplyr arrange
tidy.rset <- function(x, ...) {
stacked <- purrr::map(x$splits, tidy)
for(i in seq(along = stacked))
stacked[[i]]$Resample <- x$id[i]
stacked <- dplyr::bind_rows(stacked)
stacked <- dplyr::arrange_(.data = stacked, .dots=c("Data","Row"))
stacked
}
#' @rdname tidy.rsplit
#' @export
#' @inheritParams tidy.rsplit
#' @importFrom dplyr arrange
tidy.vfold_cv <- function(x, ...) {
stacked <- purrr::map(x$splits, tidy)
for (i in seq(along = stacked)) {
if (attr(x, "repeats") > 1) {
stacked[[i]]$Repeat <- x$id[i]
stacked[[i]]$Fold <- x$id2[i]
} else
stacked[[i]]$Fold <- x$id[i]
}
stacked <- dplyr::bind_rows(stacked)
stacked <- dplyr::arrange_(.data = stacked, .dots=c("Data","Row"))
stacked
}
#' @rdname tidy.rsplit
#' @export
#' @inheritParams tidy.rsplit
#' @importFrom dplyr arrange full_join
#' @importFrom tidyr unnest
#' @importFrom purrr map
tidy.nested_cv <- function(x, ...) {
x$inner_tidy <- purrr::map(x$inner_resamples, tidy_wrap)
inner_tidy <- tidyr::unnest(x, inner_tidy)
class(x) <- class(x)[class(x) != "nested_cv"]
outer_tidy <- tidy(x)
id_cols <- names(outer_tidy)
id_cols <- id_cols[!(id_cols %in% c("Row", "Data"))]
inner_id <- grep("^id", names(inner_tidy))
if(length(inner_id) != length(id_cols))
stop("Cannot merge tidt data sets", call. = FALSE)
names(inner_tidy)[inner_id] <- id_cols
full_join(outer_tidy, inner_tidy, by = id_cols)
}
tidy_wrap <- function(x) {
x <- tidy(x)
names(x) <- paste0("inner_", names(x))
x
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.