/R/ks-tidiers.R
https://github.com/tidymodels/broom · R · 70 lines · 24 code · 2 blank · 44 comment · 0 complexity · 6e8231eb2990b2dee4dc6e76a4e1a226 MD5 · raw file
- #' @templateVar class kde
- #' @template title_desc_tidy
- #'
- #' @param x A `kde` object returned from [ks::kde()].
- #' @template param_unused_dots
- #'
- #' @evalRd return_tidy("obs", "variable", "value", "estimate")
- #'
- #' @details Returns a data frame in long format with four columns. Use
- #' \code{tidyr::pivot_wider(..., names_from = variable, values_from = value)}
- #' on the output to return to a wide format.
- #'
- #' @examples
- #'
- #' library(ks)
- #'
- #' dat <- replicate(2, rnorm(100))
- #' k <- kde(dat)
- #'
- #' td <- tidy(k)
- #' td
- #'
- #' library(ggplot2)
- #' library(dplyr)
- #' library(tidyr)
- #'
- #' td %>%
- #' pivot_wider(c(obs, estimate),
- #' names_from = variable,
- #' values_from = value
- #' ) %>%
- #' ggplot(aes(x1, x2, fill = estimate)) +
- #' geom_tile() +
- #' theme_void()
- #'
- #' # also works with 3 dimensions
- #' dat3 <- replicate(3, rnorm(100))
- #' k3 <- kde(dat3)
- #'
- #' td3 <- tidy(k3)
- #' td3
- #' @export
- #' @aliases kde_tidiers ks_tidiers
- #' @seealso [tidy()], [ks::kde()]
- tidy.kde <- function(x, ...) {
- estimate <- x$estimate %>%
- as.data.frame.table(responseName = "value") %>%
- dplyr::mutate_if(is.factor, as.integer)
- dims <- seq_len(length(x$eval.points))
- purrr::map2(
- x$eval.points,
- estimate[dims],
- function(e, d) e[d]
- ) %>%
- purrr::set_names(paste0("x", dims)) %>%
- as_tibble() %>%
- mutate(
- estimate = estimate$value,
- obs = row_number()
- ) %>%
- pivot_longer(
- cols = c(dplyr::everything(), -estimate, -obs),
- names_to = "variable",
- values_to = "value"
- ) %>%
- arrange(variable, obs) %>%
- select(obs, variable, value, estimate)
- }