15 S4
15.1 Basics (Exercises 15.2.1)
Q1. lubridate::period() returns an S4 class. What slots does it have? What class is each slot? What accessors does it provide?
A1. Let’s first create an instance of Period class:
library(lubridate)
x <- lubridate::period(c(2, 43, 6), c("hour", "second", "minute"))
x
#> [1] "2H 6M 43S"It has the following slots:
slotNames(x)
#> [1] ".Data" "year" "month" "day" "hour" "minute"Additionally, the base type of each slot (numeric) can be seen in str() output:
str(x)
#> Formal class 'Period' [package "lubridate"] with 6 slots
#> ..@ .Data : num 43
#> ..@ year : num 0
#> ..@ month : num 0
#> ..@ day : num 0
#> ..@ hour : num 2
#> ..@ minute: num 6The lubridate package provides accessors for all slots:
year(x)
#> [1] 0
month(x)
#> [1] 0
day(x)
#> [1] 0
hour(x)
#> [1] 2
minute(x)
#> [1] 6
second(x)
#> [1] 43Q2. What other ways can you find help for a method? Read ?"?" and summarise the details.
A2. The "?" operator allows access to documentation in three ways. To demonstrate different ways to access documentation, let’s define a new S4 class.
pow <- function(x, exp) c(x, exp)
setGeneric("pow")
#> [1] "pow"Ways to access documentation:
- The general documentation for a generic can be found with
?topic:
?pow- The expression
type?topicwill look for the overall documentation methods for the functionf.
?pow # produces the function documentation
methods?pow # looks for the overall methods documentation15.2 Classes (Exercises 15.3.6)
Q1. Extend the Person class with fields to match utils::person(). Think about what slots you will need, what class each slot should have, and what you’ll need to check in your validity method.
A1. The code below extends the Person class described in the book to match more closely with utils::person().
setClass("Person",
slots = c(
age = "numeric",
given = "character",
family = "character",
middle = "character",
email = "character",
role = "character",
comment = "character"
),
prototype = list(
age = NA_real_,
given = NA_character_,
family = NA_character_,
middle = NA_character_,
email = NA_character_,
role = NA_character_,
comment = NA_character_
)
)
# Helper function to create an instance of the `Person` class
Person <- function(given,
family,
middle = NA_character_,
age = NA_real_,
email = NA_character_,
role = NA_character_,
comment = NA_character_) {
age <- as.double(age)
new("Person",
age = age,
given = given,
family = family,
middle = middle,
email = email,
role = role,
comment = comment
)
}
# Validator to ensure that each slot is of length one and that the specified
# role is one of the possible roles
setValidity("Person", function(object) {
invalid_length <- NULL
slot_lengths <- c(
length(object@age),
length(object@given),
length(object@middle),
length(object@family),
length(object@email),
length(object@comment)
)
if (any(slot_lengths > 1L)) {
invalid_length <- "\nFollowing slots must be of length 1:\n @age, @given, @family, @middle, @email, @comment"
}
possible_roles <- c(
NA_character_, "aut", "com", "cph", "cre", "ctb", "ctr", "dtc", "fnd", "rev", "ths", "trl"
)
if (any(!object@role %in% possible_roles)) {
invalid_length <- paste(
invalid_length,
"\nSlot @role(s) must be one of the following:\n",
paste(possible_roles, collapse = ", ")
)
}
if (!is.null(invalid_length)) {
return(invalid_length)
} else {
return(TRUE)
}
})
#> Class "Person" [in ".GlobalEnv"]
#>
#> Slots:
#>
#> Name: age given family middle email
#> Class: numeric character character character character
#>
#> Name: role comment
#> Class: character characterLet’s make sure that validation works as expected:
# length of first argument not 1
Person(c("Indrajeet", "Surendra"), "Patil")
#> Error in validObject(.Object): invalid class "Person" object:
#> Following slots must be of length 1:
#> @age, @given, @family, @middle, @email, @comment
# role not recognized
Person("Indrajeet", "Patil", role = "xyz")
#> Error in validObject(.Object): invalid class "Person" object:
#> Slot @role(s) must be one of the following:
#> NA, aut, com, cph, cre, ctb, ctr, dtc, fnd, rev, ths, trl
# all okay
Person("Indrajeet", "Patil", role = c("aut", "cph"))
#> An object of class "Person"
#> Slot "age":
#> [1] NA
#>
#> Slot "given":
#> [1] "Indrajeet"
#>
#> Slot "family":
#> [1] "Patil"
#>
#> Slot "middle":
#> [1] NA
#>
#> Slot "email":
#> [1] NA
#>
#> Slot "role":
#> [1] "aut" "cph"
#>
#> Slot "comment":
#> [1] NAQ2. What happens if you define a new S4 class that doesn’t have any slots? (Hint: read about virtual classes in ?setClass.)
A2. If you define a new S4 class that doesn’t have any slots, it will create virtual classes:
setClass("Empty")
isVirtualClass("Empty")
#> [1] TRUEYou can’t create an instance of this class:
new("Empty")
#> Error in new("Empty"): trying to generate an object from a virtual class ("Empty")So how is this useful? As mentioned in ?setClass docs:
Classes exist for which no actual objects can be created, the virtual classes.
The most common and useful form of virtual class is the class union, a virtual class that is defined in a call to
setClassUnion()rather than a call tosetClass().
So virtual classes can still be inherited:
setClass("Nothing", contains = "Empty")In addition to not specifying any slots, here is another way to create virtual classes:
Calls to
setClass()will also create a virtual class, either when only the Class argument is supplied (no slots or superclasses) or when thecontains=argument includes the special class name"VIRTUAL".
Q3. Imagine you were going to reimplement factors, dates, and data frames in S4. Sketch out the setClass() calls that you would use to define the classes. Think about appropriate slots and prototype.
A3. The reimplementation of following classes in S4 might have definitions like the following.
factor
For simplicity, we won’t provide all options that factor() provides. Note that x has pseudo-class ANY to accept objects of any type.
setClass("Factor",
slots = c(
x = "ANY",
levels = "character",
ordered = "logical"
),
prototype = list(
x = character(),
levels = character(),
ordered = FALSE
)
)
new("Factor", x = letters[1:3], levels = LETTERS[1:3])
#> An object of class "Factor"
#> Slot "x":
#> [1] "a" "b" "c"
#>
#> Slot "levels":
#> [1] "A" "B" "C"
#>
#> Slot "ordered":
#> [1] FALSE
new("Factor", x = 1:3, levels = letters[1:3])
#> An object of class "Factor"
#> Slot "x":
#> [1] 1 2 3
#>
#> Slot "levels":
#> [1] "a" "b" "c"
#>
#> Slot "ordered":
#> [1] FALSE
new("Factor", x = c(TRUE, FALSE, TRUE), levels = c("x", "y", "x"))
#> An object of class "Factor"
#> Slot "x":
#> [1] TRUE FALSE TRUE
#>
#> Slot "levels":
#> [1] "x" "y" "x"
#>
#> Slot "ordered":
#> [1] FALSEDate
Just like the base-R version, this will have only integer values.
setClass("Date2",
slots = list(
data = "integer"
),
prototype = list(
data = integer()
)
)
new("Date2", data = 1342L)
#> An object of class "Date2"
#> Slot "data":
#> [1] 1342data.frame
The tricky part is supporting the ... argument of data.frame(). For this, we can let the users pass a (named) list.
setClass("DataFrame",
slots = c(
data = "list",
row.names = "character"
),
prototype = list(
data = list(),
row.names = character(0L)
)
)
new("DataFrame", data = list(x = c("a", "b"), y = c(1L, 2L)))
#> An object of class "DataFrame"
#> Slot "data":
#> $x
#> [1] "a" "b"
#>
#> $y
#> [1] 1 2
#>
#>
#> Slot "row.names":
#> character(0)15.3 Generics and methods (Exercises 15.4.5)
Q1. Add age() accessors for the Person class.
A1. We first should define a generic and then a method for our class:
Indra <- Person("Indrajeet", "Patil", role = c("aut", "cph"), age = 34)
setGeneric("age", function(x) standardGeneric("age"))
#> [1] "age"
setMethod("age", "Person", function(x) x@age)
age(Indra)
#> [1] 34Q2. In the definition of the generic, why is it necessary to repeat the name of the generic twice?
A2. Let’s look at the generic we just defined; the generic name "age" is repeated twice.
setGeneric(name = "age", def = function(x) standardGeneric("age"))This is because:
- the
"age"passed to argumentnameprovides the name for the generic - the
"age"passed to argumentdefsupplies the method dispatch
This is reminiscent of how we defined S3 generic, where we also had to repeat the name twice:
age <- function(x) {
UseMethod("age")
}Q3. Why does the show() method defined in Section Show method use is(object)[[1]]? (Hint: try printing the employee subclass.)
A3. Because we wish to define show() method for a specific class, we need to disregard the other super-/sub-classes.
Always using the first element ensures that the method will be defined for the class in question:
is(Alice)[[1]]
#> [1] "Employee"Q4. What happens if you define a method with different argument names to the generic?
A4. Let’s experiment with the method we defined in Q1. to study this behavior.
The original method that worked as expected since the argument name between generic and method matched:
setMethod("age", "Person", function(x) x@age)If this is not the case, we either get a warning or get an error depending on which and how many arguments have been specified:
setMethod("age", "Person", function(object) object@age)
#> Warning: For function 'age', signature 'Person': argument
#> in method definition changed from (object) to (x)
setMethod("age", "Person", function(object, x) object@age)
#> Error in rematchDefinition(definition, fdef, mnames, fnames, signature): methods can add arguments to the generic 'age' only if '...' is an argument to the generic
setMethod("age", "Person", function(...) ...elt(1)@age)
#> Warning: For function 'age', signature 'Person': argument
#> in method definition changed from (...) to (x)
setMethod("age", "Person", function(x, ...) x@age)
#> Error in rematchDefinition(definition, fdef, mnames, fnames, signature): methods can add arguments to the generic 'age' only if '...' is an argument to the generic15.4 Method dispatch (Exercises 15.5.5)
Q1. Draw the method graph for f(😅, 😽).
A1. I don’t how to prepare the visual illustrations used in the book, so I am linking to the illustration in the official solution manual:
Q2. Draw the method graph for f(😃, 😉, 😙).
A2. I don’t how to prepare the visual illustrations used in the book, so I am linking to the illustration in the official solution manual:
Q3. Take the last example which shows multiple dispatch over two classes that use multiple inheritance. What happens if you define a method for all terminal classes? Why does method dispatch not save us much work here?
A3. Because one class has distance of 2 to all terminal nodes and the other four have distance of 1 to two terminal nodes each, this will introduce ambiguity.
Method dispatch not save us much work here because to resolve this ambiguity we have to define five more methods (one per class combination).
15.5 S4 and S3 (Exercises 15.6.3)
Q1. What would a full setOldClass() definition look like for an ordered factor (i.e. add slots and prototype the definition above)?
A1. We can register the old-style/S3 ordered class to a formally defined class using setOldClass().
setClass("factor",
contains = "integer",
slots = c(
levels = "character"
),
prototype = structure(
integer(),
levels = character()
)
)
setOldClass("factor", S4Class = "factor")
#> Warning in rm(list = what, pos = classWhere): object
#> '.__C__factor' not found
setClass("Ordered",
contains = "factor",
slots = c(
levels = "character",
ordered = "logical"
),
prototype = structure(
integer(),
levels = character(),
ordered = logical()
)
)
setOldClass("ordered", S4Class = "Ordered")Let’s use it to see if it works as expected.
x <- new("Ordered", 1L:4L, levels = letters[1:4], ordered = TRUE)
x
#> Object of class "Ordered"
#> [1] a b c d
#> Levels: a b c d
#> Slot "ordered":
#> [1] TRUE
str(x)
#> Formal class 'Ordered' [package ".GlobalEnv"] with 4 slots
#> ..@ .Data : int [1:4] 1 2 3 4
#> ..@ levels : chr [1:4] "a" "b" "c" "d"
#> ..@ ordered : logi TRUE
#> ..@ .S3Class: chr "factor"
class(x)
#> [1] "Ordered"
#> attr(,"package")
#> [1] ".GlobalEnv"Q2. Define a length method for the Person class.
A2. Because our Person class can be used to create objects that represent multiple people, let’s say the length() method returns how many persons are in the object.
We can define an S3 method for this class:
Alternatively, we can also write S4 method:
15.6 Session information
sessioninfo::session_info(include_base = TRUE)
#> ─ Session info ───────────────────────────────────────────
#> setting value
#> version R version 4.4.0 (2024-04-24)
#> os Ubuntu 22.04.4 LTS
#> system x86_64, linux-gnu
#> ui X11
#> language (EN)
#> collate C.UTF-8
#> ctype C.UTF-8
#> tz UTC
#> date 2024-05-20
#> pandoc 3.2 @ /opt/hostedtoolcache/pandoc/3.2/x64/ (via rmarkdown)
#>
#> ─ Packages ───────────────────────────────────────────────
#> package * version date (UTC) lib source
#> assertthat 0.2.1 2019-03-21 [1] RSPM
#> base * 4.4.0 2024-05-06 [3] local
#> bookdown 0.39 2024-04-15 [1] RSPM
#> bslib 0.7.0 2024-03-29 [1] RSPM
#> cachem 1.1.0 2024-05-16 [1] RSPM
#> cli 3.6.2 2023-12-11 [1] RSPM
#> compiler 4.4.0 2024-05-06 [3] local
#> crayon 1.5.2 2022-09-29 [1] RSPM
#> datasets * 4.4.0 2024-05-06 [3] local
#> digest 0.6.35 2024-03-11 [1] RSPM
#> downlit 0.4.3 2023-06-29 [1] RSPM
#> emo 0.0.0.9000 2024-04-28 [1] Github (hadley/emo@3f03b11)
#> evaluate 0.23 2023-11-01 [1] RSPM
#> fastmap 1.2.0 2024-05-15 [1] RSPM
#> fs 1.6.4 2024-04-25 [1] RSPM
#> generics 0.1.3 2022-07-05 [1] RSPM
#> glue 1.7.0 2024-01-09 [1] RSPM
#> graphics * 4.4.0 2024-05-06 [3] local
#> grDevices * 4.4.0 2024-05-06 [3] local
#> highr 0.10 2022-12-22 [1] RSPM
#> htmltools 0.5.8.1 2024-04-04 [1] RSPM
#> jquerylib 0.1.4 2021-04-26 [1] RSPM
#> jsonlite 1.8.8 2023-12-04 [1] RSPM
#> knitr 1.46 2024-04-06 [1] RSPM
#> lifecycle 1.0.4 2023-11-07 [1] RSPM
#> lubridate * 1.9.3 2023-09-27 [1] RSPM
#> magrittr * 2.0.3 2022-03-30 [1] RSPM
#> memoise 2.0.1 2021-11-26 [1] RSPM
#> methods * 4.4.0 2024-05-06 [3] local
#> purrr 1.0.2 2023-08-10 [1] RSPM
#> R6 2.5.1 2021-08-19 [1] RSPM
#> rlang 1.1.3 2024-01-10 [1] RSPM
#> rmarkdown 2.27 2024-05-17 [1] RSPM
#> sass 0.4.9 2024-03-15 [1] RSPM
#> sessioninfo 1.2.2 2021-12-06 [1] RSPM
#> stats * 4.4.0 2024-05-06 [3] local
#> stringi 1.8.4 2024-05-06 [1] RSPM
#> stringr 1.5.1 2023-11-14 [1] RSPM
#> timechange 0.3.0 2024-01-18 [1] RSPM
#> tools 4.4.0 2024-05-06 [3] local
#> utils * 4.4.0 2024-05-06 [3] local
#> vctrs 0.6.5 2023-12-01 [1] RSPM
#> withr 3.0.0 2024-01-16 [1] RSPM
#> xfun 0.44 2024-05-15 [1] RSPM
#> xml2 1.3.6 2023-12-04 [1] RSPM
#> yaml 2.3.8 2023-12-11 [1] RSPM
#>
#> [1] /home/runner/work/_temp/Library
#> [2] /opt/R/4.4.0/lib/R/site-library
#> [3] /opt/R/4.4.0/lib/R/library
#>
#> ──────────────────────────────────────────────────────────