S3 -- basic R OOP system,
S4 -- a bit more advanced OOP, common in, e.g. Bioconductor,
RC -- Reference Classes, the most advanced and close to, e.g. Java OOP, extension of S4,
R6 -- simplified RC, extension of S3, require(R6)
S4 classes are more advanced as you actually define the structure of the data within the object of your particular class:
setClass('gene', representation(name='character', coords='numeric') ).intragenic_region <- setClass(Class = 'intragenic_region', slots = c( name='character', coords='numeric' ) )my.gene <- new('gene', name = 'ANK3', coords = c(1.4e6, 1.412e6))# but since SetClass returns a low-level constructormy.intra1 <- .intragenic_region(name = 'int1', coords = c(1.7e6, 1.717e6))
.ext_gene <- setClass(Class = 'ext_gene', contains = "gene", slots = c( gene = 'gene', feature_name = 'character', feature_value = 'character' ))ANK3 <- .ext_gene(name = 'ANK3', coords = c(1.4e6, 1.412e6), feature_name = 'num_introns', feature_value = '5')str(ANK3)
## Formal class 'ext_gene' [package ".GlobalEnv"] with 5 slots## ..@ gene :Formal class 'gene' [package ".GlobalEnv"] with 2 slots## .. .. ..@ name : chr(0) ## .. .. ..@ coords: num(0) ## ..@ feature_name : chr "num_introns"## ..@ feature_value: chr "5"## ..@ name : chr "ANK3"## ..@ coords : num [1:2] 1400000 1412000
Preventing double class definition:
setClass('Not_Sealed')setClass('Not_Sealed')
But to prevent this:
setClass('Sealed', sealed = T)setClass('Sealed')
## Error in setClass("Sealed"): "Sealed" has a sealed class definition and cannot be redefined
The variables within an S4 class are stored in the so-called slots. In the above example, we have 2 such slots: name and coords. Here is how to access them:
my.gene@name # access using @ operatormy.gene@coords[2] # access the 2nd element in slot coords
## [1] "ANK3"## [1] 1412000
The power of classes lies in the fact that they define both the data types in particular slots and operations (functions) we can perform on them. Let us define a generic print function for an S4 class:
setMethod('print', 'gene', function(x) { cat('GENE: ', x@name, ' --> ') cat('[', x@coords, ']') })print(my.gene) # and we use the newly defined print
## GENE: ANK3 --> [ 1400000 1412000 ]
An S3 class object is one of R base types (e.g. integer) with class
attribute set:
An S3 class object is one of R base types (e.g. integer) with class
attribute set:
obj <- factor(c("a", "b", "c"))typeof(obj)
## [1] "integer"
class(obj)
## [1] "factor"
attributes(obj)
## $levels## [1] "a" "b" "c"## ## $class## [1] "factor"
str(obj)
## Factor w/ 3 levels "a","b","c": 1 2 3
An S3 class object is one of R base types (e.g. integer) with class
attribute set:
obj <- factor(c("a", "b", "c"))typeof(obj)
## [1] "integer"
class(obj)
## [1] "factor"
attributes(obj)
## $levels## [1] "a" "b" "c"## ## $class## [1] "factor"
str(obj)
## Factor w/ 3 levels "a","b","c": 1 2 3
print(obj)
## [1] a b c## Levels: a b c
An S3 class object is one of R base types (e.g. integer) with class
attribute set:
obj <- factor(c("a", "b", "c"))typeof(obj)
## [1] "integer"
class(obj)
## [1] "factor"
attributes(obj)
## $levels## [1] "a" "b" "c"## ## $class## [1] "factor"
str(obj)
## Factor w/ 3 levels "a","b","c": 1 2 3
print(obj)
## [1] a b c## Levels: a b c
print(unclass(obj))
## [1] 1 2 3## attr(,"levels")## [1] "a" "b" "c"
str
MethodsSome S3 classes provide a custom str
, e.g.:
time <- strptime("2018-06-07", "%Y-%m-%d")
str(time)
## POSIXlt[1:1], format: "2018-06-07"
str(unclass(time))
## List of 11## $ sec : num 0## $ min : int 0## $ hour : int 0## $ mday : int 7## $ mon : int 5## $ year : int 118## $ wday : int 4## $ yday : int 157## $ isdst : int 1## $ zone : chr "CEST"## $ gmtoff: int NA
Have you ever wondered why print()
or summary()
work on many types (classes) of data?
Have you ever wondered why print()
or summary()
work on many types (classes) of data?
They are so-called generics, i.e. functions and methods that operate on classes. They know which method to apply to which class thanks to the process of method dispatch.
The naming scheme for generics is: generic.class()
i.e. a generic that applies to the class
class.
Examples:
print.factor()
, print.default()
, print.data.frame()
.To see the code of a method:
getS3method('summary', 'lm') %>% head(n = 5)
## ## 1 function (object, correlation = FALSE, symbolic.cor = FALSE, ## 2 ...) ## 3 { ## 4 z <- object ## 5 p <- z$rank
To create an S3 class, simply give a name to a data structure:
gf <- structure(list(), class = 'genomic_features')class(gf)
## [1] "genomic_features"
OR
gf <- list()class(gf) <- 'genomic_features'class(gf)
## [1] "genomic_features"
You can use some inheritance too:
egf <- list()class(egf) <- c('genomic_features', 'extended_genomic_features')class(egf)
## [1] "genomic_features" "extended_genomic_features"
linmod <- with(mtcars, lm(log(mpg) ~ log(disp)))linmod
## ## Call:## lm(formula = log(mpg) ~ log(disp))## ## Coefficients:## (Intercept) log(disp) ## 5.3810 -0.4586
linmod <- with(mtcars, lm(log(mpg) ~ log(disp)))linmod
## ## Call:## lm(formula = log(mpg) ~ log(disp))## ## Coefficients:## (Intercept) log(disp) ## 5.3810 -0.4586
class(linmod) <- "data.frame"linmod
## [1] coefficients residuals effects rank fitted.values## [6] assign qr df.residual xlevels call ## [11] terms model ## <0 rows> (or 0-length row.names)
linmod <- with(mtcars, lm(log(mpg) ~ log(disp)))linmod
## ## Call:## lm(formula = log(mpg) ~ log(disp))## ## Coefficients:## (Intercept) log(disp) ## 5.3810 -0.4586
class(linmod) <- "data.frame"linmod
## [1] coefficients residuals effects rank fitted.values## [6] assign qr df.residual xlevels call ## [11] terms model ## <0 rows> (or 0-length row.names)
apply()
system_time()
system.time(x <- runif(n = 100000))x[1:5]
## user system elapsed ## 0.003 0.000 0.005 ## [1] 0.8543852 0.4353749 0.2444676 0.8691084 0.4898445
my_plot <- function(...) { plot(..., col = 'blue', las = 1, cex = .5, pch = 19, cex.axis = .7)}
tidyverse
functions take data x
as the very first argument and return object similar to x
so that they can be chained by %>%
Even more patterns here.
new_Animal <- function(species, age) { stopifnot(is.character(species)) stopifnot(is.numeric(age)) structure( species, age = age, class = "Animal" )}
validate_Animal <- function(x) { species <- unclass(x) age <- attr(x, 'age') if (is.na(species) || species == "") { stop('Species name is missing!', call. = FALSE) } if (!is.numeric(age) || age < 1 || age >= 100) { stop("Invalid age!", call. = FALSE) } return(x)}
Animal <- function(x) { species <- x[[1]] age <- x[[2]] validate_Animal(new_Animal(species, age))}
Animal <- function(x) { species <- x[[1]] age <- x[[2]] validate_Animal(new_Animal(species, age))}
# Testingdog <- Animal(list('Canis familiaris', 7))class(dog)
## [1] "Animal"
Animal <- function(x) { species <- x[[1]] age <- x[[2]] validate_Animal(new_Animal(species, age))}
# Testingdog <- Animal(list('Canis familiaris', 7))class(dog)
## [1] "Animal"
cat <- Animal(list('Felis felis', '9'))
## Error in new_Animal(species, age): is.numeric(age) is not TRUE
cat <- Animal(list('Felis felis', 9))class(cat)
## [1] "Animal"
One can build an S3 class on top of any existing base type, e.g. a named list:
point_in_space_class <- function(x, y, z) { structure( list( x = x, y = y, z = z ), class = "point_in_space_class" )}
require(R6)
,library(R6)Person <- R6Class("Person", public = list( name = NULL, hair = NULL, initialize = function(name = NA, hair = NA) { stopifnot(is.character(name), is.character(hair)) self$name <- name self$hair <- hair self$greet() }, set_hair = function(val) { self$hair <- val }, greet = function() { cat(paste0("Hello, my name is ", self$name, ".\n")) } ))
kate <- Person$new(name = 'Kate', hair = 'blond')str(kate)
## Hello, my name is Kate.## Classes 'Person', 'R6' <Person>## Public:## clone: function (deep = FALSE) ## greet: function () ## hair: blond## initialize: function (name = NA, hair = NA) ## name: Kate## set_hair: function (val)
kate <- Person$new(name = 'Kate', hair = 'blond')str(kate)
## Hello, my name is Kate.## Classes 'Person', 'R6' <Person>## Public:## clone: function (deep = FALSE) ## greet: function () ## hair: blond## initialize: function (name = NA, hair = NA) ## name: Kate## set_hair: function (val)
kate$greet()kate$set_hair('red')kate
## Hello, my name is Kate.## <Person>## Public:## clone: function (deep = FALSE) ## greet: function () ## hair: red## initialize: function (name = NA, hair = NA) ## name: Kate## set_hair: function (val)
kate$hair
## [1] "red"
kate$hair
## [1] "red"
ann <- kateann$set_hair('blue')ann$hair
## [1] "blue"
kate$hair
## [1] "red"
ann <- kateann$set_hair('blue')ann$hair
## [1] "blue"
kate$hair
## [1] "blue"
remarkjs
framework through R package xaringan
.R.version
## _ ## platform x86_64-apple-darwin17.0 ## arch x86_64 ## os darwin17.0 ## system x86_64, darwin17.0 ## status ## major 4 ## minor 1.1 ## year 2021 ## month 08 ## day 10 ## svn rev 80725 ## language R ## version.string R version 4.1.1 (2021-08-10)## nickname Kick Things
Keyboard shortcuts
↑, ←, Pg Up, k | Go to previous slide |
↓, →, Pg Dn, Space, j | Go to next slide |
Home | Go to first slide |
End | Go to last slide |
Number + Return | Go to specific slide |
b / m / f | Toggle blackout / mirrored / fullscreen mode |
c | Clone slideshow |
p | Toggle presenter mode |
t | Restart the presentation timer |
?, h | Toggle this help |
Esc | Back to slideshow |