bindr/0000755000177400001440000000000013011734160011536 5ustar murdochusersbindr/tests/0000755000177400001440000000000013000370371012676 5ustar murdochusersbindr/tests/testthat.R0000644000177400001440000000006613000370371014663 0ustar murdochuserslibrary(testthat) library(bindr) test_check("bindr") bindr/tests/testthat/0000755000177400001440000000000013011734160014540 5ustar murdochusersbindr/tests/testthat/test-create.R0000644000177400001440000000254113011111701017073 0ustar murdochuserscontext("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-error.R0000644000177400001440000000063313000432366016774 0ustar murdochuserscontext("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.R0000644000177400001440000000114013011346026017265 0ustar murdochuserscontext("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/test-populate.R0000644000177400001440000000063413011111701017462 0ustar murdochuserscontext("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/NAMESPACE0000644000177400001440000000012613000370371012752 0ustar murdochusers# Generated by roxygen2: do not edit by hand export(create_env) export(populate_env) bindr/NEWS.md0000644000177400001440000000076013011712335012637 0ustar murdochusers# 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/R/0000755000177400001440000000000013011321007011727 5ustar murdochusersbindr/R/bindr-package.R0000644000177400001440000000025113000437341014546 0ustar murdochusers#' @details #' See [create_env()] for creating an environment populated with active bindings, #' and [populate_env()] for populating an existing environment. "_PACKAGE" bindr/R/populate.R0000644000177400001440000000550513011321007013710 0ustar murdochusers#' 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 <- vapply(names, function(x) !is.null(env[[as.character(x)]]), logical(1L)) if (any(existing)) { stop("Not creating bindings for existing variables: ", paste(names[existing], 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) list(...) function(value) { if (!missing(value)) { stop("Binding is read-only.", call. = FALSE) } fun(name, ...) } } environment(make_active_binding_fun) <- .envir make_active_binding_fun } bindr/README.md0000644000177400001440000001320313011711132013006 0ustar murdochusers bindr [![Travis-CI Build Status](https://travis-ci.org/krlmlr/bindr.svg?branch=master)](https://travis-ci.org/krlmlr/bindr) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/krlmlr/bindr?branch=master&svg=true)](https://ci.appveyor.com/project/krlmlr/bindr) [![Coverage Status](https://img.shields.io/codecov/c/github/krlmlr/bindr/master.svg)](https://codecov.io/github/krlmlr/bindr?branch=master) [![CRAN\_Status\_Badge](http://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-k" append_random("X", sep = "+") #> Evaluating append_random(sep = "+") #> [1] "X+u" ``` 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" #> [18] "r" "s" "t" "u" "v" "w" "x" "y" "z" env$a #> Evaluating append_random(sep = "-") #> [1] "a-p" env$a #> Evaluating append_random(sep = "-") #> [1] "a-j" env$a #> Evaluating append_random(sep = "-") #> [1] "a-b" env$c #> Evaluating append_random(sep = "-") #> [1] "c-b" env$Z #> NULL ``` Bindings can also be added to existing environments: ``` r populate_env(env, LETTERS, append_random, "+") env$a #> Evaluating append_random(sep = "-") #> [1] "a-z" env$Z #> Evaluating append_random(sep = "+") #> [1] "Z+j" ``` 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-m" ``` 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, 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: a, b ``` 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(as.name("__ToLower__"), change_case) populate_env(env, as.name("__tOuPPER__"), change_case, TRUE) ls(env) #> [1] "__ToLower__" "__tOuPPER__" env$`__ToLower__` #> [1] "__tolower__" get("__tOuPPER__", env) #> [1] "__TOUPPER__" ``` bindr/MD50000644000177400001440000000133113011734160012044 0ustar murdochusersafc48b784bc1bc99e61d49fe6ab93b2e *DESCRIPTION d3d2f503f5c96ac395a270e7c295ec0b *LICENSE bfedbdf528857533acbe57424d0ec1ca *NAMESPACE ac0527407a23ee66268b4a0534bf8f01 *NEWS.md bbb31f70697967217d6e88924f7e57c9 *R/bindr-package.R 87c29cbcab26d8c686ea2414ef631b95 *R/populate.R 25b82adb8e21c5620fc03968dd92461b *README.md d8f31701d6400d94bcb519331f139232 *man/bindr-package.Rd 9d9a8aec71318df0046e422d54e005bc *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/DESCRIPTION0000644000177400001440000000143613011734160013250 0ustar murdochusersPackage: bindr Title: Parametrized Active Bindings Version: 0.1 Authors@R: c( person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r@mailbox.org"), person("RStudio", role = "cph") ) Description: Provides a simple interface for creating active bindings where the bound function accepts additional arguments. Suggests: testthat LazyData: true Date: 2016-11-12 BugReports: https://github.com/krlmlr/bindr/issues URL: https://github.com/krlmlr/bindr, https://krlmlr.github.io/bindr RoxygenNote: 5.0.1.9000 License: MIT + file LICENSE Encoding: UTF-8 NeedsCompilation: no Packaged: 2016-11-12 22:17:21 UTC; muelleki Author: Kirill Müller [aut, cre], RStudio [cph] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2016-11-13 01:48:48 bindr/man/0000755000177400001440000000000013011346125012311 5ustar murdochusersbindr/man/create_env.Rd0000644000177400001440000000264213011321007014707 0ustar murdochusers% 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/man/bindr-package.Rd0000644000177400001440000000157113011346125015273 0ustar murdochusers% 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{krlmlr+r@mailbox.org} Other contributors: \itemize{ \item RStudio [copyright holder] } } bindr/LICENSE0000644000177400001440000000004513010603432012536 0ustar murdochusersYEAR: 2016 COPYRIGHT HOLDER: RStudio