version 0.3-7

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsubfn
-Version: 0.3-3
-Date: 2006-10-28
+Version: 0.3-7
+Date: 2007-10-17
 Title: Utilities for strings and function arguments.
 Author: G. Grothendieck
 Maintainer: G. Grothendieck <ggrothendieck@gmail.com>
@@ -18,8 +18,8 @@ Description: gsubfn is like gsub but can take a replacement function
    expects another function as an input argument.  gsubfn also
    provides for quasi-perl string interpolation in arguments
    of any existing R function.
-Depends: R (>= 2.4.0), proto
+Depends: R (>= 2.5.0), proto
 Suggests: boot, chron, doBy, grid, lattice, quantreg, reshape, zoo
 License: GPL (Version 2 or later)
 URL: http://code.google.com/p/gsubfn/
-Packaged: Sat Oct 28 08:49:30 2006; Kates
+Packaged: Thu Oct 16 14:43:21 2008; Louis

R/fn.R

@@ -1,3 +1,4 @@
+# eval.with.vis is no longer used - withVisible is used instead
 eval.with.vis <- function (expr) {
      expr <- substitute(expr)
      pf <- parent.frame()
@@ -9,15 +10,18 @@ eval.with.vis <- function (expr) {
 as.function.formula <- function(x, ...) {
 	vars <- setdiff(all.vars(x[[2]]), c("letters", "LETTERS", "pi"))
 	if (length(vars) == 0) { 
-		f <- function() {}
+		f0 <- function() {}
+		body(f0) <- x[[length(x)]]
+		environment(f0) <- environment(x)
+		f0
 	} else {
 		f <- function(x) {}
 		formals(f) <- rep(formals(f), length(vars))
 		names(formals(f)) <- vars
+		body(f) <- x[[length(x)]]
+		environment(f) <- environment(x)
+		f
 	}
-	body(f) <- x[[length(x)]]
-	environment(f) <- environment(x)
-	f
 }
 
 match.funfn <- function(x, ...) UseMethod("match.funfn")
@@ -58,9 +62,9 @@ fn <- structure(NA, class = "fn")
 		# is.fo2 is a logical vector indicating whether each
 		#    list element has or does not have a ~~ (double ~)
 
-		is.fo <- sapply(mcListE, function(x) is(x, "formula"))
+		is.fo <- sapply(mcListE, function(x) inherits(x, "formula"))
 		any.fo <- any(is.fo)
-		is.fo2 <- sapply(mcListE, function(x) is(x, "formula") &&
+		is.fo2 <- sapply(mcListE, function(x) inherits(x, "formula") &&
 			length(x[[length(x)]]) > 1 &&
 			identical(x[[length(x)]][[1]], as.name("~")))
 		# change ~~ to ~
@@ -82,7 +86,7 @@ fn <- structure(NA, class = "fn")
 		if (any.chara)
 		   for(i in seq(along = mcListE))
 		      if (is.chara[i])
-			mcListE[[i]] <- gsubfn(x = substring(mcListE[[i]], 2))
+			mcListE[[i]] <- gsubfn(x = substring(mcListE[[i]], 2), env = p)
 
 		# if no ~~ formulas and no \1 strings use default strategy
 		# of converting all formulas to functions and if no formulas
@@ -96,13 +100,14 @@ fn <- structure(NA, class = "fn")
 		      if (any.char)
 		         for(i in seq(along = mcListE))
 		            if (is.char[i])
-			       mcListE[[i]] <- gsubfn(x = mcListE[[i]])
+			       mcListE[[i]] <- gsubfn(x = mcListE[[i]], env = p)
 		   }
 		}
 
 		# out <- do.call(FUN, args)
 		# thanks Duncan for eval.with.vis !!!
-		out <- eval.with.vis(do.call(FUN, mcListE, env=parent.frame()))
+		# out <- eval.with.vis(do.call(FUN, mcListE, env=p))
+		out <- withVisible(do.call(FUN, mcListE, env=p))
 		vis <- out$visible
 		out <- out $value
 		if (!is.null(simplify)) {

R/gsubfn.R

@@ -23,22 +23,38 @@
 gsubfn <- function(pattern, replacement, x, backref, USE.NAMES = FALSE, 
   env = parent.frame(), ...) 
 {
-   if (missing(replacement)) replacement <- function(x,b1,b2) 
-	eval(parse(text = paste(b1,b2,sep="")), env) 
+
+   here <- environment()
+
+   if (missing(replacement)) here$replacement <- function(...) 
+	eval(parse(text = paste(..., sep = "")), env) 
+
    if (is.character(replacement)) 
 	return(base::gsub(pattern, replacement, x, ...))
+
+   if (is.list(replacement)) {
+			values.replacement <- replacement
+			names.replacement <- names(replacement)
+			here$replacement <- function(...) {
+				idx <- match(..1, names.replacement, 
+					nomatch = match("", names.replacement, nomatch = 0))
+				if (idx > 0) values.replacement[[idx]]
+				else ..1
+			}
+    }
    # if (inherits(replacement, "formula")) replacement <- as.function(replacement)
    if (missing(pattern)) pattern <- "[$]([[:alpha:]][[:alnum:].]*)|`([^`]+)`"
    if (missing(backref)) {
-        i <- 1
 	j <- nchar(base::gsub("[^(]","",pattern))+1
+    i <- 1
+	i <- min(2, j)
    } else {
 	i <- as.numeric(backref < 0) + 1
 	j <- abs(backref)+1
    }
 
    e <- NULL
-   if (!is(replacement, "formula") && !is.function(replacement)) {
+   if (!inherits(replacement, "formula") && !is.function(replacement)) {
 	e <- replacement
 	e$pattern <- pattern
 	e$x <- x
@@ -55,9 +71,9 @@ gsubfn <- function(pattern, replacement, x, backref, USE.NAMES = FALSE,
 		this$match <- c(...)
 		this$fun(...)
 	}
-	replacement <- e$replacement
+	here$replacement <- e$replacement
    }
-   replacement <- match.funfn(replacement)
+   here$replacement <- match.funfn(replacement)
    stopifnot(is.character(pattern), is.character(x), is.function(replacement))
    force(env)
    gsub.function <- function(x) {
@@ -98,6 +114,17 @@ strapply <-
 function (X, pattern, FUN = function(x, ...) x, ...,
     simplify = FALSE, USE.NAMES = FALSE, combine = c) 
 {
+	if (is.character(FUN)) {
+		FUN.orig <- FUN
+		FUN <- function(...) FUN.orig
+	} else if (is.list(FUN)) {
+		FUN.orig <- FUN
+		FUN <- function(...) {
+			FUN.orig[[match(..1, names(FUN.orig), 
+				nomatch = match("", names(FUN.orig)))]]
+		}
+	}
+
     p <- if (is.proto(FUN)) {
 		FUN$X <- X
 		FUN$pattern <- pattern
@@ -107,18 +134,18 @@ function (X, pattern, FUN = function(x, ...) x, ...,
 		proto(
 			pre = function(this) { 
 				this$first <- TRUE
-				v <- NULL
+				this$v <- NULL
 				if (!is.null(FUN[["pre"]])) FUN$pre()
 			},
 			fun = function(this, ...) {
-				FUN$count <- count
-				this$v <- if (first) combine(FUN$fun(...))
-				else c(v, combine(FUN$fun(...)))
-				first <<- FALSE
+				FUN$count <- this$count
+				this$v <- if (this$first) combine(FUN$fun(...))
+				else c(this$v, combine(FUN$fun(...)))
+				this$first <- FALSE
 			},
 			post = function(this) {
 				# cat("A:", first, "\n")
-				if (first) this$v <- NULL
+				if (this$first) this$v <- NULL
 				if (!is.null(FUN[["post"]])) FUN$post()
 			},
 		    ) 
@@ -130,13 +157,13 @@ function (X, pattern, FUN = function(x, ...) x, ...,
 				this$v <- NULL 
 			},
 			fun = function(this, ...) {
-				this$v <- if (first) combine(FUN(...))
-				else c(v, combine(FUN(...)))
-				first <<- FALSE
+				this$v <- if (this$first) combine(FUN(...))
+				else c(this$v, combine(FUN(...)))
+				this$first <- FALSE
 			},
 			post = function(this) { 
 				# cat("B:", first, "\n")
-				if (first) this$v <- NULL  
+				if (this$first) this$v <- NULL  
 			}
 		)
         }
@@ -148,7 +175,3 @@ function (X, pattern, FUN = function(x, ...) x, ...,
     else do.call(match.funfn(simplify), result)
 }
 
-
-
-
-

demo/00Index

@@ -1,5 +1,4 @@
 gsubfn-chron		read in zoo data with chron datetimes.
 gsubfn-cut		Use strapply to extract endpoints from cut labels.
 gsubfn-gries		Stefan Gries' Linguistics code.
-gsubfn-proto		Use of proto objects with gsubfn and strapply.
 gsubfn-si		Replace SI scale letter with number.

demo/gsubfn-chron.R

@@ -14,7 +14,7 @@ Lines <- "2006-01-24 02:41:24.00011,1.22930000,5,1.22950000,7
 # convert to chron
 to.chron <- function(x) 
    strapply(format(x), "([0-9-]+) ([0-9:]+)",
-	~ chron(as.Date(dd), tt), backref = -2,simplify = c)
+	~ chron(as.numeric(as.Date(dd)), tt), simplify = c)
 
 con <- textConnection(Lines)
 read.zoo(con, sep = ",", FUN = to.chron)

demo/gsubfn-gries.R

@@ -15,7 +15,7 @@ Lines2 <- scan(fn2, what = "char", sep = "\n")
 tagged.corpus.sentences <- grep("^<s n=", Lines2, value = TRUE)
 # just to see what it looks like
 tagged.corpus.sentences[c(3, 8)]
-words <- unlist(strapply(tagged.corpus.sentences, ">([^<]*)", backref = -1))
+words <- unlist(strapply(tagged.corpus.sentences, ">([^<]*)"))
 words <- gsub(" $", "", words)
 tail(words, 25)
 

demo/gsubfn-si.R

@@ -4,8 +4,8 @@
 # replace letter with e followed by appropriate digits.
 # (see formatEng2R by Hans-Joerg Bibiko in the R Wiki)
 
-conv <- c(y = "e-24", z = "e-21", a = "e-18", f = "e-15", p = "e-12", 
+conv <- list(y = "e-24", z = "e-21", a = "e-18", f = "e-15", p = "e-12", 
     n = "e-9", `µ` = "e-6", m = "e-3", d = "e-1", c = "e-2", k = "e3", 
     M = "e6", G = "e9", T = "e12", P = "e15", E = "e18", Z = "e21", Y = "e24") 
-gsubfn(".$", x ~ if (x %in% names(conv)) conv[x] else x, c("19", "32.5M"))
+gsubfn(".$", conv, c("19", "32.5M"))
 

inst/NEWS

@@ -1,3 +1,45 @@
+Changes in 0.3-7
+
+	o R CMD CHECK fixes
+
+	o if replacement object is a list and match not found in that list then
+	  no replacement is done
+
+Changes in 0.3-6
+
+    o bug fixes: fn$force("$x") failed if variable name was x as shown here
+
+	o bug fixes: f <- function() { aaa <- "X"; fn$cat("abc$aaa def\n") }; f()
+	  failed.
+
+	o internals: eval.with.vis() replaced in $.fn.  Now using withVisible().
+      This change requires R 2.5 or later.
+
+	o the replacement object in gsubfn can be a list as well
+
+	o the replacement object in strapply can be a character string or list
+      as well
+
+    o if backref= is omitted on gsubfn or strapply it passes the backreferences
+      if any (but not the entire match) or if there are no back references
+      it passes the entire match.  Thus the default has changed in the case
+      that (1) there are one or more backreferences in the regular expression 
+      and (2) backref was not specified.  This should eliminate the need to 
+      specify backref in most circumstances.  Note that if there are no 
+      backreferences in your regular expression or if backref= had been
+      specified there is no change thus in most cases there will be no change.
+
+Changes in 0.3-5
+
+	o fixed bug in demo index
+
+	o eliminated dependence on methods package (previously only
+	  dependence was use of 'is')
+
+Changes in 0.3-4
+
+	o fixed typo
+
 Changes in 0.3-3
 
 	o changed quantreg example to reflect change in engel data set

inst/WISHLIST

@@ -1,20 +1,16 @@
 
 WISHLIST
 
-o assign("mywarn", NULL, .GlobalEnv)
-  fn$tryCatch( warning("a warning"), 
-    warning = w ~ mywarn <<- conditionMessage(w))
-  print(mywarn)
-does not work.
-
 o xml features
 
 o better simplification
 
-o handle invisible output
-
 o extend fn$ to proto objects
 
 o can current rules of determining which formulas to convert to functions
   and which strings to perform interpolation on be improved?
 
+o check number of function args in addition to the number of ( to improve
+  backref heuristic
+
+o add named character vectors as replacement argument objects