Re: R-alpha: patch for NextMethod

Gregory R. Warnes (warnes@biostat.washington.edu)
Wed, 18 Sep 1996 13:28:13 -0700 (PDT)


Date: Wed, 18 Sep 1996 13:28:13 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>
Subject: Re: R-alpha: patch for NextMethod
In-Reply-To: <Pine.SUN.3.91.960918130618.13750F-100000@babcomm>


This should read:

> When NextMethod was called on an object for which there was not an
                                                              ^^^
> appropriate method defined, it generated and error rather than calling
> the default method.  For example:

Sorry,

Greg

On Wed, 18 Sep 1996, Gregory R. Warnes wrote:

> 
> When NextMethod was called on an object for which there was an 
> appropriate method defined, it generated and error rather than calling 
> the default method.  For example:
> 
> [in R]
> > x _ c(1,2,3)
> > class(x) _ c("test","test2")
> > print.test _
> function (x, ...) 
> {
> 	NextMethod("print", x)
> }
> > print(x)
> > print(x)
> test test2 :Error: couldn't find function "print.test2"
> 
> [in Splus 3.3]
> > x _ c(1,2,3)
> > class(x) _ c("test","test2")
> > print.test _
> function (x, ...)
> {
>         NextMethod("print")
> }
> > print(x)
> [1] 1 2 3
> attr(, "class"):
> [1] "test"  "test2"
> 
> 
> Fixed version of NextMethod:
> ===========================
> 
> "NextMethod" <-
> function (name, object, ...) 
> {
> 	parentenv <- sys.frame(sys.parent())
> 	call <- sys.call(sys.parent())
> 	cname <- call[[1]]
> 	if (missing(object)) {
> 		obname <- (names(as.list(call))[[2]])
> 		object <- get(obname, parentenv)
> 	}
> 	obclass <- class(object)
> 	if (is.null(obclass)) 
> 		stop("NextMethod applied to non-object")
> 	sname <- strsplit(cname, ".")[[1]]
> 	nmeth.name <- NULL
> 	if (sname[1] == name) {
> 		lens <- length(sname)
> 		if (lens < 2 || sname[2] == "default") 
> 			stop("NextMethod used in an improper context")
> 		ind <- which(obclass == sname[[lens]])
> 	}
> 	else ind <- 1
> 	while (ind < length(obclass)) {
> 		ind <- ind + 1
> 		nmeth.name <- paste(name, obclass[ind], sep = ".")
> 		if (flag _ exists(nmeth.name, parentenv, 
> 		           inherits = TRUE)) #GRW 9/18/96
> 			break
> 	}
> 	if (is.null(nmeth.name) || !flag ) #GRW 9/18/96
> 		nmeth.name <- paste(name, "default", sep = ".")
> 	nmeth.name <- as.name(nmeth.name)
> 	call[[1]] <- nmeth.name
> 	#	return(eval(call,parentenv))
> 	ncall <- as.call(c(as.list(call), list(...)))
> 	return(eval(ncall, parentenv))
> }
> 
> 
> 
> -------------------------------------------------------------------------------
>     Gregory R. Warnes          | It is high time that the ideal of success
> warnes@biostat.washington.edu  |  be replaced by the ideal of service.
>                                |                       Albert Einstein
> -------------------------------------------------------------------------------
> 
> =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
> r-testers mailing list -- To (un)subscribe, send
> subscribe	or	unsubscribe
> (in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
> =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
> 


-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-