page() (Was: Re: predict.smooth.spline.fit and Recall() (Was: Re: Return function from function and Recall()))

Here I think S3 dispatch is very natural.  Try the following:

page <- function(x, method = c("dput", "print"), ...) UseMethod("page")

page.getAnywhere <- function(x, ..., idx=NULL) {
 name <- x$name;
 objects <- x$obj;

 if (length(objects) == 0)
   stop("no object named '", name, "' was found");

 if (is.null(idx)) {
   # Include all non-duplicated objects found
   idx <- (1:length(objects))[!x$dups];
 }

 for (ii in idx) {
   title <- paste(name, " (", x$where[ii], ")", sep="");
   eval(substitute({
     object <- x$obj[[ii]];
     page(object, ...);
   }, list(object=as.name(title))));
 }
}

page.default <- utils::page;

page(getAnywhere("predict.smooth.spline.fit"))

You can have page.function(), page.character(), page.environment(),
etc. and make these call page.default() indirectly.  What I think
would be a very useful add on is to add an argument 'title' for which
you can set/override the title.  Then the "ugly" substitute() calls
could be limited to one specific case; where a "default" object is
passed and no title is set.

If you want to, I could play around with a bit.

/Henrik

On 4/5/06, Kurt Hornik <Kurt.Hornik at wu-wien.ac.at> wrote:

Prof Brian Ripley writes:

On Wed, 5 Apr 2006, Henrik Bengtsson wrote:

Hi,

[snip]

As for

PS, may I suggest to modify page() so that
'page(getAnywhere("predict.smooth.spline.fit"))' works? DS.

it is rather tricky.  page() takes a name aka symbol as its argument
(and is thereby S-compatible), and also works with a bare character
string (undocumented).  What you have here is a call that does not
even return a function.  It is more reasonable that
stats:::predict.smooth.spline.fit should work, and it is also a call.
I have in the past thought about special-casing that, but it is a
valid name (you would have to back-quote it, but it does work).  So
one possible way out would be to use get() on a name and evaluate
calls, e.g.

page <- function(x, method = c("dput", "print"), ...)
{
     subx <- substitute(x)
     have_object <- FALSE
     if(is.call(subx)) {
         object <- x
         have_object <- TRUE
         subx <- deparse(subx)
     } else {
         if(is.character(x)) subx <- x
         else if(is.name(subx)) subx <- deparse(subx)
         if (!is.character(subx) || length(subx) != 1)
             stop("'page' requires a name, call or character string")
         parent <- parent.frame()
         if(exists(subx, envir = parent, inherits=TRUE)) {
             object <- get(subx, envir = parent, inherits=TRUE)
             have_object <- TRUE
         }
     }
     if(have_object) {
         method <- match.arg(method)
         file <- tempfile("Rpage.")
         if(method == "dput")
             dput(object, file)
         else {
             sink(file)
             print(object)
             sink()
         }
      file.show(file, title = subx, delete.file = TRUE, ...)
     } else
      stop(gettextf("no object named '%s' to show", subx), domain = NA)
}

which also allows 1-element character vectors (and I am not entirely
sure we want that).

There was a similar issue with prompt() (actually, its default method)
for which I ended up "temporarily" providing the following (argh):

        else {
            name <- substitute(object)
            if (is.name(name))
                as.character(name)
            else if (is.call(name) && (as.character(name[[1]]) %in%
                c("::", ":::", "getAnywhere"))) {
                name <- as.character(name)
                name[length(name)]
            }
            else stop("cannot determine a usable name")
        }

Best
-k

On Wed, 5 Apr 2006, Henrik Bengtsson wrote:

Here I think S3 dispatch is very natural.  Try the following:

I don't: it is documented to work on a name not an object.

page <- function(x, method = c("dput", "print"), ...) UseMethod("page")

page.getAnywhere <- function(x, ..., idx=NULL) {
 name <- x$name;
 objects <- x$obj;

 if (length(objects) == 0)
   stop("no object named '", name, "' was found");

 if (is.null(idx)) {
   # Include all non-duplicated objects found
   idx <- (1:length(objects))[!x$dups];
 }

 for (ii in idx) {
   title <- paste(name, " (", x$where[ii], ")", sep="");
   eval(substitute({
     object <- x$obj[[ii]];
     page(object, ...);
   }, list(object=as.name(title))));
 }
}

page.default <- utils::page;

page(getAnywhere("predict.smooth.spline.fit"))

You can have page.function(), page.character(), page.environment(),
etc. and make these call page.default() indirectly.  What I think
would be a very useful add on is to add an argument 'title' for which
you can set/override the title.  Then the "ugly" substitute() calls
could be limited to one specific case; where a "default" object is
passed and no title is set.

If you want to, I could play around with a bit.

/Henrik

On 4/5/06, Kurt Hornik <Kurt.Hornik at wu-wien.ac.at> wrote:

Prof Brian Ripley writes:

On Wed, 5 Apr 2006, Henrik Bengtsson wrote:

Hi,

[snip]

As for

PS, may I suggest to modify page() so that
'page(getAnywhere("predict.smooth.spline.fit"))' works? DS.

it is rather tricky.  page() takes a name aka symbol as its argument
(and is thereby S-compatible), and also works with a bare character
string (undocumented).  What you have here is a call that does not
even return a function.  It is more reasonable that
stats:::predict.smooth.spline.fit should work, and it is also a call.
I have in the past thought about special-casing that, but it is a
valid name (you would have to back-quote it, but it does work).  So
one possible way out would be to use get() on a name and evaluate
calls, e.g.

page <- function(x, method = c("dput", "print"), ...)
{
     subx <- substitute(x)
     have_object <- FALSE
     if(is.call(subx)) {
         object <- x
         have_object <- TRUE
         subx <- deparse(subx)
     } else {
         if(is.character(x)) subx <- x
         else if(is.name(subx)) subx <- deparse(subx)
         if (!is.character(subx) || length(subx) != 1)
             stop("'page' requires a name, call or character string")
         parent <- parent.frame()
         if(exists(subx, envir = parent, inherits=TRUE)) {
             object <- get(subx, envir = parent, inherits=TRUE)
             have_object <- TRUE
         }
     }
     if(have_object) {
         method <- match.arg(method)
         file <- tempfile("Rpage.")
         if(method == "dput")
             dput(object, file)
         else {
             sink(file)
             print(object)
             sink()
         }
      file.show(file, title = subx, delete.file = TRUE, ...)
     } else
      stop(gettextf("no object named '%s' to show", subx), domain = NA)
}

which also allows 1-element character vectors (and I am not entirely
sure we want that).

There was a similar issue with prompt() (actually, its default method)
for which I ended up "temporarily" providing the following (argh):

        else {
            name <- substitute(object)
            if (is.name(name))
                as.character(name)
            else if (is.call(name) && (as.character(name[[1]]) %in%
                c("::", ":::", "getAnywhere"))) {
                name <- as.character(name)
                name[length(name)]
            }
            else stop("cannot determine a usable name")
        }

Best
-k

--
Brian D. Ripley,                  ripley at stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595