[med-svn] [r-cran-bindr] 01/02: New upstream version 0.1
Andreas Tille
tille at debian.org
Sat Sep 30 11:31:12 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-bindr.
commit f566048799e63aec16b280469fc3c6c835e31b4f
Author: Andreas Tille <tille at debian.org>
Date: Sat Sep 30 13:30:49 2017 +0200
New upstream version 0.1
---
DESCRIPTION | 24 ++++++
LICENSE | 2 +
MD5 | 14 ++++
NAMESPACE | 4 +
NEWS.md | 8 ++
R/bindr-package.R | 4 +
R/populate.R | 85 +++++++++++++++++++++
README.md | 166 +++++++++++++++++++++++++++++++++++++++++
man/bindr-package.Rd | 34 +++++++++
man/create_env.Rd | 44 +++++++++++
tests/testthat.R | 4 +
tests/testthat/test-create.R | 46 ++++++++++++
tests/testthat/test-error.R | 14 ++++
tests/testthat/test-payload.R | 19 +++++
tests/testthat/test-populate.R | 15 ++++
15 files changed, 483 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..2112d70
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,24 @@
+Package: bindr
+Title: Parametrized Active Bindings
+Version: 0.1
+Authors at R: c(
+ person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r at 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 <krlmlr+r at mailbox.org>
+Repository: CRAN
+Date/Publication: 2016-11-13 01:48:48
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..120294d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2016
+COPYRIGHT HOLDER: RStudio
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..94987e3
--- /dev/null
+++ b/MD5
@@ -0,0 +1,14 @@
+afc48b784bc1bc99e61d49fe6ab93b2e *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
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..acffcc9
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,4 @@
+# Generated by roxygen2: do not edit by hand
+
+export(create_env)
+export(populate_env)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..714ceb3
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,8 @@
+# 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.
diff --git a/R/bindr-package.R b/R/bindr-package.R
new file mode 100644
index 0000000..af116ad
--- /dev/null
+++ b/R/bindr-package.R
@@ -0,0 +1,4 @@
+#' @details
+#' See [create_env()] for creating an environment populated with active bindings,
+#' and [populate_env()] for populating an existing environment.
+"_PACKAGE"
diff --git a/R/populate.R b/R/populate.R
new file mode 100644
index 0000000..0071a6a
--- /dev/null
+++ b/R/populate.R
@@ -0,0 +1,85 @@
+#' 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
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..9bf8a17
--- /dev/null
+++ b/README.md
@@ -0,0 +1,166 @@
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+bindr [](https://travis-ci.org/krlmlr/bindr) [](https://ci.appveyor.com/project/krlmlr/bindr) [](https://codecov.io/github/krlmlr/bindr?branch=master) [] [...]
+============================================================================================================================================================================================================================================================================================================================================================================================================================================================================================================ [...]
+
+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 th [...]
+
+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 <Rcpp.h>
+
+#include <algorithm>
+#include <string>
+
+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__"
+```
diff --git a/man/bindr-package.Rd b/man/bindr-package.Rd
new file mode 100644
index 0000000..be6ed60
--- /dev/null
+++ b/man/bindr-package.Rd
@@ -0,0 +1,34 @@
+% 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 at mailbox.org}
+
+Other contributors:
+\itemize{
+ \item RStudio [copyright holder]
+}
+
+}
+
diff --git a/man/create_env.Rd b/man/create_env.Rd
new file mode 100644
index 0000000..8095f51
--- /dev/null
+++ b/man/create_env.Rd
@@ -0,0 +1,44 @@
+% 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
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..43d5eae
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(bindr)
+
+test_check("bindr")
diff --git a/tests/testthat/test-create.R b/tests/testthat/test-create.R
new file mode 100644
index 0000000..0c0183d
--- /dev/null
+++ b/tests/testthat/test-create.R
@@ -0,0 +1,46 @@
+context("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")
+})
diff --git a/tests/testthat/test-error.R b/tests/testthat/test-error.R
new file mode 100644
index 0000000..9c842ce
--- /dev/null
+++ b/tests/testthat/test-error.R
@@ -0,0 +1,14 @@
+context("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)
+ )
+})
diff --git a/tests/testthat/test-payload.R b/tests/testthat/test-payload.R
new file mode 100644
index 0000000..d902b90
--- /dev/null
+++ b/tests/testthat/test-payload.R
@@ -0,0 +1,19 @@
+context("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")
+})
diff --git a/tests/testthat/test-populate.R b/tests/testthat/test-populate.R
new file mode 100644
index 0000000..82ab861
--- /dev/null
+++ b/tests/testthat/test-populate.R
@@ -0,0 +1,15 @@
+context("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")
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-bindr.git
More information about the debian-med-commit
mailing list