flow <- function(x, initial = "Initial population") {
flow_table <- tibble::tibble(
step = initial,
included = nrow(x),
excluded = NA_integer_
)
new_flow(x, flow_table = flow_table)
}
#' @export
track <- flow
new_flow <- function(x, flow_table, ..., class = NULL) {
tibble::new_tibble(x,
flow_table = flow_table,
...,
class = c(class, "flow_df")
)
}
unflow <- function(x) {
structure(x, flow_table = NULL, class = setdiff(class(x), "flow_df"))
}
as_tibble.flow_df <- function(x, ...) {
as_tibble(unflow(x), ...)
}
as.data.frame.flow_df <- function(x, ...) {
as.data.frame(unflow(x), ...)
}
as_flow <- function(x, ...) {
UseMethod("as_flow")
}
as_flow.flow_df <- function(x, ...) x
as_flow.data.frame <- function(x, ...) {
flow(x)
}
reconstruct <- function(new, old) {
UseMethod("reconstruct", old)
}
reconstruct.flow_df <- function(new, old) {
new_flow(new, flow_table = flow_table(old))
}
flow_table <- function(x, ...) {
UseMethod("flow_table")
}
flow_table.flow_df <- function(x, ...) {
attr(x, "flow_table")
}
flow_table.data.frame <- function(x, ...) {
NULL
}
#' @export
chart <- function(x, ...) {
UseMethod("chart")
}
#' @export
chart.default <- function(x, ...) {
flow_table(x, ...)
}
set_flow_table <- function(x, value) {
attr(x, "flow_table") <- value
x
}
`flow_table<-` <- function(x, value) {
set_flow_table(x, value)
}
add_step <- function(x, step, n_incl, n_excl) {
old <- flow_table(x)
new <- tibble::add_row(old,
step = step,
included = n_incl,
excluded = n_excl
)
set_flow_table(x, new)
}
update_flow <- function(included, original, step) {
n_incl <- nrow(included)
n_excl <- nrow(original) - n_incl
add_step(included, step, n_incl, n_excl)
}
step_auto_name <- function(...) {
paste(dots_text(...), collapse = " & ")
}
dots_text <- function(...) {
vapply(rlang::enexprs(...), rlang::expr_text, character(1))
}
all.equal.flow_df <- function(target, current, ...) {
msg <- attr.all.equal(target, current)
if (is.null(msg)) return(NextMethod())
if (isTRUE(next_msg <- NextMethod()))
msg else c(msg, next_msg)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.