R-alpha: patch for NextMethod

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


Date: Wed, 18 Sep 1996 13:17:27 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>
Subject: R-alpha: patch for NextMethod


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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-