I extend the basic R-type array with the following S4 class:
setClass("marray",
representation(
shape = "integer",
ndim = "integer",
size = "integer",
order = "character"
),
prototype(
... # some default values
),
contains = "array"
)
Within a class method I will set the dimension of the array:
setMethod("reshape",
signature = "marray",
definition = function(object, dim = NULL, order = c("C", "F") {
order <- match.arg(order)
if (identical(object#shape, dim) && identical(object#order, order))
return(object)
if ((identical(object#shape, dim)) && (!identical(object#order, order)))
object <- flatten(object, axis = NULL, order = object#order)
if (identical(order, "C"))
dimC(object#.Data) <- dim
else
dim(object#.Data) <- dim
if (is.null(dim)) object#.Data <- as.array(object#.Data)
object#shape <- as.integer(DIM(object#.Data))
object#ndim <- as.integer(length(object#shape))
object#size <- as.integer(prod(object#shape))
object#order <- order
object
}
)
If dim is NULL, the following error occurred: "Error in (function (cl, name, valueClass) : Assignment of an object of class integer in an object of class marray is not allowed for #.Data"
I can understand the error, but what is a proper way to get rid of it?
With this workaround within the method everything works pretty fine:
data <- object#.Data
dim(data) <- dim
object#.Data <- as.array(data)
My feeling tells me that this workaround is not necessarily the best way to get around this problem. Saving the array (.Data) in a variable (data) and afterwards restoring it back seems to me a huge memory issue.
Many thanks in advance
Related
I am trying to create a new class that will automatically generate the values of its slots if those values are not given explicitly.
Here is my setClass code:
TestClass <- setClass(
"TestClass",
slots = c( names = "character",
values = "numeric"
),
validity = function(object) {
if (length(object#values) != length(object#names) ) {
warning("The amount of parameter values is not equal to the amount of parameter names. All parameter values have been set to 1.")
object#values <- rep(1, length(object#names))
} else {
object#values <- as.numeric(object#values)
}
}
)
The goal is to have the TestClass class always generate a vector of 1s for the "values" slot, if the values are not provided.
When I run the code:
test <- TestClass(names = c("a", "b"))
I get the following error:
Error in validObject(.Object) : invalid class “TestClass” object: 1: 1
invalid class “TestClass” object: 2: 1
In addition: Warning message:
In validityMethod(object) :
The amount of parameter values is not equal to the amount of parameter names. All parameter values have been set to 1.
EDIT: I know I can use "prototype" in setClass to create my defaults. But as you can see I am trying to be self referential and check if the values provided for the class arguments meet certain conditions, and if they don't, override the input by assigning values to them.
I think I stumbled upon an answer from Hadley Wickham, but I'm not sure if it's less of a solution and more of a clever workaround.
I can apparently create a new class using the new() function. And then, using if statements within new(), I have more control over the values of the slots.
TestClass <- function(names, values = NA) {
if (length(values) != length(names) ) {
warning("The amount of parameter values is not equal to the amount of parameter names. All parameter values have been set to 1.")
values <- rep(1, length(names))
} else {
values <- as.numeric(values)
}
new("TestClass", names = names, values = values)
}
TestClass_1 <- TestClass(names = c("a", "b") )
I'm creating a S4 object of the money class in the following manner:
# Create class ------------------------------------------------------------
# Create S4 class object holding money and export to generator function
setClass(Class = "money",
slots = list(currency = "character",
value = "numeric")) -> money
For which I'm later defining the show method:
# Methods -----------------------------------------------------------------
# Create show method
setMethod("show",
"money",
function(object) {
cat(switch(object#currency,
GBP = intToUtf8(163)),
format(
x = round(object#value, 2),
trim = TRUE,
big.mark = ",",
big.interval = 3
),
sep = "")
})
Preview
So far it works as promised:
# Create test object
tst_fig <- new(Class = "money",
value = 1e6,
currency = "GBP")
# Show the object
tst_fig
# £1,000,000
Problem
I would like to enable basic arithmetic on that object:
>> tst_fig + 1e6
Error in tst_fig + 1000000 : non-numeric argument to binary operator
Desired results
> tst_fig + 1e6
# £2,000,000
Attempts
Naturally this is won't work:
>> setMethod("+",
... "money",
... function(object, x) {
... object#value + x
... })
Error in conformMethod(signature, mnames, fnames, f, fdef, definition) :
in method for ‘+’ with signature ‘e1="money"’: formal arguments (e1 = "money", e2 = "money") omitted in the method definition cannot be in the signature
Side notes
There is a similar excellent answer provided by #Roland on implementing money class in S3; in the context of this question I'm interested in creating S4 class that would behave in a similar manner without any specific reason other than curiosity. The key requirements is that isS4() on that object returns TRUE.
What I mean by similar manner:
It prints like nicely formatted money but permits all operations the one could do on a common numeric.
I came across how to do this in my own question here. I have generally used the setMethod('Arith') approach as it is more concise when you intend to implement several operations. If you search the documentation ?Arith you will see that it list the different operations as well as other S4 group generics.
As the error suggests you need to have e1 and e2 defined for Arith methods. In your specific case the following works.
Note - to get your desired output (i.e. a money class object) you will need to create a new money object.
setMethod("+",
c(e1="money", e2="numeric"),
function(e1, e2){
new(Class = "money", value = e1#value + e2, currency = e1#currency)
}
)
tst_fig + 1e6
[1] £2e+06
However, as I said, you probably want the more general, concise version which uses .Generic to interpret the Arith method you are using.
setMethod("Arith",
c(e1="money", e2="numeric"),
function(e1, e2)
{
op = .Generic[[1]]
switch(op,
`+` = return(new(Class = "money", value = e1#value + e2, currency = e1#currency))
)
}
)
Normally you would set the attribute of an object as
attributes(x) <- list(dummy = 123)
But I have the variable names stored in a character vector. The following code throws an error:
var <- "x"
attributes(eval(as.name(var))) <- list(dummy = 123)
Error in attributes(eval(as.name(var))) <- list(dummy = 123) :
could not find function "eval<-"
If eval(as.name()) is not the right way could someone suggest a way to solve this problem?
You can use a function to apply the attributes and the assign function to apply them:
add_dummy <- function(obj, name, attribute){
attr(obj, name) <- attribute
return(obj)
}
assign(var, add_dummy(get(var), "attr_name", list(dummy = 123)))
I am attempting to write some classes in R. Here is the start of a neural network layer class. It is generating warnings and errors that I don't know how to correct.
# Slot definitions
setClass(
Class="neuralNetworkLayer",
representation=representation(
input = "vector",
linearOutput = "vector",
squashedOutput = "vector",
hasBias = "logical",
bias = "vector",
weights = "vector",
gains = "matrix",
squashFcn = "closure",
squashFcnDerivative = "closure"
)
)
# Constructors
NeuralNetworkLayer <- function(nInput,nOutput,hasBias=TRUE,squashFcn,squashFcnDerivative) {
nc = list(
input = c(rep(NA,nInput)),
linearOutput = c(rep(NA,nOutput)),
squashedOutput = c(rep(NA,nOutput)),
hasBias = hasBias,
bias = c(rep(NA,nOutput)),
weights = c(rep(NA,nOutput)),
gain = matrix(data=weights, nrow = nInput, ncol = nOutput),
squashFcn = squashFcn, # source of warning / error
squashFcnDerivative = squashFcnDerivative,
get = function(x) nc[[x]],
set = function(x, value) nc[[x]] <<- value,
props = list()
)
#Add a few more functions
nc$addProp = function(name, value) {
p <- nc$props
p[[name]] <- value
assign('props', p, envir=nc)
}
nc <- list2env(nc)
class(nc) <- "NeuralNetwork"
return(nc)
}
tanhDerivative <- function(x) {
d = 1 - tan(x)^2
return(d)
}
test <- NeuralNetworkLayer(nInput=4,nOutput=5,hasBias=TRUE,
squashFcn=tanh,squashFcnDerivative=tanhDerivative)
The messages generated are
Warning message:
undefined slot classes in definition of "neuralNetworkLayer": squashFcn(class "closure"),
squashFcnDerivative(class "closure")
Error in as.vector(x, mode) :
cannot coerce type 'closure' to vector of type 'any'
Both messages indicate that the base class closure can not be used for a slot. How to pass a function?
Taking the advice from the two answers, the following code can be generated. This addresses the original question of passing a function to a slot, and then using that function. For completeness, the revised neural network layer class is present.
setClass(
Class="neuralNetworkLayer",
representation=representation(
nInput = "numeric",
nOutput = "numeric",
squashFcn = "function",
derivSquashFcn = "function",
gains = "matrix",
hasBias = "logical",
bias = "matrix",
linOutput = "matrix",
squashOutput = "matrix"
)
)
getClass("neuralNetworkLayer")
getSlots("neuralNetworkLayer")
sf <- function(x){
f = tanh(x)
return(f)
}
dsf <- function(x) {
d = 1 - tan(x)^2
return(d)
}
# Create an object of class
hh = new("neuralNetworkLayer",squashFcn=sf,nInput=5,nOutput=5,hasBias=TRUE,
derivSquashFcn = dsf)
hh#squashFcn(3)
hh#derivSquashFcn(3)
The error/warning :
undefined slot classes in definition of "neuralNetworkLayer": squashFcn(class "closure")
means that slot is not defined beacuse the type "closure" is not defined.
You try To define a slot(attribute) as a generic function one idea is to use ANY ( the default for slot I think) type:
neuralNetworkLayer <-
setClass(
Class="neuralNetworkLayer",
representation=representation(
squashFcn = "ANY"
)
)
Then ,for example you instantiate your class like this :
# Constructors
hh = neuralNetworkLayer(squashFcn=function(x)print(x)) ## dummy function here
hh#squashFcn(10)
[1] 10
That's said , I think you should consider to define your functions slots as a real method(see setMethod) . Methods are to have typed (safer) objects Otheriwse there is no good reason the reason to use S4 system and easier to use S3 method.
I don't get why you are defining a neuralNetworkLayer S4 class while your constructor doesn't make any use of it. You just are creating a normal R list (no slots in the returning object of NeuralNetworkLayer). In your constructor you should call new somewhere.
Anyhow, your error doesn't have nothing to do with closure as you might think. You just didn't define the weights object that it happens to be also an R function. When you say:
weights = c(rep(NA,nOutput)),
gains = matrix(data=weights, nrow = nInput, ncol = nOutput),
you are creating an element of a list named weights, but you are not creating an object named weights. When you define the gains element, R just finds for weights its R function and tries to coerce it to put it into a matrix, giving the error. You can just define weights in your first line of NeuralNetworkLayer:
weights = c(rep(NA,nOutput))
and then, when you define nc, replace the first line I wrote above with:
weights = weights,
and your function won't give any error.
For the warning part of the definition of the S4 class, just use function instead of closure. However, as you have defined your constructor, you may well not define it at all.
I would like to use a custom reference class inside another reference class, but this code fails:
nameClass <- setRefClass("nameClass", fields = list(first = "character",
last = "character"),
methods = list(
initialize = function(char){
chunks <- strsplit(char,"\\.")
first <<- chunks[[1]][1]
last <<- chunks[[1]][2]
},
show = function(){
cat("Special Name Class \n:")
cat("First Name:")
methods::show(first)
cat("Last Name:")
methods::show(last)
}
))
# this works fine
nameClass$new("tyler.durden")
When I try to add a second class that has a field of class nameClass this class cannot be initiated.
personClass <- setRefClass("personClass", fields = list(fullname = "nameClass",
occupation = "character"),
methods = list(
initialize = function(Obj){
nm <- deparse(substitute(Obj))
fullname <<- nameClass$new(nm)
occupation <<- Obj
}))
this just returns:
Error in strsplit(char, "\\.") :
argument "char" is missing, with no default
I could imagine a solution where nameClass is an S4 class but I reading a little made me kind of afraid to mix S4 and reference classes. Am I missing somthing or should I simply use an S4 classes when I want to define this particular name field more exactly than just 'character'?
I also found this thread with a promising title but could not figure out how this could solve my problem.
This is a variation of a common issue in the S4 system, where for inheritance to work a call to new with zero arguments has to work. This is because of the way inheritance is implemented, where the base class is instantiated and then populated with values from the derived class. To instantiate the base class requires creating it without any arguments. That you have a problem is illustrated with
> nameClass()
Error in .Internal(strsplit(x, as.character(split), fixed, perl, useBytes)) :
'x' is missing
and the solution is to provide a default argument in your initialize method
initialize=function(char=charcter()) { <...> }
or to otherwise arranging (e.g., by testing missing(char) in the body of initialize) for a no-argument call to the constructor to work.
Probably programming best practice would dictate that the initialize method takes a ... argument and has callSuper() in its body, so that derived classes can take advantage of base class (e.g., field assignment) functionality. To avoid problems with inadvertent matching of unnamed arguments, I think the signature should probably end up built around a template that looks like
initialize(..., char=character()) { callSuper(...) }
This scheme relies on a suitable definition of an 'empty' nameClass. The following probably has too much opinion and change of perspective to be immediately useful, but... It's tempting to think of nameClass as a 'row' in a data frame, but it's better (because R works best on vectors) to think of it as describing columns. With this in mind a reasonable representation of an 'empty' nameClass is where the first and last fields are each of length 0. Then
nameClass <- setRefClass("nameClass",
fields = list(first = "character", last = "character"),
methods = list(
initialize = function(..., char=character()){
if (length(char)) {
names <- strsplit(char, ".", fixed=TRUE)
.first <- vapply(names, "[[", character(1), 1)
.last <- vapply(names, "[[", character(1), 2)
} else {
.first <- character()
.last <- character()
}
callSuper(..., first=.first, last=.last)
}, show = function(){
.helper <- function(x)
sprintf("%s%s", paste(sQuote(head(x)), collapse=", "),
if (length(x) > 6) ", ..." else "")
cat("Special Name Class (n = ", length(first), ")\n", sep="")
cat("First names:", .helper(first), "\n")
cat("Last names:", .helper(last), "\n")
}))
with test cases like
> nameClass()
Special Name Class (n = 0)
First names:
Last names:
> nameClass(char="Paul.Simon")
Special Name Class (n = 1)
First names: 'Paul'
Last names: 'Simon'
> nameClass(char=c("Paul.Simon", "Frank.Sinatra"))
Special Name Class (n = 2)
First names: 'Paul', 'Frank'
Last names: 'Simon', 'Sinatra'
> nameClass(char=paste(LETTERS, letters, sep="."))
Special Name Class (n = 26)
First names: 'A', 'B', 'C', 'D', 'E', 'F', ...
Last names: 'a', 'b', 'c', 'd', 'e', 'f', ...
The derived class might be defined as
personClass <- setRefClass("personClass",
fields = list(fullname = "nameClass", occupation = "character"),
methods = list(
initialize = function(..., fullname=nameClass(),
occupation=character()) {
callSuper(..., fullname=fullname, occupation=occupation)
}))
with test cases like
personClass()
personClass(fullname=nameClass())
personClass(fullname=nameClass(), occupation=character())
personClass(fullname=nameClass(char="some.one"), occupation="job")
It seems that this is because you do not have a default constructor for your "nameClass":
nameClass$new()
Error in strsplit(char, "\\.") :
argument "char" is missing, with no default
If you modify your nameClass like this:
nameClass <- setRefClass("nameClass", fields = list(first = "character",
last = "character"),
methods = list(
initialize = function(s = NULL) {
if (!is.null(s) && nzchar(s)) {
chunks <- strsplit(s,"\\.")
first <<- chunks[[1]][1]
last <<- chunks[[1]][2]
}
},
show = function(){
cat("Special Name Class \n:")
cat("First Name:")
methods::show(first)
cat("Last Name:")
methods::show(last)
}
))
Then:
nameClass$new()
Special Name Class
:First Name:character(0)
Last Name:character(0)
and your personClass is now functional (yet the initialize method is quite odd):
personClass$new("tyler.durden")
Reference class object of class "personClass"
Field "fullname":
Special Name Class
:First Name:[1] "\"tyler"
Last Name:[1] "durden\""
Field "occupation":
[1] "tyler.durden"