Patch proposal for match.fun()

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

Patch proposal for match.fun()

Berwin A Turlach
G'day all,

some time ago I sent an email regarding the following behaviour of
match.fun():

> x <- matrix(rnorm(200), ncol=2)
> var <- "fred"
> apply(x, 2, var)
Error in get(x, envir, mode, inherits) : variable "fred" of mode "function" was not found

and asked whether it would be desirable to change this behaviour such
that the function var would be found and no error would be produced.
I also asked whether there are arguments against such a change.

As I did not receive any arguments against such a change, I looked
into changing match.fun() such that the example above would work.  The
result is the patch attached below.  On my machine, r-devel passes
"make check FORCE=FORCE" with this patch applied.  Thus, hopefully
this change to match.fun() does not break anything.

I realise that there is now a lot of code replication in the function,
but was not sure whether it would be worthwile to write a small helper
function to reduce this replication.  (In particular, I was not sure
whether that would then involve using substitute thrice.  Since I
rarely use this command I am not so sure about its proper use.)

Also, I presume it is debatable whether a warning should be issued if
the lookup using get() fails if the argument was a character string of
length one.  Personally, I like it because the user still gets some
feedback that he used an (important) function name as variable name:

   > x <- matrix(rnorm(200), ncol=2)
   > var <- "foo"
   > apply(x, 2, var)
   [1] 1.055595 1.098397
   Warning message:
   Error in get(x, envir, mode, inherits) : variable "foo" of mode "function" was not found
    in: match.fun(FUN)

and the combination of warning + error should make it really easy to
track down situations like this:

   > foo <- "bar"
   > apply(x, 2, foo)
   Error in get(x, envir, mode, inherits) : variable "foo" of mode "function" was not found
   In addition: Warning message:
   Error in get(x, envir, mode, inherits) : variable "bar" of mode "function" was not found
    in: match.fun(FUN)

Of course, other people might have other tastes. :)

Please consider applying this patch (or a variation) to r-devel.

Thanks.

Cheers,

        Berwin


Index: src/library/base/R/match.fun.R
===================================================================
--- src/library/base/R/match.fun.R (revision 38204)
+++ src/library/base/R/match.fun.R (working copy)
@@ -5,7 +5,7 @@
 {
     if ( is.function(FUN) )
         return(FUN)
-    if (!(is.character(FUN) && length(FUN) == 1 || is.symbol(FUN))) {
+    if (!( (CL1 <- is.character(FUN) && length(FUN) == 1) || is.symbol(FUN))) {
         ## Substitute in parent
         FUN <- eval.parent(substitute(substitute(FUN)))
         if (!is.symbol(FUN))
@@ -13,12 +13,43 @@
                           deparse(FUN)), domain = NA)
     }
     envir <- parent.frame(2)
-    if( descend )
+    if( CL1 ) {
+      if( descend ){
+        TMPFUN <- try(get(FUN, mode = "function", env=envir), silent=TRUE)
+        if( inherits(TMPFUN, "try-error") ){
+          warning(TMPFUN)
+          FUN <- eval.parent(substitute(substitute(FUN)))
+          if (!is.symbol(FUN)){
+            stop(gettextf("'%s' is not a function, character or symbol",
+                          deparse(FUN)), domain = NA)
+          }
+          TMPFUN <- get(as.character(FUN), mode = "function", env=envir)
+        }
+        FUN <- TMPFUN
+      }
+      else {
+        TMPFUN <- try(get(FUN, mode = "any", env=envir), silent=TRUE)
+        if( inherits(TMPFUN, "try-error") ){
+          warning(TMPFUN)
+          FUN <- eval.parent(substitute(substitute(FUN)))
+          if (!is.symbol(FUN)){
+            stop(gettextf("'%s' is not a function, character or symbol",
+                          deparse(FUN)), domain = NA)
+          }
+          TMPFUN <- get(as.character(FUN), mode = "any", env=envir)
+        }
+        FUN <- TMPFUN
+        if( !is.function(FUN) )
+          stop(gettextf("found non-function '%s'", FUN), domain = NA)
+      }
+    } else {
+      if( descend )
         FUN <- get(as.character(FUN), mode = "function", env=envir)
-    else {
+      else {
         FUN <- get(as.character(FUN), mode = "any", env=envir)
         if( !is.function(FUN) )
-           stop(gettextf("found non-function '%s'", FUN), domain = NA)
+          stop(gettextf("found non-function '%s'", FUN), domain = NA)
+      }
     }
     return(FUN)
 }
Index: src/library/base/man/match.fun.Rd
===================================================================
--- src/library/base/man/match.fun.Rd (revision 38204)
+++ src/library/base/man/match.fun.Rd (working copy)
@@ -26,9 +26,10 @@
   example, enclosed in backquotes) or a
   character vector of length one, it will be looked up using \code{get}
   in the environment of the parent of the caller.  If it is of any other
-  mode, it is attempted first to get the argument to the caller as a
-  symbol (using \code{substitute} twice), and if that fails, an error is
-  declared.
+  mode, or if it is a character vector of length one and the look up
+  using \code{get} failed, it is attempted first to get the argument to
+  the caller as a symbol (using \code{substitute} twice), and if that
+  fails, an error is declared.
 
   If \code{descend = TRUE}, \code{match.fun} will look past non-function
   objects with the given name; otherwise if \code{FUN} points to a

______________________________________________
[hidden email] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel