[R] Help on a Display function

[William Dunlap]

> -----Original Message-----
> From: r-help-bounces at r-project.org 
> [mailto:r-help-bounces at r-project.org] On Behalf Of Hans W Borchers
> Sent: Friday, January 14, 2011 8:55 AM
> To: r-help at stat.math.ethz.ch
> Subject: [R] Help on a Display function
> 
> >
> I wanted to simulate the Matlab DISPLAY function for some time now.
> After seeing a recent proposal by Gabor Grothendieck I came 
> up with the
> following solution,
> 
> display <- function(...) {
>   my_names  <- 
> lapply(substitute(placeholderFunction(...))[-1], deparse)
>   for (my in my_names) cat(my, "=", eval(parse(text=my)), 
> "\n", sep=" ")
> }
> 
> that works about as good as I would have hoped:
> 
>     > a <- 1; b <- a + 1
>     > display(a, b, sin(1))
>     a = 1 
>     b = 2 
>     sin(1) = 0.841471

But it fails on this:
  > my_names <- c("Bill", "William")
  > display(rev(my_names))
  rev(my_names) = Error in cat(list(...), file, sep, fill, labels,
append) : 
    argument 3 (type 'list') cannot be handled by 'cat'
This is because you call eval() using the environment of the
function, while ordinary argument evaluation evaluates them
in the environment of the caller.   Do not use eval() directly
but use the ordinary evaluation that R does automatically.  E.g.,

  display2 <- function (...) 
  {
      evaluatedArgs <- list(...)
      argTags <- names(evaluatedArgs)
      deparsedArgs <- lapply(substitute(placeholderFunction(...))[-1], 
          function(expr) {
              d <- deparse(expr)
              paste(d, collapse = "\n        ") # or d[1] or ...
        })
      # use if(is.null(argTags)) ... cat without argTags ... ?
      cat(paste(sep = " = ", argTags, deparsedArgs, evaluatedArgs), 
          sep = "\n")
  }
  > my_names <- c("Bill", "William")
  > display2(rev(my_names))
   = rev(my_names) = c("William", "Bill")
  > display2(strings=rev(my_names))
  strings = rev(my_names) = c("William", "Bill")
  > display2(x=log(10), 1+2+3,
z=(function(p){lp<-log(p);lp+lp^2/2+lp^3/6})(0.2))
  x = log(10) = 2.30258509299405
   = 1 + 2 + 3 = 6
  z = (function(p) {
              lp <- log(p)
              lp + lp^2/2 + lp^3/6
          })(0.2) = -1.00911130949159

> 
> My questions:
> 
> (1) Is there a better or more appropriate way to write such a 
> function? ---
>     I'm not so well versed in internal R functions such as 
> (de)parse(),
>     substitute(), or eval().
> 
> (2) What is the role of the "placeholderFunction"? I could 
> not find enough
>     information about it resp. about the whole construction.

The function
  f <- function(x) substitute(func(x))
produces an object of class "call" whose first element
is the name "func" and whose subsequent elements are
the arguments in the call.  The [-1] strips off the
function name.  You might also do
  f <- function(x) substitute((x))
which produces an object of class "(" whose first element
is the name "(" which you can strip off.  "(" is easier
to misread and "(" objects must have length 2, while
call objects have any length greater than 0.

I learned about this by playing around with the output of
quote() (or parse() or substitute() or expression()).  Look
at the class, length, and [[elements]] of expressions.
The following str.language might get you started.  It prints
the name, class, length, and a summary of the value of each
part of an expression.

str.language <-
function (object, ..., level = 0, name = myDeparse(substitute(object))) 
{
    abbr <- function(string, maxlen = 25) {
        if (length(string) > 1 || nchar(string) > maxlen) 
            paste(substring(string[1], 1, maxlen), "...", sep = "")
        else string
    }
    myDeparse <- function(object) {
        if (!is.environment(object)) {
            deparse(object)
        }
        else {
            ename <- environmentName(object)
            if (ename == "") 
                ename <- "<unnamed env>"
            paste(sep = "", "<", ename, "> ", paste(collapse = " ", 
                objects(object)))
        }
    }
    cat(rep("  ", level), sep = "")
    if (is.null(name)) 
        name <- ""
    cat(sprintf("`%s` %s(%d): %s\n", abbr(name), class(object), 
        length(object), abbr(myDeparse(object))))
    a <- attributes(object)
    if (is.recursive(object) && !is.environment(object)) {
        object <- as.list(object)
        names <- names(object)
        for (i in seq_along(object)) {
            str.language(object[[i]], ..., level = level + 1, 
                name = names[i])
        }
    }
    a$names <- NULL
    if (length(a) > 0) {
        str.language(a, level = level + 1, name = paste("Attributes of",

            abbr(name)))
    }
}
<environment: R_GlobalEnv>
> str.language(quote(func(x, ...)))
`quote(func(x, ...))` call(3): func(x, ...)
  `` name(1): func
  `` name(1): x
  `` name(1): ...
> str.language(quote(if(isGood)cat("Yes!\n") else NULL))
`quote(if (isGood) cat("Ye...` if(4): if (isGood) cat("Yes!\n")...
  `` name(1): if
  `` name(1): isGood
  `` call(2): cat("Yes!\n")
    `` name(1): cat
    `` character(1): "Yes!\n"
  `` NULL(0): NULL

Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com 

> 
> Thanks, Hans Werner
> 
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide 
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>