port in named map builder and lambda

Author: JohnMount

DESCRIPTION

@@ -2,7 +2,7 @@ Package: wrapr
 Type: Package
 Title: Wrap R Functions for Debugging and Parametric Programming
 Version: 0.4.1
-Date: 2017-07-29
+Date: 2017-08-24
 Authors@R: c(
     person("John", "Mount", email = "[email protected]", role = c("aut", "cre")),
     person("Nina", "Zumel", email = "[email protected]", role = c("aut")),

NAMESPACE

@@ -1,6 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(":=",character)
+S3method(":=",formula)
+S3method(":=",list)
 export("%.>%")
+export(":=")
 export(DebugFn)
 export(DebugFnE)
 export(DebugFnW)
@@ -11,6 +15,9 @@ export(add_name_column)
 export(ateval)
 export(beval)
 export(buildNameCallback)
+export(lambda)
 export(let)
+export(makeFunction_se)
+export(named_map_builder)
 export(restrictToNameAssignments)
 export(seval)

NEWS.md

@@ -1,7 +1,8 @@
 
-# wrapr 0.4.1 2017-07-29
+# wrapr 0.4.1 2017-08-24
 
  * Do not insist let-mapping be invertible.
+ * Migrate named map builder and lambda from seplyr.de
 
 # wrapr 0.4.0 2017-07-22
 

R/lambda.R

@@ -0,0 +1,83 @@
+
+
+#' Build an anonymous function.
+#'
+#' Developed from:
+#' \url{http://www.win-vector.com/blog/2016/12/the-case-for-using-in-r/comment-page-1/#comment-66399},
+#'  \url{https://github.com/klmr/functional#a-concise-lambda-syntax},
+#'  \url{https://github.com/klmr/functional/blob/master/lambda.r}
+#' Called from \code{:=} operator.
+#'
+#' @param params formal parameters of function, unbound names.
+#' @param body subsituted body of function to map arguments into (braces required for ":=" notation).
+#' @param env environment to work in.
+#' @return user defined function.
+#'
+#' @examples
+#'
+#' f <- makeFunction_se(as.name('x'), substitute({x*x}))
+#' f(7)
+#'
+#' f <- x := { x*x }
+#' f(7)
+#'
+#' g <- makeFunction_se(c(as.name('x'), as.name('y')), substitute({ x + 3*y }))
+#' g(1,100)
+#'
+#' g <- c(x,y) := { x + 3*y }
+#' g(1,100)
+#'
+#' @export
+#'
+makeFunction_se <- function(params, body, env = parent.frame()) {
+  vars <- as.character(params)
+  formals <- replicate(length(vars), quote(expr = ))
+  names(formals) <- vars
+  eval(call('function', as.pairlist(formals), body), env)
+}
+
+
+
+#' Build an anonymous function.
+#'
+#' Mostly just a place-holder so lambda-symbol form has somewhere safe to hang its help entry.
+#'
+#' @param ... formal parameters of function, unbound names, followed by function body (code/language).
+#' @param env environment to work in
+#' @return user defined function.
+#'
+#' @examples
+#'
+#' #lambda-syntax: lambda(arg [, arg]*, body [, env=env])
+#' # also works with lambda character as function name
+#' # print(intToUtf8(0x03BB))
+#'
+#' # example: square numbers
+#' sapply(1:4, lambda(x, x^2))
+#'
+#' # example more than one argumnet
+#' f <- lambda(x, y, x+y)
+#' f(2,4)
+#'
+#' # formula interface syntax: [~arg|arg(~arg)+] := body
+#' f <- x~y := x + 3 * y
+#' f(5, 47)
+#'
+#' @export
+#'
+lambda <- function(..., env = parent.frame()) {
+  args <- substitute(list(...))
+  body <- args[[length(args)]]
+  args <- args[-length(args)]
+  params <- lapply(args[-1], as.name)
+  makeFunction_se(params, body, env)
+}
+
+#' @export
+`:=.formula` <- function(args, values) {
+  env = parent.frame()
+  params <- setdiff(as.character(all.vars(substitute(args))),
+                    '~')
+  body <- substitute(values)
+  makeFunction_se(params, body, env)
+}

R/namedMapBuilder.R

@@ -0,0 +1,80 @@
+
+
+#' Named map builder.
+#'
+#' Set names of right-argument to be left-argument, and return right argument.
+#' Has a special case for length-1 name sets.
+#' Called from \code{:=} operator.
+#'
+#' @param names names to set.
+#' @param values values to assign names to (and return).
+#' @return values with names set.
+#'
+#' @examples
+#'
+#'
+#' c('a' := '4', 'b' := '5')
+#' # equivalent to: c(a = '4', b = '5')
+#'
+#' c('a', 'b') := c('1', '2')
+#' # equivalent to: c(a = '1', b = '2')
+#'
+#' # the important example
+#' name <- 'a'
+#' name := '5'
+#' # equivalent to: c('a' = '5')
+#'
+#' # fn version, see makeFunction_se
+#' g <- c(x,y) := { x + 3*y }
+#' g(1,100)
+#'
+#' @export
+named_map_builder <- function(names, values) {
+  # sepcial case 'a' := c('b', 'c') -> a := 'bc'
+  if((length(values)>1)&&(length(names)==1)) {
+    values <- do.call(paste0, as.list(values))
+  }
+  # main case
+  names(values) <- as.character(names)
+  values
+}
+
+#' @rdname named_map_builder
+#' @export
+`:=` <- function(names, values) {
+  # check if this was a lambda assignment
+  # only consider so if LHS is variables and RHS has {}
+  nv <- substitute(names)
+  vl <- substitute(values)
+  isVarArray <- is.call(vl) &&
+    (as.character(vl[[1]])=='{') &&
+    is.language(nv) &&
+    all(vapply(nv, is.name, logical(1))) &&
+    (length(nv<=1) ||
+       ((!any(vapply(nv, is.call, logical(1)))) &&
+          as.character(nv[[1]])=='c'))
+  if(isVarArray) {
+    return(makeFunction_se(all.vars(nv), vl,  parent.frame()))
+  }
+  # use standard S3 dispatch
+  rm(list= c('nv', 'vl'))
+  UseMethod(":=")
+}
+
+# override as few S3 types as we reasonably need.
+# deliberaterly leave default alone
+# as a "good citizen".
+
+# #' @export
+# `:=.default` <- named_map_builder
+
+#' @export
+`:=.character` <- named_map_builder
+
+#' @export
+`:=.list` <- named_map_builder
+
+#' #' @export
+#' `:=.name` <- named_map_builder
+
+

R/zzz.R

@@ -0,0 +1,6 @@
+
+# https://stackoverflow.com/questions/20223601/r-how-to-run-some-code-on-load-of-package
+.onLoad <- function(libname, pkgname){
+  # write lambda into package namespace
+  do.call('<<-', list(intToUtf8(0x03BB), lambda))
+}

cran-comments.md

@@ -6,17 +6,18 @@
  * using R version 3.4.1 (2017-06-30)
  * win-builder (devel and release) 
 
-## R CMD check --as-cran wrapr_0.4.0.tar.gz
+## R CMD check --as-cran wrapr_0.4.1.tar.gz
 
 * using R version 3.4.1 (2017-06-30)
 * using platform: x86_64-apple-darwin15.6.0 (64-bit)
 * using session charset: UTF-8
 * using option ‘--as-cran’
 * checking for file ‘wrapr/DESCRIPTION’ ... OK
 * checking extension type ... Package
-* this is package ‘wrapr’ version ‘0.4.0’
+* this is package ‘wrapr’ version ‘0.4.1’
 * package encoding: UTF-8
 
+
 * checking CRAN incoming feasibility ... Note_to_CRAN_maintainers
 Maintainer: ‘John Mount <[email protected]>’