It was introduced in the third version of the S language that was precursor of R. Strongly recommended.
It was introduced in the fourth version of the S language that was precursor of R. Use for bioconductor
Are an attempt to create a system that behaves similarly to popular OOP languages like Java or C#
Similar to ReferenceClases but simpler. Recommended when need more power
class(): Determine the kind of variabletypeof(): Data type of an object# Look at the definition of type_info()
type_info <-
function(x)
{
c(
class = class(x),
typeof = typeof(x),
mode = mode(x),
storage.mode = storage.mode(x)
)
}
# Create list of example variables
some_vars <- list(
an_integer_vector = rpois(24, lambda = 5),
a_numeric_vector = rbeta(24, shape1 = 1, shape2 = 1),
an_integer_array = array(rbinom(24, size = 8, prob = 0.5), dim = c(2, 3, 4)),
a_numeric_array = array(rweibull(24, shape = 1, scale = 1), dim = c(2, 3, 4)),
a_data_frame = data.frame(int = rgeom(24, prob = 0.5), num = runif(24)),
a_factor = factor(month.abb),
a_formula = y ~ x,
a_closure_function = mean,
a_builtin_function = length,
a_special_function = `if`
)
# Loop over some_vars calling type_info() on each element to explore them
lapply(some_vars, type_info)## $an_integer_vector
## class typeof mode storage.mode
## "integer" "integer" "numeric" "integer"
##
## $a_numeric_vector
## class typeof mode storage.mode
## "numeric" "double" "numeric" "double"
##
## $an_integer_array
## class typeof mode storage.mode
## "array" "integer" "numeric" "integer"
##
## $a_numeric_array
## class typeof mode storage.mode
## "array" "double" "numeric" "double"
##
## $a_data_frame
## class typeof mode storage.mode
## "data.frame" "list" "list" "list"
##
## $a_factor
## class typeof mode storage.mode
## "factor" "integer" "numeric" "integer"
##
## $a_formula
## class typeof mode storage.mode
## "formula" "language" "call" "language"
##
## $a_closure_function
## class typeof mode storage.mode
## "function" "closure" "function" "function"
##
## $a_builtin_function
## class typeof mode storage.mode
## "function" "builtin" "function" "function"
##
## $a_special_function
## class typeof mode storage.mode
## "function" "special" "function" "function"Function overlading = input dependent function: summary() is an example of that, depends of the type of input, the function will return different outputs. Its main purpose is simplify the code
The s3 system exists entirely to make this problem easier. it does it splitting function into two parts:
print is a generic function. This is typical for an S3 generic. All the function needs todo is call UseMethod, with its own name.
There are two conditions that you must follow for S3 methods.
print method for Date objects is calle print.Datesummary method for factor objects is called summary.factorprint are x and the ellipsis (...). The arguments to print.Date are the arguments to the generic, with an extra max argument.Variable names separated by dots are sometimes called leopard case. It isn’t a recommended convention. Better use lower_snake_case or lowerCamelCase
You can create your own S3 functions. The first step is to write the generic. This is typically a single line function that calls UseMethod(), passing its name as a string.
The first argument to an S3 generic is usually called x, though this isn’t compulsory. It is also good practice to include a … (“ellipsis”, or “dot-dot-dot”) argument, in case arguments need to be passed from one method to another.
Overall, the structure of an S3 generic looks like this.
an_s3_generic <- function(x, maybe = "some", other = "arguments", ...) {
UseMethod("an_s3_generic")
}By itself, the generic function doesn’t do anything. For that, you need to create methods, which are just regular functions with two conditions:
generic.class <- function(some, arguments, ...) {
# Do something
}get_n_elements <- function(x, ...)
{
UseMethod("get_n_elements")
}
# View get_n_elements
get_n_elements## function(x, ...)
## {
## UseMethod("get_n_elements")
## }# Create a data.frame method for get_n_elements
get_n_elements.data.frame <- function(x, ...)
{
nrow(x) * ncol(x) # or prod(dim(x))
}
# Call the method on the sleep dataset
n_elements_sleep <- get_n_elements(sleep)
# View the result
n_elements_sleep## [1] 60If no suitable method is found for a generic, then an error is thrown. For example, at the moment, get_n_elements() only has a method available for data.frames. If you pass a matrix to get_n_elements() instead, you’ll see an error.
Rather than having to write dozens of methods for every kind of input, you can create a method that handles all types that don’t have a specific method. This is called the default method; it always has the name generic.default. For example, print.default() will print any type of object that doesn’t have its own print() method.
# View predefined objects
ls.str()## an_s3_generic : function (x, maybe = "some", other = "arguments", ...)
## get_n_elements : function (x, ...)
## get_n_elements.data.frame : function (x, ...)
## n_elements_sleep : int 60
## some_vars : List of 10
## $ an_integer_vector : int [1:24] 1 3 3 4 1 2 11 2 8 9 ...
## $ a_numeric_vector : num [1:24] 0.614 0.5378 0.9006 0.9957 0.0245 ...
## $ an_integer_array : int [1:2, 1:3, 1:4] 4 5 2 6 3 6 8 5 6 4 ...
## $ a_numeric_array : num [1:2, 1:3, 1:4] 0.326 1.11 5.165 0.849 0.149 ...
## $ a_data_frame :'data.frame': 24 obs. of 2 variables:
## $ a_factor : Factor w/ 12 levels "Apr","Aug","Dec",..: 5 4 8 1 9 7 6 2 12 11 ...
## $ a_formula :Class 'formula' language y ~ x
## $ a_closure_function:function (x, ...)
## $ a_builtin_function:function (x)
## $ a_special_function:.Primitive("if")
## type_info : function (x)# Create a default method for get_n_elements
get_n_elements.default <- function(x, ...)
{
length(unlist(x, use.names = FALSE))
}
# Call the method on the ability.cov dataset
n_elements_ability.cov <- get_n_elements(ability.cov)Call methods of generic function
methods("mean")## [1] mean.Date mean.default mean.difftime mean.POSIXct mean.POSIXlt
## [6] mean.quosure*
## see '?methods' for accessing help and source code.S3methods(class = 'glm')## [1] add1 anova confint cooks.distance deviance
## [6] drop1 effects extractAIC family formula
## [11] influence logLik model.frame nobs predict
## [16] print residuals rstandard rstudent summary
## [21] vcov weights
## see '?methods' for accessing help and source codeFunctions written in C for performance reasons and can also be generic
.S3PrimitiveGenerics## [1] "anyNA" "as.character" "as.complex" "as.double"
## [5] "as.environment" "as.integer" "as.logical" "as.call"
## [9] "as.numeric" "as.raw" "c" "dim"
## [13] "dim<-" "dimnames" "dimnames<-" "is.array"
## [17] "is.finite" "is.infinite" "is.matrix" "is.na"
## [21] "is.nan" "is.numeric" "length" "length<-"
## [25] "levels<-" "names" "names<-" "rep"
## [29] "seq.int" "xtfrm"Variables can have more than one class. In this case, class() returns a character vector of length greater than one.
Likewise you can set multiple classes by assigning a character vector to class(). The classes should be ordered from more specific to more general as you move left to right, since you want to begin with the behavior most targeted to your object. For example:
x <- c("a", "e", "i", "o", "u")
class(x) <- c("vowels", "letters", "character")You can check for the other classes using the general purpose inherits() function. For example:
inherits(x, "vowels")
kitty <- "Miaow!"
# View the kitty
kitty## [1] "Miaow!"# Assign classes
class(kitty) <- c("cat", "mammal", "character")
# Does kitty inherit from cat/mammal/character?
inherits(kitty, "cat")## [1] TRUEinherits(kitty, "mammal")## [1] TRUEinherits(kitty, "character")## [1] TRUE# Is kitty a character vector?
is.character(kitty)## [1] TRUE# Does kitty inherit from dog?
inherits(kitty, "dog")## [1] FALSEkitty## [1] "Miaow!"
## attr(,"class")
## [1] "cat" "mammal" "character"When objects have multiple classes, you may wish to call methods for several of these classes. This is done using NextMethod().
The S3 methods now take the form:
an_s3_method.some_class <- function(x, ...)
{
# Act on some_class, then
NextMethod("an_s3_method")
}That is, NextMethod() should be the last line of the method.
what_am_i <- function(x, ...)
{
UseMethod("what_am_i")
}
# Inspect your workspace
ls.str()## an_s3_generic : function (x, maybe = "some", other = "arguments", ...)
## get_n_elements : function (x, ...)
## get_n_elements.data.frame : function (x, ...)
## get_n_elements.default : function (x, ...)
## kitty : 'cat' chr "Miaow!"
## n_elements_ability.cov : int 43
## n_elements_sleep : int 60
## some_vars : List of 10
## $ an_integer_vector : int [1:24] 1 3 3 4 1 2 11 2 8 9 ...
## $ a_numeric_vector : num [1:24] 0.614 0.5378 0.9006 0.9957 0.0245 ...
## $ an_integer_array : int [1:2, 1:3, 1:4] 4 5 2 6 3 6 8 5 6 4 ...
## $ a_numeric_array : num [1:2, 1:3, 1:4] 0.326 1.11 5.165 0.849 0.149 ...
## $ a_data_frame :'data.frame': 24 obs. of 2 variables:
## $ a_factor : Factor w/ 12 levels "Apr","Aug","Dec",..: 5 4 8 1 9 7 6 2 12 11 ...
## $ a_formula :Class 'formula' language y ~ x
## $ a_closure_function:function (x, ...)
## $ a_builtin_function:function (x)
## $ a_special_function:.Primitive("if")
## type_info : function (x)
## what_am_i : function (x, ...)# cat method
what_am_i.cat <- function(x, ...)
{
# Write a message
message("I'm a cat")
# Call NextMethod
NextMethod("what_am_i")
}
# mammal method
what_am_i.mammal <- function(x, ...)
{
message("I'm a mammal")
NextMethod("what_am_i")
}
# character method
what_am_i.character <- function(x, ...)
{
message("I'm a character vector")
}
# Call what_am_i()
what_am_i(kitty)## I'm a cat## I'm a mammal## I'm a character vectorThe R6 system provides a way of storing data and objects within the same variable
R6 library use R6Class function to create classes
library(R6)
thing_factory <- R6Class(
"Thing", # The name of class, by convention use UpperCamelCase
private = list(
a_field = "a_value",
another_field = 123
)
)
a_thing <- thing_factory$new()# Define microwave_oven_factory
microwave_oven_factory <- R6Class(
"MicrowaveOven",
private = list(
power_rating_watts = 800
)
)
# View the microwave_oven_factory
microwave_oven_factory## <MicrowaveOven> object generator
## Public:
## clone: function (deep = FALSE)
## Private:
## power_rating_watts: 800
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUE# Make a new microwave oven
microwave_oven <- microwave_oven_factory$new()In OOP, the term for separating the implementation of the object from its user interface is called “encapsulation”
# Add a cook method to the factory definition
# Add a close_door() method
# Add an initialize method
microwave_oven_factory <- R6Class(
"MicrowaveOven",
private = list(
power_rating_watts = 800,
door_is_open = FALSE
),
public = list(
cook = function(time_seconds) {
Sys.sleep(time_seconds)
print("Your food is cooked!")
},
open_door = function() {
private$door_is_open <- TRUE
},
close_door = function() {
private$door_is_open <- FALSE
},
# Add initialize() method here
initialize = function(power_rating_watts, door_is_open) {
if(!missing(power_rating_watts)) {
private$power_rating_watts <- power_rating_watts
}
if(!missing(door_is_open)) {
private$door_is_open <- door_is_open
}
}
)
)
# Make a microwave
a_microwave_oven <- microwave_oven_factory$new(
power_rating_watts = 650,
door_is_open = TRUE
)
# Call cook method for 1 second
a_microwave_oven$cook(1)## [1] "Your food is cooked!"Data Values stored in the private element of R6class are not directly accesible by the user
Are defined like functions, but are accessed like data variables. for convention the private names begin with ..
library("assertive")## Warning: package 'assertive' was built under R version 4.0.3# Add a binding for power rating
microwave_oven_factory <- R6Class(
"MicrowaveOven",
private = list(
..power_rating_watts = 800,
..power_level_watts = 800
),
# Add active list containing an active binding
active = list(
power_level_watts = function(value) {
if(missing(value)) {
# Return the private value
private$..power_level_watts
} else {
# Assert that value is a number
assert_is_a_number(value)
# Assert that value is in a closed range from 0 to power rating
assert_all_are_in_closed_range(
value, lower = 0, upper = private$..power_rating_watts
)
# Set the private power level to value
private$..power_level_watts <- value
}
}
)
)
# Make a microwave
a_microwave_oven <- microwave_oven_factory$new()
# Get the power level
a_microwave_oven$power_level_watts## [1] 800# Try to set the power level to "400"
# $power_level_watts <- "400"
# Try to set the power level to 1600 watts
# a_microwave_oven$power_level_watts <- 1600
# Set the power level to 400 watts
a_microwave_oven$power_level_watts <- 400# Define a fancy microwave class inheriting from microwave oven
fancy_microwave_oven_factory <- R6Class(
"FancyMicrowaveOven",
inherit = microwave_oven_factory
)
# Explore microwave oven classes
microwave_oven_factory## <MicrowaveOven> object generator
## Public:
## clone: function (deep = FALSE)
## Active bindings:
## power_level_watts: function (value)
## Private:
## ..power_rating_watts: 800
## ..power_level_watts: 800
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUEfancy_microwave_oven_factory## <FancyMicrowaveOven> object generator
## Inherits from: <microwave_oven_factory>
## Public:
## clone: function (deep = FALSE)
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUE# Instantiate both types of microwave
a_microwave_oven <- microwave_oven_factory$new()
a_fancy_microwave <- fancy_microwave_oven_factory$new()
# Get power rating for each microwave
microwave_power_rating <- a_microwave_oven$power_rating_watts
fancy_microwave_power_rating <- a_fancy_microwave$power_rating_watts
# Verify that these are the same
identical(microwave_power_rating, fancy_microwave_power_rating)## [1] TRUEprivate$ accesses privte fieldself$ accesses public methods in selfsuper$ accessess public methods in parentWith inheritance:
# Explore microwave oven class
microwave_oven_factory <- R6Class(
"MicrowaveOven",
private = list(
power_rating_watts = 800,
door_is_open = FALSE
),
public = list(
cook = function(time_seconds) {
Sys.sleep(time_seconds)
print("Your food is cooked!")
},
open_door = function() {
private$door_is_open <- TRUE
},
close_door = function() {
private$door_is_open <- FALSE
},
# Add initialize() method here
initialize = function(power_rating_watts, door_is_open) {
if(!missing(power_rating_watts)) {
private$power_rating_watts <- power_rating_watts
}
if(!missing(door_is_open)) {
private$door_is_open <- door_is_open
}
}
)
)
# Extend the class definition
fancy_microwave_oven_factory <- R6Class(
"FancyMicrowaveOven",
inherit = microwave_oven_factory,
# Add a public list with a cook baked potato method
public = list(
cook_baked_potato = function() {
self$cook(3)
}
)
)
# Instantiate a fancy microwave
a_fancy_microwave <- fancy_microwave_oven_factory$new()
# Call the cook_baked_potato() method
a_fancy_microwave$cook_baked_potato()## [1] "Your food is cooked!"# Explore microwave oven class
microwave_oven_factory## <MicrowaveOven> object generator
## Public:
## cook: function (time_seconds)
## open_door: function ()
## close_door: function ()
## initialize: function (power_rating_watts, door_is_open)
## clone: function (deep = FALSE)
## Private:
## power_rating_watts: 800
## door_is_open: FALSE
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUE# Update the class definition
fancy_microwave_oven_factory <- R6Class(
"FancyMicrowaveOven",
inherit = microwave_oven_factory,
# Add a public list with a cook method
public = list(
cook = function(time_seconds) {
super$cook(time_seconds)
message("Enjoy your dinner!")
}
)
)
# Instantiate a fancy microwave
a_fancy_microwave <- fancy_microwave_oven_factory$new()
# Call the cook() method
a_fancy_microwave$cook(1)## [1] "Your food is cooked!"## Enjoy your dinner!By default, R6 classes only have access to the functionality of their direct parent. To allow access across multiple generations, the intermediate classes need to define an active binding that exposes their parent. This takes the form
# Expose the parent functionality
fancy_microwave_oven_factory <- R6Class(
"FancyMicrowaveOven",
inherit = microwave_oven_factory,
public = list(
cook_baked_potato = function() {
self$cook(3)
},
cook = function(time_seconds) {
super$cook(time_seconds)
message("Enjoy your dinner!")
}
),
# Add an active element with a super_ binding
active = list(
super_ = function() super
)
)
# Instantiate a fancy microwave
a_fancy_microwave <- fancy_microwave_oven_factory$new()
# Call the super_ binding
a_fancy_microwave$super_## <environment: 0x000000001081b1e8># Explore other microwaves
microwave_oven_factory## <MicrowaveOven> object generator
## Public:
## cook: function (time_seconds)
## open_door: function ()
## close_door: function ()
## initialize: function (power_rating_watts, door_is_open)
## clone: function (deep = FALSE)
## Private:
## power_rating_watts: 800
## door_is_open: FALSE
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUEfancy_microwave_oven_factory## <FancyMicrowaveOven> object generator
## Inherits from: <microwave_oven_factory>
## Public:
## cook_baked_potato: function ()
## cook: function (time_seconds)
## clone: function (deep = FALSE)
## Active bindings:
## super_: function ()
## Parent env: <environment: R_GlobalEnv>
## Locked objects: TRUE
## Locked class: FALSE
## Portable: TRUE# Define a high-end microwave oven class
high_end_microwave_oven_factory <- R6Class(
"HighEndMicrowaveOven",
inherit = fancy_microwave_oven_factory,
public = list(
cook = function(time_seconds) {
super$super_$cook(time_seconds)
message(ascii_pizza_slice)
}
)
)
# Instantiate a high-end microwave oven
a_high_end_microwave <- high_end_microwave_oven_factory$new()
# Use it to cook for one second
#a_high_end_microwave$cook(1)# Define a new environment
env <- new.env()
# Add an element named perfect using $
env$perfect <- c(6, 28, 496)
# Add an element named bases using [[
env[["bases"]] <- c("A", "C", "G", "T")
# Complete the class definition
microwave_oven_factory <- R6Class(
"MicrowaveOven",
private = list(
shared = {
# Create a new environment named e
e <- new.env()
# Assign safety_warning into e
e$safety_warning <- "Warning. Do not try to cook metal objects."
# Return e
e
}
),
active = list(
# Add the safety_warning binding
safety_warning = function(value) {
if(missing(value)) {
private$shared$safety_warning
} else {
private$shared$safety_warning <- value
}
}
)
)
# Create two microwave ovens
a_microwave_oven <- microwave_oven_factory$new()
another_microwave_oven <- microwave_oven_factory$new()
# Change the safety warning for a_microwave_oven
a_microwave_oven$safety_warning <- "Warning. If the food is too hot you may scald yourself."
# Verify that the warning has change for another_microwave
another_microwave_oven$safety_warning## [1] "Warning. If the food is too hot you may scald yourself."R6 objects use the same copy by reference behavior as environments. That is, if you copy an R6 object using <- assignment, then changes in one object will be reflected in the copies as well.
# Create a microwave oven
a_microwave_oven <- microwave_oven_factory$new()
# Copy a_microwave_oven using <-
assigned_microwave_oven <- a_microwave_oven
# Copy a_microwave_oven using clone()
cloned_microwave_oven <- a_microwave_oven$clone()
# Change a_microwave_oven's power level
#a_microwave_oven$power_level_watts <- 400
# Check a_microwave_oven & assigned_microwave power level same
identical(a_microwave_oven$power_level_watts, assigned_microwave_oven$power_level_watts)## [1] TRUE# Check a_microwave_oven & cloned_microwave_oven power level different
identical(a_microwave_oven$power_level_watts, cloned_microwave_oven$power_level_watts) ## [1] TRUEJust as an R6 class can define a public initialize() method to run custom code when objects are created, they can also define a public finalize() method to run custom code when objects are destroyed. finalize() should take no arguments. It is typically used to close connections to databases or files, or undo side-effects such as changing global options() or graphics par() ameters.
library(RSQLite)
# From previous step
smart_microwave_oven_factory <- R6Class(
"SmartMicrowaveOven",
inherit = microwave_oven_factory,
private = list(
conn = NULL
),
public = list(
initialize = function() {
private$conn <- dbConnect(SQLite(), "cooking-times.sqlite")
},
get_cooking_time = function(food) {
dbGetQuery(
private$conn,
sprintf("SELECT time_seconds FROM cooking_times WHERE food = '%s'", food)
)
},
finalize = function() {
message("Disconnecting from the cooking times database.")
dbDisconnect(private$conn)
}
)
)
a_smart_microwave <- smart_microwave_oven_factory$new()
# Remove the smart microwave
rm(a_smart_microwave)
# Force garbage collection
gc() ## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 763732 40.8 1440288 77 1164281 62.2
## Vcells 1370689 10.5 8388608 64 2190161 16.8