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") )
Related
Using below code I'm attempting to re-write the summary function so that just the coefficient is returned :
summary <- function(x)
{
UseMethod("GetFirst",x)
}
summary <- function(x)
{
return(x$Coefficient)
}
class(summary) <- "mysum"
tosum = as_tibble(c(1,2,3))
tosum
summary(tosum)
This returns an error :
> summary(tosum)
NULL
Warning message:
Unknown or uninitialised column: 'Coefficient'.
How to read the available properties on the summary function and invoke using s3 ?
summary is already a Generic function so you don't need UseMethod. In order to extend its functionality you need to add another method which will work with the class you want.
See an example:
summary.myclass <- function(x)
{
return(x$Coefficient)
}
tosum = data.frame(Coefficient = c(1,2,3))
class(tosum) <- c('myclass', 'data.frame')
summary(tosum)
#[1] 1 2 3
Here I am defining an extension of summary (called method) for the myclass class. When I use summary on tosum which is of that class then summary.myclass is dispatched and the column Coefficiet is returned.
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'm trying to write a function with dynamic arguments (i.e. the function argument names are not determined beforehand). Inside the function, I can generate a list of possible argument names as strings and try to extract the function argument with the corresponding name (if given). I tried using match.arg, but that does not work.
As a (massively stripped-down) example, consider the following attempt:
# Override column in the dataframe. Dots arguments can be any
# of the column names of the data.frame.
dataframe.override = function(frame, ...) {
for (n in names(frame)) {
# Check whether this col name was given as an argument to the function
if (!missing(n)) {
vl = match.arg(n);
# DO something with that value and assign it as a column:
newval = vl
frame[,n] = newval
}
}
frame
}
AA = data.frame(a = 1:5, b = 6:10, c = 11:15)
dataframe.override(AA, b = c(5,6,6,6,6)) # Should override column b
Unfortunately, the match.arg apparently does not work:
Error in match.arg(n) : 'arg' should be one of
So, my question is: Inside a function, how can I check whether the function was called with a given argument and extract its value, given the argument name as a string?
Thanks,
Reinhold
PS: In reality, the "Do something..." part is quite complicated, so simply assigning the vector to the dataframe column directly without such a function is not an option.
You probably want to review the chapter on Non Standard Evaluation in Advanced-R. I also think Hadley's answer to a related question might be useful.
So: let's start from that other answer. The most idiomatic way to get the arguments to a function is like this:
get_arguments <- function(...){
match.call(expand.dots = FALSE)$`...`
}
That provides a list of the arguments with names:
> get_arguments(one, test=2, three=3)
[[1]]
one
$test
[1] 2
$three
[1] 3
You could simply call names() on the result to get the names.
Note that if you want the values as strings you'll need to use deparse, e.g.
deparse(get_arguments(one, test=2, three=3)[[2]])
[1] "2"
P.S. Instead of looping through all columns, you might want to use intersect or setdiff, e.g.
dataframe.override = function(frame, ...) {
columns = names(match.call(expand.dots = FALSE)$`...`)[-1]
matching.cols <- intersect(names(frame), names(columns))
for (i in seq_along(matching.cols) {
n = matching.cols[[i]]
# Check whether this col name was given as an argument to the function
if (!missing(n)) {
vl = match.arg(n);
# DO something with that value and assign it as a column:
newval = vl
frame[,n] = newval
}
}
frame
}
P.P.S: I'm assuming there's a reason you're not using dplyr::mutate for this.
I'm new to R and I'm currently trying to supply the enumeration-like argument to the R function (or the RC/R6 class method), I currently use character vector plus match.arg similar to the following:
EnumTest = function(enum = c("BLUE", "RED", "BLACK")) {
enumArg <-
switch(
match.arg(enum), "BLUE" = 0L, "RED" = 1L, "BLACK" = 2L
)
switch(enumArg,
# do something
)
}
Is there are better/more concise way to imitate enum-like behavior in R? E.g. one big problem that user has to know the set of possible values for the argument and manually type it as a string - without any suggestion or auto-completion...
If there is no other better way, one thing that could improve above approach - it'd be nice to make it more concise by say predefining enums globally or say as private members of R6 class:
Color <- c("BLUE", "RED", "BLACK")
Then one could (re)use it in one or more function definitions, e.g.:
EnumTest = function(enum = Color) {
...
However, I'm not sure how to use this Color vector in match.arg function. It'd be nice if I could define Color as a map with keys being actual color values and values being integer representation - but I'm not sure how sensible that is.. Anyways, maybe there are more common neat approaches exist.
The main goal would be to provide an easy-to-use intuitive interface to the user of my package and functions (e.g. easy way to find the set of possible values, tab-completion, auto-suggestion, etc..), followed by standardized development of such functions using enum-like arguments
How about using a function that defines the enum by returning list(a= "a", ...)? You can then either assign the returned vector to a variable and use it in context, or use the function directly. Either a name or an integer reference will work as an index, although you have to use the unlist version of the index lookup, [[, otherwise you get a list with one element.
colorEnum <- function() {
list(BLUE = "BLUE", RED = "RED", BLACK = "BLACK")
}
colorEnum()$BLUE
#> [1] "BLUE"
colorEnum()[[1]]
#> [1] "BLUE"
colorEnum()[1]
#> $BLUE
#> [1] "BLUE"
col <- colorEnum()
col$BLUE
#> [1] "BLUE"
col[[1]]
#> [1] "BLUE"
col$BAD_COLOR
#> NULL
col[[5]]
#> Error in col[[5]] : subscript out of bounds
You can get the list of names for use in a match, i.e. your function parameter could be
EnumTest = function( enum = names(colorEnum()) { ...
You can actually abbreviate too, but it must be unique. (If you use RStudio, since col is a list, it will suggest completions!)
col$BLA
#> [1] "BLACK"
col$BL
#> NULL
If you want more sophisticated enum handling, you could assign S3 classes to the thing returned by your enum constructor function and write a small collection of functions to dispatch on class "enum" and allow case-insensitive indexing. You could also add special functions to work with a specific class, e.g. "colorEnum"; I have not done that here. Inheritance means the list access methods all still work.
colorEnum2 <- function() {
structure(
list(BLUE = "BLUE", RED = "RED", BLACK = "BLACK"),
class= c("colorEnum2", "enum", "list")
)
}
# Note, changed example to allow multiple returned values.
`[.enum` <- function(x, i) {
if ( is.character( i ))
i <- toupper(i)
class(x) <- "list"
names(as.list(x)[i])
}
`[[.enum` <- function(x, i, exact= FALSE) {
if ( is.character( i ))
i <- toupper(i)
class(x) <- "list"
as.list(x)[[i, exact=exact]]
}
`$.enum` <- function(x, name) {
x[[name]]
}
col <- colorEnum2()
# All these return [1] "RED"
col$red
col$r
col[["red"]]
col[["r"]]
col["red"]
col[c("red", "BLUE")]
#> [1] "RED" "BLUE"
col["r"]
[1] NA # R does not matches partial strings with "["
These override the built in [, [[ and $ functions when the thing being indexed is of class "enum", for any "enum" classed objects. If you need another one, you just need to define it.
directionEnum <- function() {
structure(
list(LEFT = "LEFT", RIGHT = "RIGHT"),
class= c("directionEnum", "enum", "list")
)
}
directionEnum()$l
#> [1] "LEFT"
If you need several enum objects, you could add a factory function enum that takes a vector of strings and a name and returns an enum object. Most of this is just validation.
enum <- function(enums, name= NULL) {
if (length(enums) < 1)
stop ("Enums may not be empty." )
enums <- toupper(as.character(enums))
uniqueEnums <- unique(enums)
if ( ! identical( enums, uniqueEnums ))
stop ("Enums must be unique (ignoring case)." )
validNames <- make.names(enums)
if ( ! identical( enums, validNames ))
stop( "Enums must be valid R identifiers." )
enumClass <- c(name, "enum", "list")
obj <- as.list(enums)
names(obj) <- enums
structure( obj, class= enumClass)
}
col <- enum(c("BLUE", "red", "Black"), name = "TheColors")
col$R
#> [1] "RED"
class(col)
#> [1] "TheColors" "enum" "list"
side <- enum(c("left", "right"))
side$L
#> [1] "LEFT"
class(side)
#> [1] "enum" "list"
But now this is starting to look like a package...
I like to use environments as replacement for enums because you can lock them to prevent any changes after creation. I define my creation function like this:
Enum <- function(...) {
## EDIT: use solution provided in comments to capture the arguments
values <- sapply(match.call(expand.dots = TRUE)[-1L], deparse)
stopifnot(identical(unique(values), values))
res <- setNames(seq_along(values), values)
res <- as.environment(as.list(res))
lockEnvironment(res, bindings = TRUE)
res
}
Create a new enum like this:
FRUITS <- Enum(APPLE, BANANA, MELON)
We can the access the values:
FRUITS$APPLE
But we cannot modify them or create new ones:
FRUITS$APPLE <- 99 # gives error
FRUITS$NEW <- 88 # gives error
I just faced this exact problem and could only find this SO question. The objectProperties package mention by Paul seems abandoned (it produces several warnings) and has lots of overhead for such a simple (in principle) problem. I came up with the following lightweight solution (depends only on the stringi package), which reproduces the feel of Enums in C languages. Maybe this helps someone.
EnumTest <- function(colorEnum = ColorEnum$BLUE) {
enumArg <- as.character(match.call()[2])
match.arg(enumArg, stringi::stri_c("ColorEnum$", names(ColorEnum)))
sprintf("%s: %i",enumArg,colorEnum)
}
ColorEnum <- list(BLUE = 0L, RED = 1L, BLACK = 2L)
Here is a simple method which supports enums with assigned values or which use the name as the value by default:
makeEnum <- function(inputList) {
myEnum <- as.list(inputList)
enumNames <- names(myEnum)
if (is.null(enumNames)) {
names(myEnum) <- myEnum
} else if ("" %in% enumNames) {
stop("The inputList has some but not all names assigned. They must be all assigned or none assigned")
}
return(myEnum)
}
If you are simply trying to make a defined list of names and don't care about the values you can use like this:
colors <- makeEnum(c("red", "green", "blue"))
If you wish, you can specify the values:
hexColors <- makeEnum(c(red="#FF0000", green="#00FF00", blue="#0000FF"))
In either case it is easy to access the enum names because of code completion:
> hexColors$green
[1] "#00FF00"
To check if a variable is a value in your enum you can check like this:
> param <- hexColors$green
> param %in% hexColors
Update 07/21/2017: I have created a package for enumerations in R:
https://github.com/aryoda/R_enumerations
If you want to use self-defined enum-alike data types as arguments of R functions that support
automatic translation of enum item names to the corresponding integer values
code auto completion (e. g. in RStudio)
clear documentation in the function signature which values are allowed as actual function parameters
easy validation of the actual function parameter against the allowed (integer) enum item values
you can define your own match.enum.arg function, e. g.:
match.enum.arg <- function(arg, choices) {
if (missing(choices)) {
formal.args <- formals(sys.function(sys.parent()))
choices <- eval(formal.args[[as.character(substitute(arg))]])
}
if(identical(arg, choices))
arg <- choices[[1]][1] # choose the first value of the first list item
allowed.values <- sapply(choices,function(item) {item[1]}) # extract the integer values of the enum items
if(!is.element(arg, allowed.values))
stop(paste("'arg' must be one of the values in the 'choices' list:", paste(allowed.values, collapse = ", ")))
return(arg)
}
Usage:
You can then define and use your own enums like this:
ColorEnum <- list(BLUE = 1L, RED = 2L, BLACK = 3L)
color2code = function(enum = ColorEnum) {
i <- match.enum.arg(enum)
return(i)
}
Example calls:
> color2code(ColorEnum$RED) # use a value from the enum (with auto completion support)
[1] 2
> color2code() # takes the first color of the ColorEnum
[1] 1
> color2code(3) # an integer enum value (dirty, just for demonstration)
[1] 3
> color2code(4) # an invalid number
Error in match.enum.arg(enum) :
'arg' must be one of the values in the 'choices' list: 1, 2, 3
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.