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

From: Henrik Bengtsson <hb_at_maths.lth.se>
Date: Wed 05 Apr 2006 - 12:24:12 GMT


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@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
>
> ______________________________________________
> R-devel@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel



R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Wed Apr 05 23:59:11 2006

This archive was generated by hypermail 2.1.8 : Wed 05 Apr 2006 - 16:16:56 GMT