├── .gitignore ├── .Rbuildignore ├── tests ├── testthat.R └── testthat │ └── test-reactibble.R ├── tools ├── intro1.png ├── intro2.png └── rstudio.png ├── man ├── refresh.Rd ├── tibble_methods.Rd ├── reactibble.Rd ├── is_reactibble.Rd ├── pillar_methods.Rd ├── materialize.Rd ├── as_reactibble.Rd ├── rt_add_row.Rd ├── mutate.reactibble.Rd ├── rt_bind_cols.Rd ├── rt_bind_rows.Rd └── dplyr_methods.Rd ├── reactibble.Rproj ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── refresh.R ├── zz.R ├── print.R ├── utils.R ├── joins.R ├── mutate.R ├── vctrs.R └── wrappers.R ├── README.Rmd └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^reactibble\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(reactibble) 3 | 4 | test_check("reactibble") 5 | -------------------------------------------------------------------------------- /tools/intro1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/moodymudskipper/reactibble/HEAD/tools/intro1.png -------------------------------------------------------------------------------- /tools/intro2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/moodymudskipper/reactibble/HEAD/tools/intro2.png -------------------------------------------------------------------------------- /tools/rstudio.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/moodymudskipper/reactibble/HEAD/tools/rstudio.png -------------------------------------------------------------------------------- /man/refresh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/refresh.R 3 | \name{refresh} 4 | \alias{refresh} 5 | \title{Refresh dynamic columns manually} 6 | \usage{ 7 | refresh(x) 8 | } 9 | \arguments{ 10 | \item{x}{object} 11 | } 12 | \description{ 13 | Refresh dynamic columns manually 14 | } 15 | -------------------------------------------------------------------------------- /man/tibble_methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.R 3 | \name{tibble_methods} 4 | \alias{tibble_methods} 5 | \alias{tbl_sum.reactibble} 6 | \title{tibble methods} 7 | \usage{ 8 | tbl_sum.reactibble(x) 9 | } 10 | \arguments{ 11 | \item{x}{Object to summarise} 12 | } 13 | \description{ 14 | tibble methods 15 | } 16 | -------------------------------------------------------------------------------- /man/reactibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{reactibble} 4 | \alias{reactibble} 5 | \title{Build a reactibble object} 6 | \usage{ 7 | reactibble(...) 8 | } 9 | \arguments{ 10 | \item{...}{A set of name-value pairs, use \code{~} to define a reactive column} 11 | } 12 | \description{ 13 | Build a reactibble object 14 | } 15 | -------------------------------------------------------------------------------- /man/is_reactibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{is_reactibble} 4 | \alias{is_reactibble} 5 | \title{Convert to a reactibble object} 6 | \usage{ 7 | is_reactibble(x) 8 | } 9 | \arguments{ 10 | \item{x}{A data frame, list, matrix, or other object that could reasonably be coerced to a tibble.} 11 | } 12 | \description{ 13 | Convert to a reactibble object 14 | } 15 | -------------------------------------------------------------------------------- /man/pillar_methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.R 3 | \name{pillar_methods} 4 | \alias{pillar_methods} 5 | \alias{pillar_shaft.reactive_col} 6 | \title{pillar methods} 7 | \usage{ 8 | pillar_shaft.reactive_col(x, ...) 9 | } 10 | \arguments{ 11 | \item{x}{A vector to format} 12 | 13 | \item{...}{Arguments passed to methods.} 14 | } 15 | \description{ 16 | pillar methods 17 | } 18 | -------------------------------------------------------------------------------- /man/materialize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{materialize} 4 | \alias{materialize} 5 | \title{convert reactive columns to static columns} 6 | \usage{ 7 | materialize(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{a reactibble object} 11 | 12 | \item{...}{bare column names} 13 | } 14 | \description{ 15 | If no column names are provided, the full reactibble is materialized. The 16 | class "reactibble" is preserved. 17 | } 18 | -------------------------------------------------------------------------------- /reactibble.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | LineEndingConversion: Posix 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/as_reactibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{as_reactibble} 4 | \alias{as_reactibble} 5 | \title{Convert to a reactibble object} 6 | \usage{ 7 | as_reactibble( 8 | x, 9 | ..., 10 | .rows = NULL, 11 | .name_repair = c("check_unique", "unique", "universal", "minimal"), 12 | rownames = pkgconfig::get_config("tibble::rownames", NULL) 13 | ) 14 | } 15 | \arguments{ 16 | \item{x}{forwarded to tibble::as_tibble} 17 | 18 | \item{...}{forwarded to tibble::as_tibble} 19 | 20 | \item{.rows}{forwarded to tibble::as_tibble} 21 | 22 | \item{.name_repair}{forwarded to tibble::as_tibble} 23 | 24 | \item{rownames}{forwarded to tibble::as_tibble} 25 | } 26 | \description{ 27 | Convert to a reactibble object 28 | } 29 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: reactibble 2 | Title: Use Dynamic Columns in Data Frames 3 | Version: 0.0.0.9000 4 | Authors@R: c( 5 | person(given = "Antoine", 6 | family = "Fabri", 7 | role = c("aut", "cre"), 8 | email = "antoine.fabri@gmail.com"), 9 | person(given = "Jonathan", 10 | family = "Carroll", 11 | role = c("ctb"), 12 | email = "rpkg@jcarroll.com.au", 13 | comment = c(ORCID = "0000-0002-1404-5264")) 14 | ) 15 | Description: Use dynamic columns in data frames. 16 | License: GPL-3 17 | Encoding: UTF-8 18 | Language: en 19 | LazyData: true 20 | Roxygen: list(markdown = TRUE) 21 | RoxygenNote: 7.1.1 22 | Imports: 23 | tibble, 24 | dplyr, 25 | rlang, 26 | pillar, 27 | vctrs, 28 | cli, 29 | crayon, 30 | memoise 31 | Suggests: 32 | data.table, 33 | testthat 34 | URL: https://github.com/moodymudskipper/reactibble 35 | BugReports: https://github.com/moodymudskipper/reactibble/issues 36 | -------------------------------------------------------------------------------- /man/rt_add_row.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrappers.R 3 | \name{rt_add_row} 4 | \alias{rt_add_row} 5 | \title{Add rows to a reactibble} 6 | \usage{ 7 | rt_add_row(.data, ..., .before = NULL, .after = NULL) 8 | } 9 | \arguments{ 10 | \item{.data}{Data frame to append to.} 11 | 12 | \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> 13 | Name-value pairs, passed on to \code{\link[tibble:tibble]{tibble()}}. Values can be defined 14 | only for columns that already exist in \code{.data} and unset columns will get an 15 | \code{NA} value.} 16 | 17 | \item{.before}{One-based row index where to add the new rows, 18 | default: after last row.} 19 | 20 | \item{.after}{One-based row index where to add the new rows, 21 | default: after last row.} 22 | } 23 | \description{ 24 | Counterpart of \code{tibble::add_row} that works efficiently on \emph{"reactibble"} 25 | objects. Beware of using \code{add_row()} instead as it would return an out of sync \code{reactibble} 26 | } 27 | -------------------------------------------------------------------------------- /man/mutate.reactibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mutate.R 3 | \name{mutate.reactibble} 4 | \alias{mutate.reactibble} 5 | \alias{transmute.reactibble} 6 | \title{modify a reactibble object} 7 | \usage{ 8 | mutate.reactibble(.data, ...) 9 | 10 | transmute.reactibble(.data, ...) 11 | } 12 | \arguments{ 13 | \item{.data}{A data frame, data frame extension (e.g. a tibble), or a 14 | lazy data frame (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for 15 | more details.} 16 | 17 | \item{...}{<\code{\link[dplyr:dplyr_data_masking]{data-masking}}> Name-value pairs. 18 | The name gives the name of the column in the output. 19 | 20 | The value can be: 21 | \itemize{ 22 | \item A vector of length 1, which will be recycled to the correct length. 23 | \item A vector the same length as the current group (or the whole data frame 24 | if ungrouped). 25 | \item \code{NULL}, to remove the column. 26 | \item A data frame or tibble, to create multiple columns in the output. 27 | }} 28 | } 29 | \description{ 30 | These work exactly like dplyr's mutate and transmute, except that one can 31 | define reactive columns using \code{~}. 32 | } 33 | -------------------------------------------------------------------------------- /man/rt_bind_cols.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrappers.R 3 | \name{rt_bind_cols} 4 | \alias{rt_bind_cols} 5 | \title{Efficiently bind multiple data frames by row and column} 6 | \usage{ 7 | rt_bind_cols(..., .id = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{Data frames to combine. 11 | 12 | Each argument can either be a data frame, a list that could be a data 13 | frame, or a list of data frames. 14 | 15 | When row-binding, columns are matched by name, and any missing 16 | columns will be filled with NA. 17 | 18 | When column-binding, rows are matched by position, so all data 19 | frames must have the same number of rows. To match by value, not 20 | position, see \link[dplyr]{mutate-joins}.} 21 | 22 | \item{.id}{Data frame identifier. 23 | 24 | When \code{.id} is supplied, a new column of identifiers is 25 | created to link each row to its original data frame. The labels 26 | are taken from the named arguments to \code{bind_rows()}. When a 27 | list of data frames is supplied, the labels are taken from the 28 | names of the list. If no names are found a numeric sequence is 29 | used instead.} 30 | } 31 | \description{ 32 | Counterpart of \code{dplyr::bind_cols} that works efficiently on \emph{"reactibble"} 33 | objects. \code{bind_cols()} will fail "reactibbles" so this new function was 34 | required.. 35 | } 36 | -------------------------------------------------------------------------------- /man/rt_bind_rows.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrappers.R 3 | \name{rt_bind_rows} 4 | \alias{rt_bind_rows} 5 | \title{Efficiently bind multiple data frames by row and column} 6 | \usage{ 7 | rt_bind_rows(..., .id = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{Data frames to combine. 11 | 12 | Each argument can either be a data frame, a list that could be a data 13 | frame, or a list of data frames. 14 | 15 | When row-binding, columns are matched by name, and any missing 16 | columns will be filled with NA. 17 | 18 | When column-binding, rows are matched by position, so all data 19 | frames must have the same number of rows. To match by value, not 20 | position, see \link[dplyr]{mutate-joins}.} 21 | 22 | \item{.id}{Data frame identifier. 23 | 24 | When \code{.id} is supplied, a new column of identifiers is 25 | created to link each row to its original data frame. The labels 26 | are taken from the named arguments to \code{bind_rows()}. When a 27 | list of data frames is supplied, the labels are taken from the 28 | names of the list. If no names are found a numeric sequence is 29 | used instead.} 30 | } 31 | \description{ 32 | Counterpart of \code{dplyr::bind_rows} that works efficiently on \emph{"reactibble"} 33 | objects. While \code{bind_rows()} can be used on "reactibbles" (at time of writing), 34 | it is brittle and inefficient, as it triggers more refreshes than necessary. 35 | } 36 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("$",reactibble) 4 | S3method("$<-",reactibble) 5 | S3method("[",reactibble) 6 | S3method("[",reactibble0) 7 | S3method("[<-",reactibble) 8 | S3method("[[",reactibble) 9 | S3method("[[<-",reactibble) 10 | S3method("names<-",reactibble) 11 | S3method(Ops,reactive_col) 12 | S3method(cbind,reactibble) 13 | S3method(format,pillar_shaft_reactive_col) 14 | S3method(format,pillar_shaft_unsynced) 15 | S3method(format,reactive_col) 16 | S3method(merge,reactibble) 17 | S3method(print,reactibble) 18 | S3method(rbind,reactibble) 19 | S3method(refresh,data.frame) 20 | S3method(refresh,reactibble) 21 | S3method(transform,reactibble) 22 | S3method(vec_arith,Date.reactive_col) 23 | S3method(vec_arith,POSIXct.reactive_col) 24 | S3method(vec_arith,POSIXlt.reactive_col) 25 | S3method(vec_arith,difftime.reactive_col) 26 | S3method(vec_arith,logical.reactive_col) 27 | S3method(vec_arith,numeric.reactive_col) 28 | S3method(vec_arith,reactive_col) 29 | S3method(vec_cast,double.reactive_col) 30 | S3method(vec_cast,reactive_col.double) 31 | S3method(vec_math,reactive_col) 32 | S3method(vec_ptype2,double.reactive_col) 33 | S3method(vec_ptype2,reactive_col) 34 | S3method(vec_ptype_abbr,reactive_col) 35 | S3method(with,reactibble) 36 | S3method(within,reactibble) 37 | export(anti_join.reactibble) 38 | export(as_reactibble) 39 | export(dplyr_reconstruct.reactibble) 40 | export(full_join.reactibble) 41 | export(inner_join.reactibble) 42 | export(is_reactibble) 43 | export(left_join.reactibble) 44 | export(materialize) 45 | export(mutate.reactibble) 46 | export(nest_join.reactibble) 47 | export(pillar_shaft.reactive_col) 48 | export(reactibble) 49 | export(refresh) 50 | export(right_join.reactibble) 51 | export(rt_add_row) 52 | export(rt_bind_cols) 53 | export(rt_bind_rows) 54 | export(semi_join.reactibble) 55 | export(slice.reactibble) 56 | export(tbl_sum.reactibble) 57 | export(transmute.reactibble) 58 | import(vctrs) 59 | importFrom(stats,na.omit) 60 | importFrom(stats,setNames) 61 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # reactibble 0.0.0.9000 2 | 3 | * Added a `NEWS.md` file to track changes to the package 4 | * All common ways to mutate columns are supported 5 | * Dropping/selecting columns triggers a refresh and fails explicitly if needed columns were dropped 6 | * Renaming columns changes the formulas so they use the new names 7 | * Implemented is_reactibble, and materialize 8 | * Implemented a proper printing method 9 | * When using `[[` or `$` on a reactibble, we fetch the static value 10 | * All columns created by mutate and transmute are forced to be static when `~` is 11 | not used, this means copying a column without using `~` creates a static copy 12 | * Refreshing occurs in the correct order 13 | * Dynamic columns now print in cyan, or in a custom color 14 | * Reactibble object can contain list columns 15 | * `transform.reactibble` triggers a warnings and returns a static native 16 | data.frame, consistently with how `base::transform` treat tibbles. 17 | * `within.reactibble` warns that it might be unsafe 18 | * `with.reactibble` is defined, only to make sure we don't return a "reactive_col" object 19 | * Implemented methods for {dplyr} join functions and base::merge 20 | * Optimized print so it doesn't refresh 21 | * When printing a tibble and the "reactibble.autorefresh" option is `TRUE` mark 22 | columns as "unsynced" colored in red. 23 | * Optimize process_reactive_dots so reactive columns are computed only in the end 24 | * Use quosures instead of expressions as column definitions 25 | * The reactive column is a *{vctrs}* object. 26 | * Defined a method for `dplyr::slice` 27 | * Added tests 28 | * Implemented `rt_bind_rows`, `rt_bind_cols` and `rt_add_row` as robust and efficient counterparts 29 | of `dplyr::bind_rows`, `dplyr::bind_cols` and `tibble::add_row`, which we can unfortunately not use 30 | on reactibbles reliably. 31 | * `rbind.reactibble` and `cbind.reactibble` warn that using the above is preferable, 32 | though they work. 33 | * Implemented easy way to memoise, by using M() in the reactive col definition 34 | -------------------------------------------------------------------------------- /R/refresh.R: -------------------------------------------------------------------------------- 1 | #' Refresh dynamic columns manually 2 | #' 3 | #' @param x object 4 | #' @export 5 | refresh <- function(x) { 6 | UseMethod("refresh", x) 7 | } 8 | 9 | #' @importFrom stats na.omit 10 | #' @export 11 | refresh.data.frame <- function(x) { 12 | if(!nrow(x)) return(x) 13 | # to avoid weird issue with bind_rows 14 | if(anyDuplicated(names(x))) return(x) 15 | 16 | 17 | call <- sys.call() 18 | pf <- parent.frame() 19 | unrefreshed <- sapply(x, inherits, "reactive_col") 20 | unrefreshed_vars <- lapply(x[unrefreshed], function(x) { 21 | all.vars(attr(x,"reactibble_col_def")$expr) 22 | }) 23 | while(any(unrefreshed)) { 24 | unrefreshed_bkp <- unrefreshed 25 | for(var in names(unrefreshed_vars)) { 26 | dependencies <-unrefreshed_vars[[var]] 27 | if(!any(na.omit(unrefreshed[dependencies]))){ 28 | col_def <- attr(x[[var]],"reactibble_col_def") 29 | x[[var]] <- tryCatch( 30 | eval(col_def$expr, x, col_def$env), 31 | error = function(e) { 32 | missing_vars <- setdiff(all.vars(col_def), names(x)) 33 | msg <- paste0( 34 | e$message, 35 | "\nDid you drop a necessary variable or provide an incorrect expression?") 36 | e$message <- msg 37 | e$call <- call 38 | stop(e) 39 | }) 40 | x[[var]] <- reactive_col(x[[var]], col_def) 41 | unrefreshed[var] <- FALSE 42 | unrefreshed_vars[var] <- NULL 43 | } 44 | } 45 | if(identical(unrefreshed, unrefreshed_bkp)) { 46 | stop("The definition of reactive columns is circular") 47 | } 48 | } 49 | if(getOption("reactibble.verbose.refresh")) 50 | message("refreshed 'reactibble' object") 51 | x 52 | } 53 | 54 | refresh_if_relevant <- function(data) { 55 | if(getOption("reactibble.autorefresh")) refresh(data) else data 56 | } 57 | 58 | #' @export 59 | refresh.reactibble <- function(x) { 60 | cl <- class(x) 61 | x <- refresh(strip_reactibble_class(x)) 62 | class(x) <- cl 63 | x 64 | } 65 | 66 | -------------------------------------------------------------------------------- /R/zz.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(...) { 2 | registerS3method("mutate", "reactibble", mutate.reactibble, asNamespace("dplyr")) 3 | registerS3method("transmute", "reactibble", transmute.reactibble, asNamespace("dplyr")) 4 | registerS3method("left_join", "reactibble", left_join.reactibble, asNamespace("dplyr")) 5 | registerS3method("right_join", "reactibble", right_join.reactibble, asNamespace("dplyr")) 6 | registerS3method("inner_join", "reactibble", inner_join.reactibble, asNamespace("dplyr")) 7 | registerS3method("full_join", "reactibble", full_join.reactibble, asNamespace("dplyr")) 8 | registerS3method("anti_join", "reactibble", anti_join.reactibble, asNamespace("dplyr")) 9 | registerS3method("semi_join", "reactibble", semi_join.reactibble, asNamespace("dplyr")) 10 | registerS3method("nest_join", "reactibble", nest_join.reactibble, asNamespace("dplyr")) 11 | registerS3method("dplyr_reconstruct", "reactibble", dplyr_reconstruct.reactibble, asNamespace("dplyr")) 12 | registerS3method("slice", "reactibble", slice.reactibble, asNamespace("dplyr")) 13 | #registerS3method("as_tibble", "reactibble", as_tibble.reactibble, asNamespace("tibble")) 14 | registerS3method("vec_ptype_abbr", "reactive_col", vec_ptype_abbr.reactive_col, asNamespace("vctrs")) 15 | registerS3method("pillar_shaft", "reactive_col", pillar_shaft.reactive_col, asNamespace("pillar")) 16 | registerS3method("tbl_sum", "reactibble", tbl_sum.reactibble, asNamespace("tibble")) 17 | 18 | #registerS3method("vec_arith", "default", vec_arith.default, asNamespace("vctrs")) 19 | 20 | 21 | # setHook(packageEvent("data.table", "onLoad"), function(...) { 22 | # registerS3method( 23 | # "as.data.table", "reactibble", 24 | # as.data.table.reactibble, asNamespace("data.table"))}) 25 | 26 | op <- options() 27 | op.reactibble <- list( 28 | reactibble.autorefresh = TRUE, 29 | reactibble.highlight = crayon::cyan, # set to NULL to disable 30 | reactibble.verbose.refresh = FALSE 31 | ) 32 | toset <- !(names(op.reactibble) %in% names(op)) 33 | if(any(toset)) options(op.reactibble[toset]) 34 | invisible() 35 | } 36 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.reactibble <- function(x, ..., n = NULL, width = NULL, n_extra = NULL) { 3 | txt <- format(as_reactibble0(x), ..., n = n, width = width, n_extra = n_extra) 4 | cli::cat_line(txt) 5 | invisible(x) 6 | } 7 | 8 | # we define a class reactibble0 so we can print without calling [.reactibble, 9 | # which is costly as it triggers a refresh 10 | 11 | as_reactibble0 <- function(x) { 12 | class(x) <- c("reactibble0", class(x)) 13 | x 14 | } 15 | 16 | # #' @export 17 | # as.data.frame.reactibble0 <- function(x) { 18 | # class(x) <- "data.frame" 19 | # x 20 | # } 21 | 22 | #' @export 23 | `[.reactibble0` <- function(x, ...) { 24 | class(x) <- setdiff(class(x), c("reactibble0", "reactibble")) 25 | x <- x[...] 26 | class(x) <- c("reactibble0", "reactibble", class(x)) 27 | x 28 | } 29 | 30 | #' tibble methods 31 | #' @inheritParams tibble::tbl_sum 32 | #' @export 33 | #' @name tibble_methods 34 | tbl_sum.reactibble <- function (x){ 35 | f <- getOption("reactibble.highlight") %||% c 36 | setNames(paste(nrow(x), "x", ncol(x)), paste("A", f("reactibble"))) 37 | } 38 | 39 | #' pillar methods 40 | #' @inheritParams pillar::pillar_shaft 41 | #' @export 42 | #' @name pillar_methods 43 | pillar_shaft.reactive_col <- function(x, ...) { 44 | printing_tibble <- 45 | list(quote(print.tbl(x))) %in% as.list(sys.calls()) 46 | if(printing_tibble && getOption("reactibble.autorefresh")) { 47 | placeholder <- "unsynced!!!" 48 | pillar::new_pillar_shaft( 49 | rep_len(placeholder, length(x)), 50 | class = "pillar_shaft_unsynced", 51 | align = "left", na_indent = 5, width = nchar(placeholder)) 52 | } else { 53 | # create the pillar from the original class 54 | shaft <- pillar::pillar_shaft(strip_reactive_col(x), ...) 55 | # add a class so it can be forwarded to the right format method 56 | class(shaft) <- c("pillar_shaft_reactive_col", class(shaft)) 57 | shaft 58 | } 59 | } 60 | 61 | #' @export 62 | format.pillar_shaft_reactive_col<- function(x, ...) { 63 | f <- getOption("reactibble.highlight") %||% c 64 | # apply format method for original class 65 | fmt<- NextMethod() 66 | # add color to output, preserving the attributes by using []<- 67 | if(!is.null(getOption("reactibble.highlight"))) { 68 | # deal with lists, which are already colored by crayon 69 | fmt[] <- gsub("\033\\[90m(.*?)\033\\[39m", "\\1", fmt) 70 | fmt[] <- f(fmt) 71 | } 72 | fmt 73 | } 74 | 75 | #' @export 76 | format.pillar_shaft_unsynced <- function(x, ...) { 77 | format(crayon::red(x)) 78 | } 79 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # set_formula_en 2 | # 3 | # quosure2formula <- function(q) { 4 | # 5 | # } 6 | 7 | 8 | #' Convert to a reactibble object 9 | #' @param x A data frame, list, matrix, or other object that could reasonably be coerced to a tibble. 10 | #' 11 | #' @export 12 | is_reactibble <- function(x) { 13 | inherits(x, "reactibble") 14 | } 15 | 16 | is_reactive_col <- function(x) { 17 | inherits(x, "reactive_col") 18 | } 19 | 20 | 21 | #' Convert to a reactibble object 22 | #' 23 | #' @param x forwarded to tibble::as_tibble 24 | #' @param ... forwarded to tibble::as_tibble 25 | #' @param .rows forwarded to tibble::as_tibble 26 | #' @param .name_repair forwarded to tibble::as_tibble 27 | #' @param rownames forwarded to tibble::as_tibble 28 | #' @export 29 | as_reactibble <- function( 30 | x, ..., .rows = NULL, 31 | .name_repair = c("check_unique", "unique", "universal", "minimal"), 32 | rownames = pkgconfig::get_config("tibble::rownames", NULL )) { 33 | if(is_reactibble(x)) { 34 | class(x) <- c("reactibble", "tbl_df", "tbl", "data.frame") 35 | return(x) 36 | } 37 | x <- tibble::as_tibble( 38 | x, ..., .rows = .rows, .name_repair = .name_repair, rownames = rownames) 39 | class(x) <- union("reactibble", class(x)) 40 | x 41 | } 42 | 43 | #' Build a reactibble object 44 | #' @param ... A set of name-value pairs, use `~` to define a reactive column 45 | #' 46 | #' @export 47 | reactibble <- function(...) { 48 | dots <- process_reactive_dots(...) 49 | x <- dplyr::tibble(!!!dots) 50 | x <- process_reactive_output(x, dots) 51 | as_reactibble(x) 52 | } 53 | 54 | strip_reactibble_class <- function(x) { 55 | class(x) <- setdiff(attr(x, "class"), "reactibble") 56 | x 57 | } 58 | 59 | as_reactive_col <- function(x, expr) { 60 | if(is.list(x)) 61 | # to work around tibble issue 62 | class(x) <- union(c("reactive_col", "list"), attr(x, "class")) 63 | else 64 | class(x) <- union("reactive_col", attr(x, "class")) 65 | attr(x,"reactibble_col_def") <- expr 66 | x 67 | } 68 | 69 | strip_reactive_col <- function(x) { 70 | # we need this wrapper because vec_data smodifies some non vcrts objects like data frames 71 | if(is_reactive_col(x)) vec_data(x) else x 72 | } 73 | 74 | #' convert reactive columns to static columns 75 | #' 76 | #' If no column names are provided, the full reactibble is materialized. The 77 | #' class "reactibble" is preserved. 78 | #' 79 | #' @param x a reactibble object 80 | #' @param ... bare column names 81 | #' @export 82 | materialize <- function(x, ...) { 83 | x <- strip_reactibble_class(x) 84 | if (! ...length()) { 85 | x[] <- lapply(x, strip_reactive_col) 86 | } else { 87 | cols <- sapply(eval(substitute(alist(...))), deparse1) 88 | x[cols] <- lapply(x[cols], strip_reactive_col) 89 | } 90 | as_reactibble(x) 91 | } 92 | 93 | `%||%` <- function(x, y) { 94 | if (is.null(x)) 95 | y 96 | else x 97 | } 98 | -------------------------------------------------------------------------------- /R/joins.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | merge.reactibble <- function (x, y, ...) { 4 | warning("`merge` when called on 'reactibble' objects return a static data frame, ", 5 | "use dplyr join functions to preserve reactive columns") 6 | merge( 7 | as.data.frame(materialize(x)), 8 | as.data.frame(materialize(y)), 9 | ...) 10 | } 11 | 12 | check_join_by_arg <- function(x, y, by) { 13 | nms.x <- names(x) 14 | nms.y <- names(y) 15 | if(is.null(by)) { 16 | by.x <- by.y <- intersect(nms.x, nms.y) 17 | } else if(is.null(names(by))) { 18 | by.x <- by.y <- by 19 | } else { 20 | by.x <- unname(by) 21 | by.y <- names(by) 22 | } 23 | 24 | wrong_by.x <- intersect(by.x, nms.x[sapply(x, inherits, "reactive_col")]) 25 | if(length(wrong_by.x)) { 26 | stop(sprintf("In `x`, attempt to join by reactive column(s): %s", 27 | toString(paste0("`", wrong_by.x, "`")))) 28 | } 29 | wrong_by.y <- intersect(by.y, nms.y[sapply(x, inherits, "reactive_col")]) 30 | if(length(wrong_by.y)) { 31 | stop(sprintf("In `y`, attempt to join by reactive column(s): %s", 32 | toString(paste0("`", wrong_by.y, "`")))) 33 | } 34 | } 35 | 36 | #' dplyr methods 37 | #' @export 38 | #' @inheritParams dplyr::left_join 39 | #' @inheritParams dplyr::nest_join 40 | #' @name dplyr_methods 41 | left_join.reactibble <- function ( 42 | x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ..., keep = FALSE) { 43 | check_join_by_arg(x, y, by) 44 | data <- NextMethod() 45 | refresh_if_relevant(data) 46 | } 47 | 48 | #' @export 49 | #' @rdname dplyr_methods 50 | right_join.reactibble <- function ( 51 | x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ..., keep = FALSE) { 52 | check_join_by_arg(x, y, by) 53 | data <- NextMethod() 54 | refresh_if_relevant(data) 55 | } 56 | 57 | #' @export 58 | #' @rdname dplyr_methods 59 | inner_join.reactibble <- function ( 60 | x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ..., keep = FALSE) { 61 | check_join_by_arg(x, y, by) 62 | data <- NextMethod() 63 | refresh_if_relevant(data) 64 | } 65 | 66 | #' @export 67 | #' @rdname dplyr_methods 68 | full_join.reactibble <- function ( 69 | x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ..., keep = FALSE) { 70 | check_join_by_arg(x, y, by) 71 | data <- NextMethod() 72 | refresh_if_relevant(data) 73 | } 74 | 75 | #' @export 76 | #' @rdname dplyr_methods 77 | anti_join.reactibble <- function ( 78 | x, y, by = NULL, copy = FALSE, ...) { 79 | check_join_by_arg(x, y, by) 80 | data <- NextMethod() 81 | refresh_if_relevant(data) 82 | } 83 | 84 | #' @export 85 | #' @rdname dplyr_methods 86 | semi_join.reactibble <- function ( 87 | x, y, by = NULL, copy = FALSE, ...) { 88 | check_join_by_arg(x, y, by) 89 | data <- NextMethod() 90 | refresh_if_relevant(data) 91 | } 92 | 93 | #' @export 94 | #' @rdname dplyr_methods 95 | nest_join.reactibble <- function ( 96 | x, y, by = NULL, copy = FALSE, keep = FALSE, name = NULL, ...) { 97 | check_join_by_arg(x, y, by) 98 | data <- NextMethod() 99 | refresh_if_relevant(data) 100 | } 101 | 102 | -------------------------------------------------------------------------------- /R/mutate.R: -------------------------------------------------------------------------------- 1 | process_reactive_dots <- function(...) { 2 | dots <- rlang::enquos(...) 3 | lapply(dots, function(x) { 4 | expr <- rlang::quo_get_expr(x) 5 | expr_is_reactive <- is.call(expr) && identical(expr[[1]], quote(`~`)) 6 | if(expr_is_reactive) { 7 | env <- attr(x, ".Environment") 8 | # check if we find a call to M 9 | expr_uses_M <- "M" %in% setdiff(all.names(expr), all.vars(expr)) 10 | if(expr_uses_M) { 11 | env <- setup_memoise_env(expr, env) 12 | } 13 | x <- reactive_col(NA, list( 14 | expr = expr[[2]], 15 | env = env 16 | )) 17 | } 18 | x 19 | }) 20 | } 21 | 22 | setup_memoise_env <- function(expr, env) { 23 | # for notes 24 | ..memoised_funs.. <- NULL 25 | M_inputs <- list() 26 | recurse <- function(expr) { 27 | if(!is.call(expr)) 28 | return(invisible(NULL)) 29 | if(identical(expr[[1]], quote(M))) 30 | M_inputs <<- c(M_inputs, expr[[2]]) 31 | else 32 | lapply(expr, recurse) 33 | invisible(NULL) 34 | } 35 | lapply(expr[[2]], recurse) 36 | # wrap in memoise 37 | M_inputs_m <- lapply(M_inputs, function(x) as.call(c(quote(memoise::memoise), x))) 38 | memoised_funs <- lapply(M_inputs_m, eval, env) 39 | names(memoised_funs) <- sapply(M_inputs, deparse1) 40 | # reinitiate our environment as a chiled of the quosure env 41 | env <- new.env(parent = env) 42 | # store memoised functions and M 43 | env$..memoised_funs.. <- memoised_funs 44 | env$M <- function(x) ..memoised_funs..[[deparse1(substitute(x))]] 45 | environment(env$M) <- env 46 | env 47 | } 48 | 49 | 50 | process_reactive_output <- function(x, dots) { 51 | # keep last definition of all modified/created vars 52 | dots <- dots[!duplicated(names(dots), fromLast = TRUE)] 53 | nms <- names(dots) 54 | # for those remove class "reactive_col" if it wasn't defined as a reactive col 55 | # (so copying a reactive_col without using "~" creates a static copy) 56 | # if it was defined as such, add the class 57 | x[nms] <- lapply(nms, function(nm) { 58 | expr <- attr(dots[[nm]], "reactibble_col_def") 59 | col <- .subset2(x, nm) 60 | if (is.null(expr)) { 61 | if (is_reactive_col(col)) col <- vec_data(col) 62 | } else { 63 | col <- reactive_col(col, expr) 64 | } 65 | col 66 | }) 67 | 68 | refresh_if_relevant(x) 69 | } 70 | 71 | #' modify a reactibble object 72 | #' 73 | #' These work exactly like dplyr's mutate and transmute, except that one can 74 | #' define reactive columns using `~`. 75 | #' @export 76 | #' @inheritParams dplyr::mutate 77 | #' @rdname mutate.reactibble 78 | mutate.reactibble <- function(.data, ...) { 79 | cl <- class(.data) 80 | dots <- process_reactive_dots(...) 81 | .data <- dplyr::mutate(strip_reactibble_class(.data), !!!dots) 82 | .data <- process_reactive_output(.data, dots) 83 | class(.data) <- cl 84 | .data 85 | } 86 | 87 | #' @export 88 | #' @rdname mutate.reactibble 89 | transmute.reactibble <- function(.data, ...) { 90 | cl <- class(.data) 91 | dots <- process_reactive_dots(...) 92 | .data <- dplyr::transmute(strip_reactibble_class(.data), !!!dots) 93 | .data <- process_reactive_output(.data, dots) 94 | class(.data) <- cl 95 | .data 96 | } 97 | -------------------------------------------------------------------------------- /R/vctrs.R: -------------------------------------------------------------------------------- 1 | 2 | #' @import vctrs 3 | NULL 4 | 5 | 6 | new_reactive_col <- function( 7 | x = logical(), 8 | reactibble_col_def = list(expr = quote(expr=), env = .GlobalEnv)) { 9 | new_vctr(x, reactibble_col_def = reactibble_col_def, class = "reactive_col") 10 | } 11 | 12 | # for reactive cols we don't need to cast the input 13 | reactive_col <- function( 14 | x = logical(), 15 | reactibble_col_def = list(expr = quote(expr=), env = .GlobalEnv)) { 16 | new_reactive_col(x, reactibble_col_def) 17 | } 18 | 19 | # our format method fetches the data and forwards it to its format method 20 | 21 | #' @export 22 | format.reactive_col <- function(x, ...) { 23 | out <- format(vec_data(x)) 24 | out[is.na(x)] <- NA 25 | out 26 | } 27 | 28 | #' @export 29 | vec_ptype_abbr.reactive_col <- function(x, ...) { 30 | # the vec_ptype_abbr depends on the input 31 | paste0("~", vec_ptype_abbr(vec_data(x))) 32 | } 33 | 34 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 35 | # vec_cast methods 36 | 37 | #' @export 38 | vec_ptype2.reactive_col <- function(x, y, ...) new_reactive_col() 39 | 40 | #' @export 41 | vec_ptype2.double.reactive_col <- function(x, y, ...) double() 42 | 43 | #' @export 44 | vec_cast.reactive_col.double <- function(x, to, ...) x 45 | 46 | #' @export 47 | vec_cast.double.reactive_col <- function(x, to, ...) vec_data(x) 48 | 49 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 50 | # vec_math methods 51 | 52 | #' @export 53 | vec_math.reactive_col <- function(.fn, .x, ...) { 54 | vec_math_base(.fn, vec_data(.x), ...) 55 | } 56 | 57 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 58 | # proxy methods 59 | 60 | # I give up 61 | 62 | #' @export 63 | Ops.reactive_col <- function(e1, e2 = NULL) { 64 | if(is_reactive_col(e1)) e1 <- vec_data(e1) 65 | if(is_reactive_col(e2)) e2 <- vec_data(e2) 66 | FUN <- get(.Generic, envir = parent.frame(), mode = "function") 67 | FUN(e1,e2) 68 | } 69 | 70 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 71 | # arith methods 72 | 73 | #' @export 74 | vec_arith.reactive_col <- function(op, x, y, ...) { 75 | if(is_reactive_col(y)) 76 | vec_arith_base(op, vec_data(x), vec_data(y)) 77 | else 78 | vec_arith_base(op, vec_data(x), y) 79 | } 80 | 81 | 82 | #' @export 83 | vec_arith.difftime.reactive_col <- function(op, x, y, ...) { 84 | vec_arith_base(op, vec_data(x), vec_data(y)) 85 | } 86 | 87 | #' @export 88 | vec_arith.logical.reactive_col <- function(op, x, y, ...) { 89 | vec_arith_base(op, vec_data(x), vec_data(y)) 90 | } 91 | 92 | #' @export 93 | vec_arith.numeric.reactive_col <- function(op, x, y, ...) { 94 | vec_arith_base(op, vec_data(x), vec_data(y)) 95 | } 96 | 97 | #' @export 98 | vec_arith.POSIXct.reactive_col <- function(op, x, y, ...) { 99 | vec_arith_base(op, vec_data(x), vec_data(y)) 100 | } 101 | 102 | #' @export 103 | vec_arith.POSIXlt.reactive_col <- function(op, x, y, ...) { 104 | vec_arith_base(op, vec_data(x), vec_data(y)) 105 | } 106 | 107 | #' @export 108 | vec_arith.Date.reactive_col <- function(op, x, y, ...) { 109 | vec_arith_base(op, vec_data(x), vec_data(y)) 110 | } 111 | -------------------------------------------------------------------------------- /man/dplyr_methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/joins.R, R/wrappers.R 3 | \name{dplyr_methods} 4 | \alias{dplyr_methods} 5 | \alias{left_join.reactibble} 6 | \alias{right_join.reactibble} 7 | \alias{inner_join.reactibble} 8 | \alias{full_join.reactibble} 9 | \alias{anti_join.reactibble} 10 | \alias{semi_join.reactibble} 11 | \alias{nest_join.reactibble} 12 | \alias{dplyr_reconstruct.reactibble} 13 | \alias{slice.reactibble} 14 | \title{dplyr methods} 15 | \usage{ 16 | left_join.reactibble( 17 | x, 18 | y, 19 | by = NULL, 20 | copy = FALSE, 21 | suffix = c(".x", ".y"), 22 | ..., 23 | keep = FALSE 24 | ) 25 | 26 | right_join.reactibble( 27 | x, 28 | y, 29 | by = NULL, 30 | copy = FALSE, 31 | suffix = c(".x", ".y"), 32 | ..., 33 | keep = FALSE 34 | ) 35 | 36 | inner_join.reactibble( 37 | x, 38 | y, 39 | by = NULL, 40 | copy = FALSE, 41 | suffix = c(".x", ".y"), 42 | ..., 43 | keep = FALSE 44 | ) 45 | 46 | full_join.reactibble( 47 | x, 48 | y, 49 | by = NULL, 50 | copy = FALSE, 51 | suffix = c(".x", ".y"), 52 | ..., 53 | keep = FALSE 54 | ) 55 | 56 | anti_join.reactibble(x, y, by = NULL, copy = FALSE, ...) 57 | 58 | semi_join.reactibble(x, y, by = NULL, copy = FALSE, ...) 59 | 60 | nest_join.reactibble( 61 | x, 62 | y, 63 | by = NULL, 64 | copy = FALSE, 65 | keep = FALSE, 66 | name = NULL, 67 | ... 68 | ) 69 | 70 | dplyr_reconstruct.reactibble(data, template) 71 | 72 | slice.reactibble(.data, ..., .preserve = FALSE) 73 | } 74 | \arguments{ 75 | \item{x}{A pair of data frames, data frame extensions (e.g. a tibble), or 76 | lazy data frames (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for 77 | more details.} 78 | 79 | \item{y}{A pair of data frames, data frame extensions (e.g. a tibble), or 80 | lazy data frames (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for 81 | more details.} 82 | 83 | \item{by}{A character vector of variables to join by. 84 | 85 | If \code{NULL}, the default, \verb{*_join()} will perform a natural join, using all 86 | variables in common across \code{x} and \code{y}. A message lists the variables so that you 87 | can check they're correct; suppress the message by supplying \code{by} explicitly. 88 | 89 | To join by different variables on \code{x} and \code{y}, use a named vector. 90 | For example, \code{by = c("a" = "b")} will match \code{x$a} to \code{y$b}. 91 | 92 | To join by multiple variables, use a vector with length > 1. 93 | For example, \code{by = c("a", "b")} will match \code{x$a} to \code{y$a} and \code{x$b} to 94 | \code{y$b}. Use a named vector to match different variables in \code{x} and \code{y}. 95 | For example, \code{by = c("a" = "b", "c" = "d")} will match \code{x$a} to \code{y$b} and 96 | \code{x$c} to \code{y$d}. 97 | 98 | To perform a cross-join, generating all combinations of \code{x} and \code{y}, 99 | use \code{by = character()}.} 100 | 101 | \item{copy}{If \code{x} and \code{y} are not from the same data source, 102 | and \code{copy} is \code{TRUE}, then \code{y} will be copied into the 103 | same src as \code{x}. This allows you to join tables across srcs, but 104 | it is a potentially expensive operation so you must opt into it.} 105 | 106 | \item{suffix}{If there are non-joined duplicate variables in \code{x} and 107 | \code{y}, these suffixes will be added to the output to disambiguate them. 108 | Should be a character vector of length 2.} 109 | 110 | \item{...}{Other parameters passed onto methods.} 111 | 112 | \item{keep}{Should the join keys from both \code{x} and \code{y} be preserved in the 113 | output? Only applies to \code{nest_join()}, \code{left_join()}, \code{right_join()}, and 114 | \code{full_join()}.} 115 | 116 | \item{name}{The name of the list column nesting joins create. 117 | If \code{NULL} the name of \code{y} is used.} 118 | 119 | \item{data}{data} 120 | 121 | \item{template}{template} 122 | 123 | \item{.data}{A data frame, data frame extension (e.g. a tibble), or a 124 | lazy data frame (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for 125 | more details.} 126 | 127 | \item{.preserve}{Relevant when the \code{.data} input is grouped. 128 | If \code{.preserve = FALSE} (the default), the grouping structure 129 | is recalculated based on the resulting data, otherwise the grouping is kept as is.} 130 | } 131 | \description{ 132 | dplyr methods 133 | } 134 | -------------------------------------------------------------------------------- /tests/testthat/test-reactibble.R: -------------------------------------------------------------------------------- 1 | test_that("reactibbles have the intended structure", { 2 | env <- environment() 3 | rt <- reactibble(c = ~2*b, b = ~2*a, a=1) 4 | expect_equal(class(rt), c("reactibble", "tbl_df", "tbl", "data.frame")) 5 | expect_equal( 6 | lapply(rt, class), 7 | list(c = c("reactive_col", "vctrs_vctr"), 8 | b = c("reactive_col", "vctrs_vctr"), 9 | a = "numeric")) 10 | expect_equal( 11 | attr(.subset2(rt,1), "reactibble_col_def"), 12 | list(expr = quote(2 * b), env = env)) 13 | 14 | }) 15 | 16 | test_that("reactibbles print ok", { 17 | rt <- reactibble(a=1, b = ~2*a) 18 | expect_equal( 19 | capture.output(rt), 20 | c("# A reactibble: 1 x 2", 21 | " a b", 22 | " <~dbl>", 23 | "1 1 2") 24 | ) 25 | }) 26 | 27 | test_that("`[[` subsetting doesn't return a 'reactive_col'", { 28 | env <- environment() 29 | rt <- reactibble(a=1, b = ~2*a) 30 | expect_equal(rt[["a"]], 1) 31 | expect_equal(rt[["b"]], 2) 32 | expect_equal(rt$"a", 1) 33 | expect_equal(rt$"b", 2) 34 | expect_equal(dplyr::pull(rt,"a"), 1) 35 | expect_equal(dplyr::pull(rt,"b"), 2) 36 | 37 | # exception if .subset2 is used 38 | expect_equal( 39 | .subset2(rt,"b"), 40 | reactive_col(2, list(expr = quote(2*a), env = env))) 41 | }) 42 | 43 | test_that("`[` subsetting works, and fails explicitly when needed", { 44 | rt <- reactibble(c = ~2*b, b = ~2*a, a=1:2) 45 | 46 | # works 47 | expect_equal( 48 | rt[2:3], 49 | reactibble(b = ~2*a, a=1:2)) 50 | expect_equal( 51 | rt[,2:3], 52 | reactibble(b = ~2*a, a=1:2)) 53 | expect_equal( 54 | rt[1,], 55 | reactibble(c = ~2*b, b = ~2*a, a=1)) 56 | 57 | # same with subset 58 | expect_equal( 59 | subset(rt, TRUE, c("b", "a")), 60 | reactibble(b = ~2*a, a=1:2)) 61 | expect_equal( 62 | subset(rt, c(TRUE, FALSE)), 63 | reactibble(c = ~2*b, b = ~2*a, a=1)) 64 | 65 | # same with dplyr 66 | expect_equal( 67 | dplyr::select(rt, b, a), 68 | reactibble(b = ~2*a, a=1:2)) 69 | expect_equal( 70 | dplyr::slice(rt, 1), 71 | reactibble(c = ~2*b, b = ~2*a, a=1)) 72 | 73 | # fails as we remove columns needed by others 74 | expect_error(rt[-3]) 75 | expect_error(rt[-2]) 76 | expect_error(dlyr::select(rt, -a)) 77 | expect_error(dlyr::select(rt, -b)) 78 | expect_error(subset(rt, TRUE, -3)) 79 | expect_error(subset(rt, TRUE, -2)) 80 | }) 81 | 82 | 83 | 84 | test_that("reactibble() computes and refreshes fine", { 85 | rt <- reactibble(c = ~2*b, b = ~2*a, a=1) 86 | expect_equal(rt[["a"]], 1) 87 | expect_equal(rt[["b"]], 2) 88 | expect_equal(rt[["c"]], 4) 89 | }) 90 | 91 | 92 | test_that("disabling/enabling autorefresh works", { 93 | options(reactibble.autorefresh = FALSE) 94 | rt <- reactibble(c = ~2*b, b = ~2*a, a=1) 95 | # not refreshed, so contains NA 96 | expect_equal(rt[["a"]], 1) 97 | expect_equal(rt[["b"]], NA) 98 | expect_equal(rt[["c"]], NA) 99 | 100 | # refresh, so it's in sync 101 | rt <- refresh(rt) 102 | expect_equal(rt[["a"]], 1) 103 | expect_equal(rt[["b"]], 2) 104 | expect_equal(rt[["c"]], 4) 105 | 106 | # change `a`, the rest is out of sync 107 | rt[["a"]] <- 2 108 | expect_equal(rt[["a"]], 2) 109 | expect_equal(rt[["b"]], 2) 110 | expect_equal(rt[["c"]], 4) 111 | 112 | # refresh, so it's in sync 113 | rt <- refresh(rt) 114 | expect_equal(rt[["a"]], 2) 115 | expect_equal(rt[["b"]], 4) 116 | expect_equal(rt[["c"]], 8) 117 | 118 | options(reactibble.autorefresh = TRUE) 119 | 120 | # now chage will autorefresh 121 | rt[["a"]] <- 1 122 | expect_equal(rt[["a"]], 1) 123 | expect_equal(rt[["b"]], 2) 124 | expect_equal(rt[["c"]], 4) 125 | }) 126 | 127 | 128 | test_that("mutate() and transmute() work", { 129 | rt <- reactibble(a=1, b= 2) 130 | rt2 <- reactibble(a=1, b= 2, c=~2*a) 131 | 132 | expect_equal(rt2, dplyr::mutate(rt, c=~2*a)) 133 | expect_equal(rt2[-2], dplyr::transmute(rt, a = b/2, c = ~2*a)) 134 | 135 | # copying without using `~` makes a static copy 136 | expect_equal(reactibble(a=1, b= 2, c=~2*a, d = 2*a), 137 | dplyr::mutate(rt2, d = c)) 138 | }) 139 | 140 | 141 | test_that("Group generic operations work", { 142 | rt <- reactibble(a = c(3, -5), b = ~ a /2) 143 | # Arith 144 | expect_error(regexp = NA, dplyr::mutate(rt, c = b * 2)) 145 | 146 | # Compare 147 | expect_error(regexp = NA, dplyr::mutate(rt, c = b > 0)) 148 | 149 | # Logic 150 | expect_error(regexp = NA, dplyr::mutate(rt, c = b == 1.5)) 151 | 152 | # Math 153 | expect_error(regexp = NA, dplyr::mutate(rt, c = abs(b))) 154 | 155 | # Math2 156 | expect_error(regexp = NA, dplyr::mutate(rt, c = round(b))) 157 | 158 | # Summary 159 | expect_error(regexp = NA, dplyr::mutate(rt, c = max(b))) 160 | 161 | # Complex 162 | expect_error(regexp = NA, dplyr::mutate(rt, c = Re(b))) 163 | }) 164 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | ```{r, include = FALSE} 7 | knitr::opts_chunk$set( 8 | collapse = TRUE, 9 | comment = "#>", 10 | fig.path = "man/figures/README-", 11 | out.width = "100%" 12 | ) 13 | ``` 14 | 15 | # reactibble 16 | 17 | IN PROGRESS! 18 | 19 | *{reactibble}* implements reactive columns in data frames. 20 | 21 | We build them using the `reactibble()` function, and define reactive columns 22 | using formulas. 23 | 24 | ```{r} 25 | library(reactibble) 26 | rt <- reactibble( 27 | height = c(1.50, 1.72), 28 | weight = c(70, 82), 29 | bmi = ~ weight / height^2 30 | ) 31 | ``` 32 | 33 | ![](tools/intro1.png) 34 | 35 | As you can see, the reactive columns are displayed in a different color, and 36 | the type of the column is prefixed with `"~"`. 37 | 38 | Then whenever we change a value, the reactive column is updated. 39 | 40 | ```{r} 41 | rt$height[1] <- 1.80 42 | ``` 43 | 44 | ![](tools/intro2.png) 45 | 46 | It is reminescent database views, excel calculated columns or reactive 47 | DataTables in `{shiny}`. 48 | 49 | The package provides functions and methods to modify the data and ease memoisation 50 | of operations. 51 | 52 | 53 | ## Installation 54 | 55 | Install with: 56 | 57 | ``` r 58 | remotes::install_github("moodymudskipper/reactibble") 59 | ``` 60 | 61 | ## Modify the data 62 | 63 | You can add or modify columns using *{dplyr}* functions `mutate()` and `transmute()`, 64 | use a formula if you wish to add a new reactive column. Building on our example above : 65 | 66 | ```{r} 67 | library(dplyr, warn.conflicts = FALSE) 68 | rt <- mutate(rt, height_cm = ~ height * 100) 69 | rt 70 | ``` 71 | 72 | To add rows we can use the functions `rt_bind_rows()` or `rt_add_row()`, 73 | counterpart to `dplyr::bind_rows()` and `tibble::add_row()` which unfortunately 74 | don't work reliably on `"reactibble"` objects. 75 | 76 | ```{r} 77 | rt <- rt_add_row(rt, height = 1.64, weight = 68) 78 | rt 79 | ``` 80 | 81 | To get a static object (still of class reactibble), call `materialize()` 82 | 83 | ```{r} 84 | materialize(rt) 85 | ``` 86 | 87 | We implemented methods for *{dplyr}*'s join functions so that they should work 88 | seamlessly on `"reactibble"` reactibble objects, provided the first argument is 89 | a `"reactibble"`. 90 | 91 | Renaming, selecting, dropping columns, slicing, will work seamlessly with the method 92 | of your choice. 93 | In case of renaming the formula of the reactive columns will adapt to the new names, 94 | and if a necessary column is dropped an explicit error will be triggered. 95 | 96 | Some functions outside of this package will work well natively on 97 | *{reactibble}*, such as `base::split()`, others will warn, such as `base::transform()`, 98 | while others might unfortunately strip off the class or attributes silently, or 99 | put the reactibble out of sync. 100 | 101 | We hope through time to provide methods for most generics posing problems, and 102 | `rt_*` alternatives for other problematic functions, if you want to help, 103 | ![the issues are open!](https://github.com/moodymudskipper/reactibble/issues) 104 | 105 | ## Refreshing 106 | 107 | The columns of a `"reactibble"` object are recomputed anytime the object is modified. 108 | In some cases this can be costly in terms of resources, we can deal with this 109 | either by memoising the columns (next section) or enabling manual refresh (present section). 110 | 111 | We can disable the autorefresh, do the transformation we need with the latest 112 | computed values, and refresh once we're done. 113 | 114 | ```{r} 115 | options(reactibble.autorefresh = FALSE) 116 | rt <- mutate(rt, weight_g = ~weight * 1000) 117 | # not yet refreshed 118 | rt 119 | # now refreshed 120 | rt <- refresh(rt) 121 | rt 122 | # go back to default 123 | options(reactibble.autorefresh = TRUE) 124 | ``` 125 | 126 | ## Memoise 127 | 128 | The other, arguably more convenient way to deal with redundant computations is 129 | to memoise them. For this we implemented a handy feature that wraps 130 | the *{memoise}* package which 131 | ![provides such a functionality](http://memoise.r-lib.org/). 132 | 133 | Wrap the function that you want to memoise in `M()` and whenever its fed the same 134 | input when refreshing the column, it will retrieve the result in memory. 135 | 136 | See example below where we memoise respectively the full column and rowwise results. 137 | 138 | ### Full column memoisation 139 | 140 | ```{r} 141 | slow_mean <- function(...) { 142 | Sys.sleep(1) 143 | mean(c(...)) 144 | } 145 | 146 | # the function is run the first time, taking one second 147 | system.time( 148 | rt <- reactibble(a=1:3, b = ~ M(slow_mean)(a)) 149 | ) 150 | rt 151 | 152 | # If we transform the data without affecting b, we use results stored in 153 | # memory, saving resources 154 | system.time( 155 | rt <- mutate(rt, c = ~ b * 2) 156 | ) 157 | ``` 158 | 159 | ### Rowwise memoisation 160 | 161 | We can memoise rowwise computations that wrapping the call in an apply function 162 | (`lapply()`, `sapply()`, `mapply()`, `Map()`, or functions from the `purrr::map*()` family) 163 | 164 | ```{r} 165 | # the function is executed 3 times, takes 3 seconds 166 | system.time( 167 | rt <- reactibble(a=1:3, b = 2:4, c = ~ mapply(M(slow_mean),a, b)) 168 | ) 169 | rt 170 | 171 | # if we add a single row, it will take only one more second to update 172 | system.time( 173 | # careful not to change the type from integer to double! 174 | rt <- rt_add_row(rt, a=4L, b = 5L) 175 | ) 176 | rt 177 | ``` 178 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # reactibble 3 | 4 | IN PROGRESS\! 5 | 6 | *{reactibble}* implements reactive columns in data frames. 7 | 8 | We build them using the `reactibble()` function, and define reactive 9 | columns using formulas. 10 | 11 | ``` r 12 | library(reactibble) 13 | rt <- reactibble( 14 | height = c(1.50, 1.72), 15 | weight = c(70, 82), 16 | bmi = ~ weight / height^2 17 | ) 18 | ``` 19 | 20 | ![](tools/intro1.png) 21 | 22 | As you can see, the reactive columns are displayed in a different color, 23 | and the type of the column is prefixed with `"~"`. 24 | 25 | Then whenever we change a value, the reactive column is updated. 26 | 27 | ``` r 28 | rt$height[1] <- 1.80 29 | ``` 30 | 31 | ![](tools/intro2.png) 32 | 33 | It is reminescent database views, excel calculated columns or reactive 34 | DataTables in `{shiny}`. 35 | 36 | The package provides functions and methods to modify the data and ease 37 | memoisation of operations. 38 | 39 | ## Installation 40 | 41 | Install with: 42 | 43 | ``` r 44 | remotes::install_github("moodymudskipper/reactibble") 45 | ``` 46 | 47 | ## Modify the data 48 | 49 | You can add or modify columns using *{dplyr}* functions `mutate()` and 50 | `transmute()`, use a formula if you wish to add a new reactive column. 51 | Building on our example above : 52 | 53 | ``` r 54 | library(dplyr, warn.conflicts = FALSE) 55 | rt <- mutate(rt, height_cm = ~ height * 100) 56 | rt 57 | #> # A reactibble: 2 x 4 58 | #> height weight bmi height_cm 59 | #> <~dbl> <~dbl> 60 | #> 1 1.8 70 21.6 180 61 | #> 2 1.72 82 27.7 172 62 | ``` 63 | 64 | To add rows we can use the functions `rt_bind_rows()` or `rt_add_row()`, 65 | counterpart to `dplyr::bind_rows()` and `tibble::add_row()` which 66 | unfortunately don’t work reliably on `"reactibble"` objects. 67 | 68 | ``` r 69 | rt <- rt_add_row(rt, height = 1.64, weight = 68) 70 | rt 71 | #> # A reactibble: 3 x 4 72 | #> height weight bmi height_cm 73 | #> <~dbl> <~dbl> 74 | #> 1 1.8 70 21.6 180 75 | #> 2 1.72 82 27.7 172 76 | #> 3 1.64 68 25.3 164 77 | ``` 78 | 79 | To get a static object (still of class reactibble), call `materialize()` 80 | 81 | ``` r 82 | materialize(rt) 83 | #> # A reactibble: 3 x 4 84 | #> height weight bmi height_cm 85 | #> 86 | #> 1 1.8 70 21.6 180 87 | #> 2 1.72 82 27.7 172 88 | #> 3 1.64 68 25.3 164 89 | ``` 90 | 91 | We implemented methods for *{dplyr}*’s join functions so that they 92 | should work seamlessly on `"reactibble"` reactibble objects, provided 93 | the first argument is a `"reactibble"`. 94 | 95 | Renaming, selecting, dropping columns, slicing, will work seamlessly 96 | with the method of your choice. In case of renaming the formula of the 97 | reactive columns will adapt to the new names, and if a necessary column 98 | is dropped an explicit error will be triggered. 99 | 100 | Some functions outside of this package will work well natively on 101 | *{reactibble}*, such as `base::split()`, others will warn, such as 102 | `base::transform()`, while others might unfortunately strip off the 103 | class or attributes silently, or put the reactibble out of sync. 104 | 105 | We hope through time to provide methods for most generics posing 106 | problems, and `rt_*` alternatives for other problematic functions, if 107 | you want to help, ![the issues are 108 | open\!](https://github.com/moodymudskipper/reactibble/issues) 109 | 110 | ## Refreshing 111 | 112 | The columns of a `"reactibble"` object are recomputed anytime the object 113 | is modified. In some cases this can be costly in terms of resources, we 114 | can deal with this either by memoising the columns (next section) or 115 | enabling manual refresh (present section). 116 | 117 | We can disable the autorefresh, do the transformation we need with the 118 | latest computed values, and refresh once we’re done. 119 | 120 | ``` r 121 | options(reactibble.autorefresh = FALSE) 122 | rt <- mutate(rt, weight_g = ~weight * 1000) 123 | # not yet refreshed 124 | rt 125 | #> # A reactibble: 3 x 5 126 | #> height weight bmi height_cm weight_g 127 | #> <~dbl> <~dbl> <~lgl> 128 | #> 1 1.8 70 21.6 180 NA 129 | #> 2 1.72 82 27.7 172 NA 130 | #> 3 1.64 68 25.3 164 NA 131 | # now refreshed 132 | rt <- refresh(rt) 133 | rt 134 | #> # A reactibble: 3 x 5 135 | #> height weight bmi height_cm weight_g 136 | #> <~dbl> <~dbl> <~dbl> 137 | #> 1 1.8 70 21.6 180 70000 138 | #> 2 1.72 82 27.7 172 82000 139 | #> 3 1.64 68 25.3 164 68000 140 | # go back to default 141 | options(reactibble.autorefresh = TRUE) 142 | ``` 143 | 144 | ## Memoise 145 | 146 | The other, arguably more convenient way to deal with redundant 147 | computations is to memoise them. For this we implemented a handy feature 148 | that wraps the *{memoise}* package which ![provides such a 149 | functionality](http://memoise.r-lib.org/). 150 | 151 | Wrap the function that you want to memoise in `M()` and whenever its fed 152 | the same input when refreshing the column, it will retrieve the result 153 | in memory. 154 | 155 | See example below where we memoise respectively the full column and 156 | rowwise results. 157 | 158 | ### Full column memoisation 159 | 160 | ``` r 161 | slow_mean <- function(...) { 162 | Sys.sleep(1) 163 | mean(c(...)) 164 | } 165 | 166 | # the function is run the first time, taking one second 167 | system.time( 168 | rt <- reactibble(a=1:3, b = ~ M(slow_mean)(a)) 169 | ) 170 | #> user system elapsed 171 | #> 0.00 0.02 1.05 172 | rt 173 | #> # A reactibble: 3 x 2 174 | #> a b 175 | #> <~dbl> 176 | #> 1 1 2 177 | #> 2 2 2 178 | #> 3 3 2 179 | 180 | # If we transform the data without affecting b, we use results stored in 181 | # memory, saving resources 182 | system.time( 183 | rt <- mutate(rt, c = ~ b * 2) 184 | ) 185 | #> user system elapsed 186 | #> 0.05 0.00 0.04 187 | ``` 188 | 189 | ### Rowwise memoisation 190 | 191 | We can memoise rowwise computations that wrapping the call in an apply 192 | function (`lapply()`, `sapply()`, `mapply()`, `Map()`, or functions from 193 | the `purrr::map*()` family) 194 | 195 | ``` r 196 | # the function is executed 3 times, takes 3 seconds 197 | system.time( 198 | rt <- reactibble(a=1:3, b = 2:4, c = ~ mapply(M(slow_mean),a, b)) 199 | ) 200 | #> user system elapsed 201 | #> 0.02 0.00 3.14 202 | rt 203 | #> # A reactibble: 3 x 3 204 | #> a b c 205 | #> <~dbl> 206 | #> 1 1 2 1.5 207 | #> 2 2 3 2.5 208 | #> 3 3 4 3.5 209 | 210 | # if we add a single row, it will take only one more second to update 211 | system.time( 212 | # careful not to change the type from integer to double! 213 | rt <- rt_add_row(rt, a=4L, b = 5L) 214 | ) 215 | #> user system elapsed 216 | #> 0.00 0.00 1.07 217 | rt 218 | #> # A reactibble: 4 x 3 219 | #> a b c 220 | #> <~dbl> 221 | #> 1 1 2 1.5 222 | #> 2 2 3 2.5 223 | #> 3 3 4 3.5 224 | #> 4 4 5 4.5 225 | ``` 226 | -------------------------------------------------------------------------------- /R/wrappers.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | `[[<-.reactibble` <- function(x, name, value) { 4 | x <- strip_reactibble_class(x) 5 | x[[name]] <- value 6 | x <- refresh_if_relevant(x) 7 | as_reactibble(x) 8 | } 9 | 10 | #' @export 11 | `$<-.reactibble` <- function(x, name, value) { 12 | x[[name]] <- value 13 | x 14 | } 15 | 16 | #' @export 17 | `[<-.reactibble` <- function(x, ..., value) { 18 | cl <- class(x) 19 | x <- strip_reactibble_class(x) 20 | x[...] <- value 21 | x <- refresh_if_relevant(x) 22 | class(x) <- cl 23 | x 24 | } 25 | 26 | #' @export 27 | transform.reactibble <- function (`_data`, ...) { 28 | warning("`transform` converts a 'reactibble' object to a static data frame, ", 29 | "use `mutate.reactibble` to preserve reactive columns") 30 | as.data.frame(materialize(`_data`)) 31 | } 32 | 33 | 34 | #' @export 35 | within.reactibble <- function (data, expr, ...) { 36 | warning( 37 | "Using `within` on a 'reactibble' object is discouraged and ", 38 | "potentially unsafe, use `mutate.reactibble` instead") 39 | cl <- class(data) 40 | x <- strip_reactibble_class(data) 41 | x <- eval.parent(substitute(within(x, expr, ...), environment())) 42 | x <- refresh_if_relevant(x) 43 | class(x) <- cl 44 | x 45 | } 46 | 47 | #' @export 48 | with.reactibble <- function (data, expr, ...) { 49 | # this just makes sure the output is not a reactive column 50 | warning( 51 | "Using `with` on a 'reactibble' object is discouraged and potentially ", 52 | "unsafe, use `mutate.reactibble` instead") 53 | data <- eval.parent(substitute(with.default(data, expr, ...), environment())) 54 | strip_reactive_col(data) 55 | } 56 | 57 | 58 | #' @export 59 | `[.reactibble` <- function(x, ...){ 60 | x <- NextMethod() 61 | refresh_if_relevant(x) 62 | } 63 | 64 | #' @export 65 | #' @importFrom stats setNames 66 | `names<-.reactibble` <- function(x, value) { 67 | cl <- class(x) 68 | x <- strip_reactibble_class(x) 69 | # renaming arg for `substitute` 70 | args <- setNames(lapply(value, as.symbol), names(x)) 71 | for (i in seq_along(x)) { 72 | if(inherits(x[[i]], "reactive_col")) { 73 | attr(x[[i]], "reactibble_col_def") <- 74 | do.call(substitute, c(list(attr(x[[i]], "reactibble_col_def"), args))) 75 | } 76 | } 77 | names(x) <- value 78 | class(x) <- cl 79 | x 80 | } 81 | 82 | # #' @export 83 | # #' @method as.data.frame reactibble 84 | # as.data.frame.reactibble <- function( 85 | # x, row.names = NULL, optional = FALSE, ...) { 86 | # x <- strip_reactibble_class(x) 87 | # x[] <- lapply(x, strip_reactive_col) 88 | # NextMethod() 89 | # } 90 | # 91 | # #' Convert to tibble 92 | # #' 93 | # #' @param x react tibble object 94 | # #' @param ... forwarded to tibble::as_tibble 95 | # #' @param .rows forwarded to tibble::as_tibble 96 | # #' @param .name_repair Treatment of problematic column names 97 | # #' @param rownames rownames How to treat existing row names of a data frame or matrix 98 | # #' @export 99 | # as_tibble.reactibble <- function( 100 | # x, ..., .rows = NULL, 101 | # .name_repair = c("check_unique", "unique", "universal", "minimal"), 102 | # rownames = pkgconfig::get_config("tibble::rownames", NULL)) { 103 | # x <- strip_reactibble_class(x) 104 | # x[] <- lapply(x, strip_reactive_col) 105 | # NextMethod() 106 | # } 107 | # 108 | # 109 | # #' @export 110 | # #' @method as.data.table reactibble 111 | # as.data.table.reactibble <- function(x, keep.rownames = FALSE, ...) { 112 | # x <- strip_reactibble_class(x) 113 | # x[] <- lapply(x, strip_reactive_col) 114 | # NextMethod() 115 | # } 116 | # 117 | # # to avoid error with devtools::load_all() 118 | # as.data.table <- NULL 119 | # 120 | 121 | #' @export 122 | `[[.reactibble` <- function(x, ...) { 123 | strip_reactive_col(.subset2(x, ...)) 124 | } 125 | 126 | #' @export 127 | `$.reactibble` <- function(x, ...) { 128 | strip_reactive_col(.subset2(x, ...)) 129 | } 130 | 131 | # This is necessary so dplyr::bind_rows reconstruct the reactibble and refreshes 132 | # it right 133 | 134 | #' @export 135 | #' @param template template 136 | #' @param data data 137 | #' @rdname dplyr_methods 138 | dplyr_reconstruct.reactibble <- function (data, template) { 139 | # hack to retrieve attributes from all tables, might break if dplyr's code changes 140 | dots <- get("dots", parent.frame(2)) 141 | reactive_col_attrs <- unlist(lapply(dots, function(x) { 142 | lapply(x, attr, "reactibble_col_def") 143 | }), FALSE) 144 | 145 | reactive_col_attrs <- reactive_col_attrs[!duplicated(names(reactive_col_attrs))] 146 | nms <- names(reactive_col_attrs) 147 | data[] <- Map(function(x, y) { 148 | attr(x, "reactibble_col_def") <- y 149 | x 150 | }, data, reactive_col_attrs) 151 | class(data) <- class(template) 152 | refresh_if_relevant(data) 153 | } 154 | 155 | #' @export 156 | rbind.reactibble <- function(..., deparse.level = 1) { 157 | warning( 158 | "Using `rbind()` on a 'reactibble' object is discouraged and ", 159 | "potentially unsafe, use `rt_bind_rows` instead") 160 | data <- rbind.data.frame(..., deparse.level = 1) 161 | # the main method does checks already so we do our checks 162 | dots <- list(...) 163 | rcs <- sapply(dots[[1]], inherits, "reactive_col") 164 | nms <- names(which(rcs)) 165 | exprs1 <- sapply(.subset(dots[[1]], nms), attr, "reactibble_col_def") 166 | for(input in dots[-1]) { 167 | exprs <- sapply(.subset(input, nms), attr, "reactibble_col_def") 168 | if(!identical(exprs, exprs1)) 169 | stop("Tried to bind a `reactive_col` to an incompatible object.") 170 | } 171 | refresh_if_relevant(data) 172 | } 173 | 174 | #' @export 175 | cbind.reactibble <- function(..., deparse.level = 1) { 176 | warning( 177 | "Using `cbind()` on a 'reactibble' object is discouraged and ", 178 | "potentially unsafe, use `rt_bind_cols` instead") 179 | data <- cbind.data.frame(..., deparse.level = 1) 180 | data <- as_reactibble(data) 181 | refresh_if_relevant(data) 182 | } 183 | 184 | 185 | #' @export 186 | #' @inheritParams dplyr::slice 187 | #' @rdname dplyr_methods 188 | slice.reactibble <- function(.data, ..., .preserve = FALSE) { 189 | cl <- class(.data) 190 | attrs <- lapply(.data, attr, "reactibble_col_def") 191 | .data <- dplyr::slice(tibble::as_tibble(.data), ..., .preserve = TRUE) 192 | .data[] <- Map(function(x, y) { 193 | attr(x, "reactibble_col_def") <- y 194 | x 195 | }, .data, attrs) 196 | class(.data) <- cl 197 | refresh_if_relevant(.data) 198 | } 199 | 200 | #' Efficiently bind multiple data frames by row and column 201 | #' 202 | #' Counterpart of `dplyr::bind_rows` that works efficiently on *"reactibble"* 203 | #' objects. While `bind_rows()` can be used on "reactibbles" (at time of writing), 204 | #' it is brittle and inefficient, as it triggers more refreshes than necessary. 205 | #' 206 | #' @inheritParams dplyr::bind_rows 207 | #' 208 | #' @export 209 | rt_bind_rows <- function(..., .id = NULL) { 210 | dots <- lapply(list(...), tibble::as_tibble) 211 | data <- dplyr::bind_rows(!!!dots, .id = .id) 212 | data <- as_reactibble(data) 213 | refresh_if_relevant(data) 214 | } 215 | 216 | #' Efficiently bind multiple data frames by row and column 217 | #' 218 | #' Counterpart of `dplyr::bind_cols` that works efficiently on *"reactibble"* 219 | #' objects. `bind_cols()` will fail "reactibbles" so this new function was 220 | #' required.. 221 | #' 222 | #' @inheritParams dplyr::bind_cols 223 | #' 224 | #' @export 225 | rt_bind_cols <- function(..., .id = NULL) { 226 | dots <- lapply(list(...), tibble::as_tibble) 227 | data <- dplyr::bind_cols(!!!dots, .id = .id) 228 | data <- as_reactibble(data) 229 | refresh_if_relevant(data) 230 | } 231 | 232 | #' Add rows to a reactibble 233 | #' 234 | #' Counterpart of `tibble::add_row` that works efficiently on *"reactibble"* 235 | #' objects. Beware of using `add_row()` instead as it would return an out of sync `reactibble` 236 | #' 237 | #' @inheritParams tibble::add_row 238 | #' 239 | #' @export 240 | rt_add_row <- function(.data, ..., .before = NULL, .after = NULL) { 241 | .data <- tibble::as_tibble(.data) 242 | .data <- tibble::add_row(.data, ..., .before = NULL, .after = NULL) 243 | .data <- as_reactibble(.data) 244 | refresh_if_relevant(.data) 245 | } 246 | --------------------------------------------------------------------------------