bindr/0000755000176200001440000000000014717723146011364 5ustar liggesusersbindr/tests/0000755000176200001440000000000014534021117012510 5ustar liggesusersbindr/tests/testthat/0000755000176200001440000000000014717723146014366 5ustar liggesusersbindr/tests/testthat/test-create.R0000644000176200001440000000254114534021117016715 0ustar liggesuserscontext("create") test_that("create_env()", { env <- create_env(lapply(letters, as.name), toupper) expect_equal(env$a, "A") expect_equal(env$x, "X") expect_null(env$X) expect_equal(length(ls(env)), length(letters)) expect_error(env$a <- "a", "read-only") }) test_that("create_env() with character", { env <- create_env(letters, toupper) expect_equal(env$a, "A") expect_equal(env$x, "X") expect_null(env$X) expect_equal(length(ls(env)), length(letters)) expect_error(env$a <- "a", "read-only") }) test_that("create_env() with inheritance", { env <- create_env(lapply(letters, as.name), toupper) env2 <- create_env(lapply(LETTERS, as.name), tolower, .enclos = env) expect_equal(get("a", env2), "A") expect_equal(get("x", env2), "X") expect_null(env2$a) expect_null(env2$x) expect_equal(env2$B, "b") expect_equal(env2$Y, "y") expect_equal(length(ls(env2)), length(letters)) expect_error(env2$B <- "B", "read-only") expect_error(env2$a <- "a", NA) expect_equal(get("a", env2), "a") }) test_that("create_env() with local function", { a <- function(x) b(x) b <- function(x) c(x) c <- function(x) toupper(x) env <- create_env(lapply(letters, as.name), a) expect_equal(env$a, "A") expect_equal(env$x, "X") expect_null(env$X) expect_equal(length(ls(env)), length(letters)) expect_error(env$a <- "a", "read-only") }) bindr/tests/testthat/test-populate.R0000644000176200001440000000063414534021117017304 0ustar liggesuserscontext("populate") test_that("can populate existing env", { env <- new.env(parent = emptyenv()) populate_env(env, letters, identity) expect_equal(env$a, quote(a)) expect_equal(env$k, quote(k)) expect_null(env$Z) }) test_that("cannot update existing vars", { env <- new.env(parent = emptyenv()) populate_env(env, "v", identity) expect_error(populate_env(env, letters, identity), "existing") }) bindr/tests/testthat/test-error.R0000644000176200001440000000063314534021117016603 0ustar liggesuserscontext("error") test_that("non-character raises error", { expect_error(create_env(1:3, identity)) expect_error(create_env(FALSE, identity)) }) test_that("non-native encoding causes warning", { with_mock( `bindr::to_symbol_encoding` = function(x) paste0(x, "-garbled"), expect_warning(create_env(letters[1:2], identity), "a -> a-garbled, b -> b-garbled", fixed = TRUE) ) }) bindr/tests/testthat/test-payload.R0000644000176200001440000000114014534021117017075 0ustar liggesuserscontext("payload") test_that("create_env() with payload", { env <- create_env(lapply(letters, as.name), paste, "letter") expect_equal(env$a, "a letter") expect_equal(env$x, "x letter") expect_null(env$X) expect_equal(length(ls(env)), length(letters)) expect_error(env$a <- "a", "read-only") }) test_that("create_env() with named payload", { env <- create_env(lapply(letters, as.name), paste0, 1:3, collapse = "") expect_equal(env$a, "a1a2a3") expect_equal(env$x, "x1x2x3") expect_null(env$X) expect_equal(length(ls(env)), length(letters)) expect_error(env$a <- "a", "read-only") }) bindr/tests/testthat.R0000644000176200001440000000006614534021117014475 0ustar liggesuserslibrary(testthat) library(bindr) test_check("bindr") bindr/MD50000644000176200001440000000140514717723146011674 0ustar liggesusers25bda9d253ef7f0e31ed4fb27171fc18 *DESCRIPTION d3d2f503f5c96ac395a270e7c295ec0b *LICENSE bfedbdf528857533acbe57424d0ec1ca *NAMESPACE 4e283f1434136d9092d17c93e3ad4e33 *NEWS.md bbb31f70697967217d6e88924f7e57c9 *R/bindr-package.R 493a78933369896507ff454817ed47b2 *R/populate.R 5611cbfe0dd9321ce00c7a95a7f5eb4b *R/utils.R e2e633c9955d342b26638f647dcfa168 *README.md 2c089eeae53f9b3bcb8ff6af7eafb2f3 *man/bindr-package.Rd d4391a48430d92dbac194bb848e93cc3 *man/create_env.Rd 7b310fee9dbf98b1fb3871318e3c11eb *tests/testthat.R bf3390049228444b38220186aee7682e *tests/testthat/test-create.R 581b1074ae18ceeb5c6ca14e0135fd5a *tests/testthat/test-error.R f1b0f8af870fd86f7e6adac2ed61b269 *tests/testthat/test-payload.R 9bce0026de3423008f59c97f753d4383 *tests/testthat/test-populate.R bindr/R/0000755000176200001440000000000014534021117011547 5ustar liggesusersbindr/R/bindr-package.R0000644000176200001440000000025114534021117014357 0ustar liggesusers#' @details #' See [create_env()] for creating an environment populated with active bindings, #' and [populate_env()] for populating an existing environment. "_PACKAGE" bindr/R/utils.R0000644000176200001440000000017314534021117013033 0ustar liggesusersfast_intersect <- function(x, y) { if (length(x) > length(y)) { intersect(y, x) } else { intersect(x, y) } } bindr/R/populate.R0000644000176200001440000000560114534021117013525 0ustar liggesusers#' Create or populate an environment with parametrized active bindings #' #' Leverages [makeActiveBinding()][base::bindenv] #' by allowing parametrized functions #' that take the name of the binding and an arbitrary number of additional arguments. #' #' @param names A [name], or a list of names, or a character vector; in the latter case #' the names are mangled if they are not representable in the native encoding #' @param fun A [function] with at least one argument, which will be called #' to compute the value of a binding. The function will be called with the #' binding name as first argument (unnamed), and `...` as additional arguments #' @param ... Additional arguments to `fun` #' @param .envir The [environment] in which `fun` will be executed, #' important if `fun` calls other functions that are not globally visible #' @param .enclos The enclosing environment (`parent.env`) for the newly created environment #' @export #' #' @examples #' env <- create_env(letters, paste0, "-lowercase") #' env$a #' env$c #' env$Z #' populate_env(env, LETTERS, paste0, "-uppercase") #' env$a #' env$Z create_env <- function(names, fun, ..., .envir = parent.frame(), .enclos = parent.frame()) { env <- new.env(parent = .enclos, size = length(names)) populate_env(env = env, names = names, fun = fun, ..., .envir = .envir) env } #' @param env An environment #' @rdname create_env #' @export populate_env <- function(env, names, fun, ..., .envir = parent.frame()) { names <- check_names(names) existing <- as.list(env) collisions <- fast_intersect(names, names(existing)) if (length(collisions) > 0) { stop( "Not creating bindings for existing variables: ", paste(utils::head(collisions, 6), collapse = ", ") ) } make_active_binding_fun <- make_make_active_binding_fun(.envir) lapply(names, function(name) { makeActiveBinding(name, make_active_binding_fun(name, fun, ...), env) }) invisible(env) } check_names <- function(names) { if (is.character(names)) { enc_names <- to_symbol_encoding(names) diff <- names != enc_names if (any(diff)) { warning("Mangling the following names: ", paste0(names[diff], " -> ", enc_names[diff], collapse = ", "), ". Use enc2native() to avoid the warning.", call. = FALSE) } lapply(enc_names, as.name) } else if (all(vapply(names, is.name, logical(1L)))) { names } else { stop("Expecting a list of names or a character vector", call. = FALSE) } } to_symbol_encoding <- function(x) enc2native(x) make_make_active_binding_fun <- function(.envir) { make_active_binding_fun <- function(name, fun, ...) { force(name) bindr_fun <- fun list(...) function(value) { if (!missing(value)) { stop("Binding is read-only.", call. = FALSE) } bindr_fun(name, ...) } } environment(make_active_binding_fun) <- .envir make_active_binding_fun } bindr/NAMESPACE0000644000176200001440000000012614534021117012564 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(create_env) export(populate_env) bindr/LICENSE0000644000176200001440000000004514534021117012352 0ustar liggesusersYEAR: 2016 COPYRIGHT HOLDER: RStudio bindr/NEWS.md0000644000176200001440000000167614717713311012465 0ustar liggesusers # bindr 0.1.2 (2024-11-21) ## Feature - The call stack for a failure in an active binding now contains a reference to `bindr_fun()` instead of `fun()`, to hint at what might have went wrong. # bindr 0.1.1 (2018-03-13) - Improve performance for very large environments for `create_env()` and `populate_env()`. - Force the `fun` argument just to be sure. # bindr 0.1 (2016-11-12) Initial release. - Functions `create_env()` and `populate_env()`. - Create or populate an environment with one or more active bindings, where the value is computed by calling a function and passing the name of the binding, and an arbitrary number of additional arguments (named or unnamed). - Not overwriting existing bindings or variables. - Names can be passed as symbols (`name`) or character strings (`character`), with warning if the conversion fails. bindr/README.md0000644000176200001440000001412314717714313012640 0ustar liggesusers # bindr [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html) [![R build status](https://github.com/krlmlr/bindr/workflows/rcc/badge.svg)](https://github.com/krlmlr/bindr/actions) [![Coverage Status](https://img.shields.io/codecov/c/github/krlmlr/bindr/master.svg)](https://app.codecov.io/github/krlmlr/bindr?branch=master) [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/bindr)](https://cran.r-project.org/package=bindr) Active bindings in R are much like properties in other languages: They look like a variable, but querying or setting the value triggers a function call. They can be created in R via [`makeActiveBinding()`](https://www.rdocumentation.org/packages/base/versions/3.3.1/topics/bindenv), but with this API the function used to compute or change the value of a binding cannot take additional arguments. The `bindr` package faciliates the creation of active bindings that are linked to a function that receives the binding name, and an arbitrary number of additional arguments. ## Installation You can install `bindr` from GitHub with: ``` r # install.packages("devtools") devtools::install_github("krlmlr/bindr") ``` ## Getting started For illustration, the `append_random()` function is used. This function appends a separator (a dash by default) and a random letter to its input, and talks about it, too. ``` r set.seed(20161510) append_random <- function(x, sep = "-") { message("Evaluating append_random(sep = ", deparse(sep), ")") paste(x, sample(letters, 1), sep = sep) } append_random("a") #> Evaluating append_random(sep = "-") #> [1] "a-h" append_random("X", sep = "+") #> Evaluating append_random(sep = "+") #> [1] "X+k" ``` In this example, we create an environment that contains bindings for all lowercase letters, which are evaluated with `append_random()`. As a result, a dash and a random letter are appended to the name of the binding: ``` r library(bindr) env <- create_env(letters, append_random) ls(env) #> [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" #> [20] "t" "u" "v" "w" "x" "y" "z" env$a #> Evaluating append_random(sep = "-") #> [1] "a-s" env$a #> Evaluating append_random(sep = "-") #> [1] "a-h" env$a #> Evaluating append_random(sep = "-") #> [1] "a-c" env$c #> Evaluating append_random(sep = "-") #> [1] "c-o" env$Z #> NULL ``` Bindings can also be added to existing environments: ``` r populate_env(env, LETTERS, append_random, "+") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") #> Evaluating append_random(sep = "-") env$a #> Evaluating append_random(sep = "-") #> [1] "a-q" env$Z #> Evaluating append_random(sep = "+") #> [1] "Z+c" ``` ## Further properties Both named and unnamed arguments are supported: ``` r create_env("binding", paste, "value", sep = "-")$binding #> [1] "binding-value" ``` A parent environment can be specified for creation: ``` r env2 <- create_env("a", identity, .enclos = env) env2$a #> a env2$b #> NULL get("b", env2) #> Evaluating append_random(sep = "-") #> [1] "b-t" ``` The bindings by default have access to the calling environment: ``` r create_local_env <- function(names) { paste_with_dash <- function(...) paste(..., sep = "-") binder <- function(name, append) paste_with_dash(name, append) create_env(names, binder, append = "appending") } env3 <- create_local_env("a") env3$a #> [1] "a-appending" ``` All bindings are read-only: ``` r env3$a <- NA #> Error: Binding is read-only. env3$a <- NULL #> Error: Binding is read-only. ``` Existing variables or bindings are not overwritten: ``` r env4 <- as.environment(list(a = 5)) populate_env(env4, list(quote(b)), identity) ls(env4) #> [1] "a" "b" populate_env(env4, letters, identity) #> Error in populate_env(env4, letters, identity): Not creating bindings for existing variables: b, a ``` ## Active bindings and C++ Active bindings must be R functions. To interface with C++ code, one must bind against an exported Rcpp function, possibly with `rng = false` if performance matters. The [`bindrcpp`](https://github.com/krlmlr/bindrcpp#readme) package uses `bindr` to provide an easy-to-use C++ interface for parametrized active bindings, and is the recommended way to interface with C++ code. In the remainder of this section, an alternative using an exported C++ function is shown. The following C++ module exports a function `change_case(to_upper = FALSE)`, which is bound against in R code later. ``` cpp #include #include #include using namespace Rcpp; // [[Rcpp::export(rng = FALSE)]] SEXP change_case(Symbol name, bool to_upper = false) { std::string name_string = name.c_str(); std::transform(name_string.begin(), name_string.end(), name_string.begin(), to_upper ? ::toupper : ::tolower); return CharacterVector(name_string); } ``` Binding from R: ``` r env <- create_env(list(as.name("__ToLower__")), change_case) populate_env(env, list(as.name("__tOuPPER__")), change_case, TRUE) ls(env) #> [1] "__ToLower__" "__tOuPPER__" env$`__ToLower__` #> [1] "__tolower__" get("__tOuPPER__", env) #> [1] "__TOUPPER__" ``` bindr/man/0000755000176200001440000000000014717711535012136 5ustar liggesusersbindr/man/bindr-package.Rd0000644000176200001440000000166414717711535015123 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bindr-package.R \docType{package} \name{bindr-package} \alias{bindr} \alias{bindr-package} \title{bindr: Parametrized Active Bindings} \description{ Provides a simple interface for creating active bindings where the bound function accepts additional arguments. } \details{ See \code{\link[=create_env]{create_env()}} for creating an environment populated with active bindings, and \code{\link[=populate_env]{populate_env()}} for populating an existing environment. } \seealso{ Useful links: \itemize{ \item \url{https://github.com/krlmlr/bindr} \item \url{https://krlmlr.github.io/bindr/} \item Report bugs at \url{https://github.com/krlmlr/bindr/issues} } } \author{ \strong{Maintainer}: Kirill Müller \email{kirill@cynkra.com} (\href{https://orcid.org/0000-0002-1416-3412}{ORCID}) Other contributors: \itemize{ \item RStudio [copyright holder, funder] } } bindr/man/create_env.Rd0000644000176200001440000000263714534021117014533 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/populate.R \name{create_env} \alias{create_env} \alias{populate_env} \title{Create or populate an environment with parametrized active bindings} \usage{ create_env(names, fun, ..., .envir = parent.frame(), .enclos = parent.frame()) populate_env(env, names, fun, ..., .envir = parent.frame()) } \arguments{ \item{names}{A \link{name}, or a list of names, or a character vector; in the latter case the names are mangled if they are not representable in the native encoding} \item{fun}{A \link{function} with at least one argument, which will be called to compute the value of a binding. The function will be called with the binding name as first argument (unnamed), and \code{...} as additional arguments} \item{...}{Additional arguments to \code{fun}} \item{.envir}{The \link{environment} in which \code{fun} will be executed, important if \code{fun} calls other functions that are not globally visible} \item{.enclos}{The enclosing environment (\code{parent.env}) for the newly created environment} \item{env}{An environment} } \description{ Leverages \link[base:bindenv]{makeActiveBinding()} by allowing parametrized functions that take the name of the binding and an arbitrary number of additional arguments. } \examples{ env <- create_env(letters, paste0, "-lowercase") env$a env$c env$Z populate_env(env, LETTERS, paste0, "-uppercase") env$a env$Z } bindr/DESCRIPTION0000644000176200001440000000156714717723146013103 0ustar liggesusersPackage: bindr Title: Parametrized Active Bindings Version: 0.1.2 Authors@R: c( person("Kirill", "M\u00fcller", role = c("aut", "cre"), email = "kirill@cynkra.com", comment = c(ORCID = "0000-0002-1416-3412")), person("RStudio", role = c("cph", "fnd")) ) Description: Provides a simple interface for creating active bindings where the bound function accepts additional arguments. Suggests: testthat Date: 2024-11-21 BugReports: https://github.com/krlmlr/bindr/issues URL: https://github.com/krlmlr/bindr, https://krlmlr.github.io/bindr/ RoxygenNote: 7.3.2.9000 License: MIT + file LICENSE Encoding: UTF-8 NeedsCompilation: no Packaged: 2024-11-21 20:34:52 UTC; kirill Author: Kirill Müller [aut, cre] (), RStudio [cph, fnd] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2024-11-21 21:30:14 UTC