From Iago.Mosqueira at cefas.co.uk  Thu Apr 19 19:55:35 2007
From: Iago.Mosqueira at cefas.co.uk (Iago Mosqueira (Cefas))
Date: Thu, 19 Apr 2007 18:55:35 +0100
Subject: [Rd] setClass inside a function
In-Reply-To: <mailman.9.1176976803.13947.r-devel@r-project.org>
Message-ID: <40A15E1D8A76A949AF0271EF3133E1A9CF7E60@LOWEXPRESS.corp.cefas.co.uk>

Hello,

I would like to create a function that gets passed a class name and then calls setClass, and a few other functions, inside. I have done this in the past with setmethod, creating accessors for all slots in a set of S4 classes. But setClass is choking when my function is called isnide a package, telling about an error in exists(cname, where). I assume this to be a problem with the environment where the class is created. If I define my creator function in a package and load it, when I call it I get

Error in assign(mname, def, where): cannot add bindings to a locked environment

This does not happen if I redefine the creator function in my working environment.

I have attached an example of the kind of function below, and I am using R 2.5.0.

Where should I look for information on undertanding what might be going on here? Why does this way of working succeeds with setMethod but not setClass?

The intention here is to provide an easy way for creating extended classes that will inherit from a class already defined, instead of array as in the example.

Many thanks,


Iago


defineClass <- function(name, dimnames) {
	#  dim, names[2], dimnames[2]
	if(names(dimnames)[1] != 'iter')
		dimnames <- c(list(iter=1), dimnames)
	dim <- unlist(lapply(dimnames, length))

	#  validity
	foo <- "validity <- function(object) {"
	# foo <- c(foo, "browser()")
	foo <- c(foo, paste("if(all(names(dimnames(object)) != c('",
		paste(names(dimnames), collapse="','", sep=""), "')))", sep=""))
	foo <- c(foo, "stop(paste('dimnames are not correct for class', name))")
	foo <- c(foo, "return(TRUE)}")
	eval(parse(text=foo))

	#  setClass
	setClass(name, representation('array'),
    	prototype=prototype(array(as.numeric(NA), dim=dim, dimnames=dimnames), units='NA'),
		validity=validity, where=sys.parent(n=-2))

	# setValidity
	setValidity(name, validity)

	#  constructors
	eval(parse(text=paste("setGeneric('", name,
		"', function(object, ...) standardGeneric('", name, "'))", sep="")))

	setMethod(name, signature(object='ANY'),
		function(object, ...)
			return(FLPar(object, ..., class=name))
	)
	setMethod(name, signature(object='missing'),
		function(...) {
			return(FLPar(..., class=name))
		}
	)

}

---
Iago Mosqueira
Systems Modelling
Cefas
Pakefield Rd.
Lowestoft NR33 0HT
U.K.
Tel +44 (0) 1502 558003


***********************************************************************************
This email and any attachments are intended for the named re...{{dropped}}



[Rd] setClass inside a function
Iago Mosqueira (Cefas