Suppress output from attr() in function result - r

In the source code for data.frame, the last three lines of code set the attributes and return the result.
...
attr(value, "row.names") <- row.names
attr(value, "class") <- "data.frame"
value
}
In a function I wrote, the result is a named list created by lapply. Before I set any attributes in the function body, result is as follows.
> x <- data.frame(a = 1:5, b = letters[1:5])
> (g <- grep.dataframe("a|c", x))
# ...
# $b
# value row
# 1 a 1
# 2 c 3
> attributes(g) # I want "list" in here...
# $names
# [1] "a" "b"
I'd like "class" to be included in the attributes list, so I add attr(res, "class") <- "list" (res is the final result) just before res. "class" now shows up in the attributes list. However,it also prints out with the result of the function, which I don't want. I tried wrapping it with invisible, but that didn't work.
Why do the manually assigned attributes print with the function result, but are suppressed in a new data frame I create?
> (h <- grep.dataframe("a|c", x))
# ...
# $b
# value row
# 1 a 1
# 2 c 3
# attr(,"class") # ...This prints with the result. I don't want that.
# [1] "list"
> attributes(h) # ...But I want these attributes
# $names
# [1] "a" "b"
# $class
# [1] "list"

The ?class documentation offers some pointers:
Many R objects have a class attribute, a character vector giving the names of the classes from which the object inherits. If the object does not have a class attribute, it has an implicit class, "matrix", "array" or the result of mode(x) (except that integer vectors have implicit class "integer"). (Functions oldClass and oldClass<- get and set the attribute, which can also be done directly.)
When a generic function fun is applied to an object with class attribute c("first", "second"), the system searches for a function called fun.first and, if it finds it, applies it to the object. If no such function is found, a function called fun.second is tried. If no class name produces a suitable function, the function fun.default is used (if it exists). If there is no class attribute, the implicit class is tried, then the default method.
From that and running a few simple tests, I gather that:
a list is one of these implicit classes: see attributes(list(1)), typeof(list(1))
when print is called on a list, it is using print.default
print.default prints the attributes of an object
So you could define a print.list that will handle your special case:
print.list <- function(x, ...) {
if (is.list(x)) attr(x, "class") <- NULL
print.default(x, ...)
}
res <- list(1)
attr(res, "class") <- "list"
res
# [[1]]
# [1] 1
attributes(res)
# $class
# [1] "list"

Related

Why won't my custom S3 class object append to a list in R?

I am learning how to make custom S3 classes in R and have run into a head scratcher.
After creating an instance of my custom S3 class, it will not append to a list with c(). No warning or error is shown, it simply does not append and I do not know why.
IN:
# initialize a list and observe expected results
my_list <- list()
my_list
OUT:
list()
IN:
# Append to the list with c() as per usual and observe expected results
my_list <- c(my_list, 1)
my_list
OUT:
[[1]]
[1] 1
IN:
my_list <- c(my_list, 2)
my_list
OUT:
[[1]]
[1] 1
[[2]]
[1] 2
IN:
# Define my custom S3 class
my_custom_s3_class <- function(attribute1, attribute2) {
my_custom_s3_class <- structure(list(), class = "my_custom_s3_class")
attributes(my_custom_s3_class)$attribute1 <- attribute1
attributes(my_custom_s3_class)$attribute2 <- attribute2
my_custom_s3_class
}
# Define print method for my S3 class
print.my_custom_s3_class <- function(x, ...) {
cat(attributes(x)$attribute1, attributes(x)$attribute2)
}
# Create an instance of my custom S3 class and observe expected results when calling it
my_custom_object <- my_custom_s3_class("hello", "world")
my_custom_object
OUT:
hello world
IN:
# Attempt to append my custom S3 class to my list from before and observe no warnings or error messages
my_list <- c(my_list, my_custom_object)
# Observe that it was not appended
my_list
OUT:
[[1]]
[1] 1
[[2]]
[1] 2
The object is of length 0
length(my_custom_object)
[1] 0
so we need to wrap it in a list
c(my_list, list(my_custom_object))
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
hello world

Can a method be added to the combine function to handle arguments of different classes?

I've made a new class, cvb:
setClass("cvb", slots = c(name = "character", dargs = "list"))
cvb <- function(name, ...) {
out <- list(name = name, dargs = list(...))
class(out) <- "cvb"
out
}
And I'd like to be able to call a method to the "combine" function, c(...), with arguments that are of class cvb, numeric, and character. I can make a method like so (not even needing to bother with S4 actually) if the first argument to c(...) is of class cvb:
c.cvb <- function(...) "In cbv c method"
which will return whatever "combination" of arguments my method defines. But I want to be able to deploy this method if any of the arguments are of class cvb, and use the default method otherwise. If the first argument to c(...) is not of class cvb I get the following:
> v <- cvb("i", 1:3)
> c(1, 2, v)
[[1]]
[1] 1
[[2]]
[1] 2
$name
[1] "i"
$dargs
$dargs[[1]]
[1] 1 2 3
Which combines two numeric types and a list type into a list, even though the first argument isn't a list. This suggests to me that there is some kind of dispatch logic that determines that if any argument is a list argument, combine all arguments into a list. I'd like it to use my c.cvb method instead of whatever is being dispatched here. Any thoughts?
I am not that familiar with S4 dispatch but am somewhat familiar with S3 dispatch. So there is likely a better way, but one option would be to supply your own dispatch logic by overriding c():
# cvb generator
cvb <- function(name, ...) {
out <- list(name = name, dargs = list(...))
class(out) <- "cvb"
out
}
# instance of cvb
v <- cvb("i", 1:3)
# new S3 c method for cvb object
c.cvb <- function(...) "In cbv c method"
# dispatch to new S3 method gives desired output
c(v, 1, 2)
#> [1] "In cbv c method"
# but will only work if the first object is of class cvb
c(1, 2, v)
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
#>
#> $name
#> [1] "i"
#>
#> $dargs
#> $dargs[[1]]
#> [1] 1 2 3
# S3 dispatch pre-hook
c <- function(...) {
if("cvb" %in% unlist(lapply(list(...), class)))
c.cvb(...)
else
base::c(...)
}
# now we get c.cvb if any argument has class cvb
c(1, 2, v)
#> [1] "In cbv c method"
Created on 2021-02-22 by the reprex package (v1.0.0)

Dynamically naming objects to be updated

I have defined an S4 Class with a slot that is a list. I have written a method (based on Genolini's introduction to S4 - section 10.2) to append a new entry to that list:
setClass("MyClass",
slots = c(entries = "list")
)
a1 <- new("MyClass", entries = list(1))
setGeneric(name="MyAppend",
def=function(.Object, newEntry)
{
standardGeneric("MyAppend")
}
)
setMethod(f = "MyAppend",
signature = "MyClass",
definition = function(.Object, newEntry){
nameObject <- deparse(substitute(.Object))
newlist <- .Object#entries
n <- newlist %>% length
newlist[[n + 1]] <- newEntry
.Object#entries <- newlist
assign(nameObject, .Object, envir = parent.frame())
return(invisible)
}
)
If I then run
MyAppend(a1, 2)
a1
I get
R>a1
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
which is just as it should be.
But in my application I will be generating the names of the objects to be updated dynamically:
ObjectName <- paste0("a", 1)
then I can turn that name into the object itself with
Object <- ObjectName %>% sym %>% eval
and then str(Object) returns
Formal class 'MyClass' [package ".GlobalEnv"] with 1 slot
..# entries:List of 3
.. ..$ : num 1
.. ..$ : num 2
which, again, is just as it should be.
But when I run
MyAppend(Object, 3)
Object
a1
I get the following that shows that while Object has been updated a1 has not been.
R>Object
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
R>
R>a1
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
What am I doing wrong, please?
The problem is that this line:
Object <- ObjectName %>% sym %>% eval
Doesn't do what you think it does. The right hand side evaluates to the object a1, so it is no different to doing
Object <- a1
But this creates a copy of a1, it does not create a reference or a pointer or a synonym for a1.
It is possible to create a reference (of sorts) by passing the unevaluated name of the object you wish to append to your generic method. If you leave out the eval part of ObjectName %>% sym %>% eval then Object gets assigned the name a1, which can be passed as a reference to the object a1.
However, this leaves you with a new problem: MyAppend doesn't know what to do with an object of class name. You therefore need to write a suitable method for dealing with names:
setMethod(f = "MyAppend",
signature = "name",
definition = function(.Object, newEntry){
stopifnot(class(eval(.Object)) == "MyClass")
objname <- as.character(.Object)
.Object <- eval(.Object)
.Object#entries <- append(.Object#entries, newEntry)
assign(as.character(objname), .Object, envir = parent.frame())
}
)
Now let's see how this would work:
a1 <- new("MyClass", entries = list(1))
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
MyAppend(a1, 2)
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
Object <- paste0("a", 1) %>% sym()
MyAppend(Object, 3)
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
#>
#> [[3]]
#> [1] 3
I think this was what you intended. You may wish to consider having a method that dispatches character strings to make this workflow easier (you would use get inside the method to retrieve the object from the name passed as a character string)
Note that I altered your own function as well; you shouldn't do return(invisible), since this returns the body of the built-in function invisible. Just leave the return statement out altogether. You can also make use of the built-in function append, to make your method for MyClass a bit simpler:
setMethod(f = "MyAppend",
signature = "MyClass",
definition = function(.Object, newEntry){
nameObject <- deparse(substitute(.Object))
.Object#entries <- append(.Object#entries, newEntry)
assign(nameObject, .Object, envir = parent.frame())
}
)
As the accepted answer has mentioned, the line
Object <- ObjectName %>% sym %>% eval
does not function as you intend.
If you want to work with dynamically generated names, the two functions you need to use are get (get an object associated with a name) and assign (assign into an object whose name you compute). Both have comprehensive help pages.
Pretty much nothing else will work (except for eval(parse(text=paste0(...))) but that is not recommended programming practice for a number of reasons.

Why, for an integer vector x, does as(x, "numeric") trigger loading of an additional S4 method for coerce?

While my question is related to this recent one, I suspect its answer(s) will have to do with the detailed workings of R's S4 object system.
What I would expect:
(TLDR; -- All indications are that as(4L, "numeric") should dispatch to a function whose body uses as.numeric(4L) to convert it to a "numeric" vector.)
Whenever one uses as(object, Class) to convert an object to the desired Class, one is really triggering a behind-the-scenes call to coerce(). coerce(), in turn, has a bunch of methods that are dispatched to based on the signature of the function call -- here the class of its first and second arguments. To see a list of all available S4 coerce() methods, one can run showMethods("coerce").
Doing so shows that there is only one method for converting to class "numeric". It's the one with signature from="ANY", to="numeric":
showMethods("coerce")
# Function: coerce (package methods)
# from="ANY", to="array"
# ... snip ...
# from="ANY", to="numeric"
# ... snip ...
That method uses as.numeric() to perform its conversion:
getMethod("coerce", c("ANY", "numeric"))
# Method Definition:
#
# function (from, to, strict = TRUE)
# {
# value <- as.numeric(from)
# if (strict)
# attributes(value) <- NULL
# value
# }
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "ANY" "numeric"
# defined "ANY" "numeric"
Given its signature, and the fact that it's the only coerce() method for conversion to class "numeric",
I would've expected that the function shown above is what would be dispatched to by a call to as(4L, "numeric").
That expectation is only reinforced by running the following two checks.
## (1) There isn't (apparently!) any specific method for "integer"-->"numeric"
## conversion
getMethod("coerce", c("integer", "numeric"))
# Error in getMethod("coerce", c("integer", "numeric")) :
# no method found for function 'coerce' and signature integer, numeric
## (2) This says that the "ANY"-->"numeric" method will be used for "integer"-->"numeric"
## conversion
selectMethod("coerce", signature=c("integer", "numeric"))
# Method Definition:
#
# function (from, to, strict = TRUE)
# {
# value <- as.numeric(from)
# if (strict)
# attributes(value) <- NULL
# value
# }
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "integer" "numeric"
# defined "ANY" "numeric"
What actually happens:
(TLDR; In fact, calling as(4L, "numeric") loads and dispatches to a method that does nothing at all.)
Despite what all indications mentioned above, as(4L, "numeric") does not dispatch to the coerce() method for calls with signature c("ANY", "numeric").
Here are a couple of ways to show that:
## (1) as.numeric() would do the job, but as(..., "numeric") does not
class(as(4L, "numeric"))
#[1] "integer"
class(as.numeric(4L))
# [1] "numeric"
## (2) Tracing shows that the "generic" method isn't called
trace("coerce", signature=c("ANY", "numeric"))
as(c(FALSE, TRUE), "numeric") ## <-- It's called for "logical" vectors
# Tracing asMethod(object) on entry
# [1] 0 1
as(c("1", "2"), "numeric") ## <-- and for "character" vectors
# Tracing asMethod(object) on entry
# [1] 1 2
as(c(1L, 2L), "numeric") ## <-- but not for "integer" vectors
# [1] 1 2
untrace("coerce")
What method, then, is used? Well, apparently the act of calling as(4L, "numeric")
adds a new S4 method to the list of methods for coerce(), and it's what is used.
(Compare the results of the following calls to what they produced before we had attempted our
first "integer" to "character" conversion.)
## At least one conversion needs to be attempted before the
## "integer"-->"numeric" method appears.
as(4L, "numeric")
## (1) Now the methods table shows a new "integer"-->"numeric" specific method
showMethods("coerce")
# Function: coerce (package methods)
# from="ANY", to="array"
# ... snip ...
# from="ANY", to="numeric"
# ... snip ...
# from="integer", to="numeric" ## <-- Here's the new method
# ... snip ...
## (2) selectMethod now tells a different story
selectMethod("coerce", signature=c("integer", "numeric"))
# Method Definition:
#
# function (from, to = "numeric", strict = TRUE)
# if (strict) {
# class(from) <- "numeric"
# from
# } else from
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "integer" "numeric"
# defined "integer" "numeric"
My questions:
Why does as(4L, "numeric") not dispatch to the available coerce() method for signature=c("ANY", "numeric")?
How/why does it instead add a new method to the S4 methods table?
From where (in R's source code or elsewhere) does the definition of the coerce() method for signature=c("integer", "numeric") come?
I'm not sure whether I can answer your question exhaustively, but I'll try.
The help of the as() function states:
The function ‘as’ turns ‘object’ into an object of class ‘Class’. In doing so, it applies a “coerce method”, using S4 classes and methods, but in a somewhat special way.
[...]
Assuming the ‘object’ is not already of the desired class, ‘as’ first looks for a method in the table of methods for the function 'coerce’ for the signature ‘c(from = class(object), to = Class)’, in the same way method selection would do its initial lookup.
[...]
If no method is found, ‘as’ looks for one. First, if either ‘Class’ or ‘class(object)’ is a superclass of the other, the class definition will contain the information needed to construct a coerce method. In the usual case that the subclass contains the superclass (i.e., has all its slots), the method is constructed either by extracting or replacing the inherited slots.
This is exactly what you can see if you look at the code of the as() function (to see it, type as (without the parentheses!) to the R console) - see below. First it looks for an asMethod, if it can't find any it tries to construct one, and finally at the end it executes it:
if (strict)
asMethod(object)
else asMethod(object, strict = FALSE)
When you copy-paste the code of the as() function and define your own function - let's call it myas() - your can insert a print(asMethod) above the if (strict) just mentioned to get the function used for coercing. In this case the output is:
> myas(4L, 'numeric')
function (from, to = "numeric", strict = TRUE)
if (strict) {
class(from) <- "numeric"
from
} else from
<environment: namespace:methods>
attr(,"target")
An object of class “signature”
from to
"integer" "numeric"
attr(,"defined")
An object of class “signature”
from to
"integer" "numeric"
attr(,"generic")
[1] "coerce"
attr(,"generic")attr(,"package")
[1] "methods"
attr(,"class")
[1] "MethodDefinition"
attr(,"class")attr(,"package")
[1] "methods"
attr(,"source")
[1] "function (from, to = \"numeric\", strict = TRUE) "
[2] "if (strict) {"
[3] " class(from) <- \"numeric\""
[4] " from"
[5] "} else from"
[1] 4
So, as you can see (look at attr(,"source")), the as(4L, 'numeric') simply assigns class numeric to the input object and returns it. Thus, the following two snippets are equivalent (for this case!):
> # Snippet 1
> x = 4L
> x = as(x, 'numeric')
> # Snippet 2
> x = 4L
> class(x) <- 'numeric'
Interestingly, both to 'nothing'. More interestingly, the other way round it works:
> x = 4
> class(x)
[1] "numeric"
> class(x) <- 'integer'
> class(x)
[1] "integer"
I'm not exactly sure about this (as the class method seems to be implemented in C) - but my guess would be that when assigning class numeric, it first checks whether it is already numeric. Which could be the case as integer is numeric (although not double) - see also the "historical anomaly" quote below:
> x = 4L
> class(x)
[1] "integer"
> is.numeric(x)
[1] TRUE
Regarding as.numeric:
This is a generic method and calls as.double(), which is why it 'works' (from the R help on as.numeric):
It is a historical anomaly that R has two names for its floating-point vectors, ‘double’ and ‘numeric’ (and formerly had ‘real’).
‘double’ is the name of the type. ‘numeric’ is the name of the mode and also of the implicit class.
Regarding questions (1) - (3): The magic happens in those four lines at the top of the as function:
where <- .classEnv(thisClass, mustFind = FALSE)
coerceFun <- getGeneric("coerce", where = where)
coerceMethods <- .getMethodsTable(coerceFun, environment(coerceFun), inherited = TRUE)
asMethod <- .quickCoerceSelect(thisClass, Class, coerceFun, coerceMethods, where)
Im lacking the time to dig into there, sorry.
Hope that helps.
Looking at the source code for as(), it has two parts. (The source code has been shortened for clarity). First, it looks for existing methods for coerce(), as you described above.
function (object, Class, strict = TRUE, ext = possibleExtends(thisClass,
Class))
{
thisClass <- .class1(object)
where <- .classEnv(thisClass, mustFind = FALSE)
coerceFun <- getGeneric("coerce", where = where)
coerceMethods <- .getMethodsTable(coerceFun, environment(coerceFun),
inherited = TRUE)
asMethod <- .quickCoerceSelect(thisClass, Class, coerceFun,
coerceMethods, where)
# No matching signatures from the coerce table!!!
if (is.null(asMethod)) {
sig <- c(from = thisClass, to = Class)
asMethod <- selectMethod("coerce", sig, optional = TRUE,
useInherited = FALSE, fdef = coerceFun, mlist = getMethodsForDispatch(coerceFun))
If it doesn't find any methods, as in this case, then it attempts to create a new method as follows:
if (is.null(asMethod)) {
canCache <- TRUE
inherited <- FALSE
# The integer vector is numeric!!!
if (is(object, Class)) {
ClassDef <- getClassDef(Class, where)
if (identical(ext, FALSE)) {}
else if (identical(ext, TRUE)) {}
else {
test <- ext#test
# Create S4 coercion method here
asMethod <- .makeAsMethod(ext#coerce, ext#simple,
Class, ClassDef, where)
canCache <- (!is(test, "function")) || identical(body(test),
TRUE)
}
}
if (is.null(asMethod)) {}
else if (canCache)
asMethod <- .asCoerceMethod(asMethod, thisClass,
ClassDef, FALSE, where)
if (is.null(asMethod)) {}
else if (canCache) {
cacheMethod("coerce", sig, asMethod, fdef = coerceFun,
inherited = inherited)
}
}
}
# Use newly created method on object here
if (strict)
asMethod(object)
else asMethod(object, strict = FALSE)
By the way, if you're only dealing with the basic atomic types, I would stick to base functions and avoid the methods package; the only reason to use methods is dealing with S4 objects.

Methods for recursive concatenations on user defined classes in R?

All the concatenation functions in R can be rewritten as recursive functions. For instance, I could use c as a binary operator and I could define a new concat function as
concat <- function(...) {
Reduce(c, ...)
}
and concat would function as c actually functions in R base.
R syntactically uses many such functions, for instance c for vectors and lists, cbind for arrays, data.frames and matrices. When defining new object classes, it makes sense to create a method for combining them using a function which takes ... as an argument.
I know R can match methods to objects when they are the first object in the argument list, but what if I define a method like
concat <- function(...) {
UseMethod('concat')
}
concat.numeric <- function(...) {
c(...)
}
concat.character <- function(...) {
c(...)
}
myCon <- function(charPart, numPart) {
out <- list(charPart=charPart, numPart=numPart)
class(out) <- "myClass"
out
}
concat.myClass <- function(...) {
myCon(sapply(..., `[[`, 'charPart'), sapply(..., `[[`, 'numPart'))
}
> concat(4, 6, 'a')
"4" "6" "a"
> myObj1 <- myCon('a', 1)
> myObj2 <- myCon('b', 2)
> concat(myObj1, myObj2)
Error in get(as.character(FUN), mode = "function", envir = envir) :
object 'p' of mode 'function' was not found
At what point does R identify the types of arguments supplied to concat? How can I convince R to attempt to cast arguments to concat up to my specific object class?
You're not quite passing what you think to sapply you need to put it in list(...) so sapply can iterate through the elements rather than parsing them as extra arguments in the wrong place.
concat.myClass <- function(...)
{
myCon(sapply(list(...), `[[`, 'charPart'), sapply(list(...), `[[`, 'numPart'))
}
> myObj1
$charPart
[1] "a"
$numPart
[1] 1
attr(,"class")
[1] "myClass"
> myObj2
$charPart
[1] "b"
$numPart
[1] 2
attr(,"class")
[1] "myClass"
this then gives:
> concat(myObj1, myObj2)
$charPart
[1] "a" "b"
$numPart
[1] 1 2
attr(,"class")
[1] "myClass"
.. which I presume is what you want???

Resources