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 <[EMAIL PROTECTED]> 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
>
>
--
Brian D. Ripley, [EMAIL PROTECTED]
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
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
