+ - 0:00:00
Notes for current slide
Notes for next slide

Object-Oriented Programming Models in R

RaukR 2022 • Advanced R for Bioinformatics

Marcin Kierczak

NBIS, SciLifeLab

RaukR 2022 • 1/32

OOP example

RaukR 2022 • 2/32

OOP example

RaukR 2022 • 3/32

OOP example

RaukR 2022 • 4/32

OOP example

RaukR 2022 • 5/32

OOP example

RaukR 2022 • 6/32

OOP example

RaukR 2022 • 7/32

OOP example

RaukR 2022 • 8/32

Object Oriented Programming

  • A programming paradigm.
  • We work with objects.
  • Reflects many real-life systems -- easy to model things.
  • Plato's cave (?): ideal objects -- classes, reflections -- instances.
RaukR 2022 • 9/32

Object Oriented Programming

  • A programming paradigm.
  • We work with objects.
  • Reflects many real-life systems -- easy to model things.
  • Plato's cave (?): ideal objects -- classes, reflections -- instances.

RaukR 2022 • 9/32

OOP Systems in R

  • 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)

RaukR 2022 • 10/32

S4 classes

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 constructor
my.intra1 <- .intragenic_region(name = 'int1',
coords = c(1.7e6, 1.717e6))
RaukR 2022 • 11/32

Inheritance in S4

.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
RaukR 2022 • 12/32

Sealed Class

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
RaukR 2022 • 13/32

S4 class -- slots

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 @ operator
my.gene@coords[2] # access the 2nd element in slot coords
## [1] "ANK3"
## [1] 1412000
RaukR 2022 • 14/32

S4 class -- methods

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 ]
RaukR 2022 • 15/32

S3 Classes

An S3 class object is one of R base types (e.g. integer) with class attribute set:

RaukR 2022 • 16/32

S3 Classes

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
RaukR 2022 • 16/32

S3 Classes

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
RaukR 2022 • 16/32

S3 Classes

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"
RaukR 2022 • 16/32

Custom str Methods

Some 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
RaukR 2022 • 17/32

Generic Methods and Method Dispatch

Have you ever wondered why print() or summary() work on many types (classes) of data?

RaukR 2022 • 18/32

Generic Methods and Method Dispatch

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
RaukR 2022 • 18/32

Creating S3 Classes

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"
RaukR 2022 • 19/32

Checking for Corectness

linmod <- with(mtcars, lm(log(mpg) ~ log(disp)))
linmod
##
## Call:
## lm(formula = log(mpg) ~ log(disp))
##
## Coefficients:
## (Intercept) log(disp)
## 5.3810 -0.4586
RaukR 2022 • 20/32

Checking for Corectness

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)
RaukR 2022 • 20/32

Checking for Corectness

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)

S C A R Y !

RaukR 2022 • 20/32

Software engineering

Margaret Hamilton, source: Wikimedia Commons

Margaret Hamilton, source: Wikimedia Commons

RaukR 2022 • 21/32

Software engineering

Margaret Hamilton, source: Wikimedia Commons

Margaret Hamilton, source: Wikimedia Commons

RaukR 2022 • 21/32

Design patterns

source: Wikimedia Commons

source: Wikimedia Commons

RaukR 2022 • 22/32

Design patterns

source: Wikimedia Commons

source: Wikimedia Commons

source: thecarpentryway.blog

source: thecarpentryway.blog

RaukR 2022 • 22/32

R and Design Pattern

  • strategyapply()
  • decoratorsystem_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
  • wrapper
my_plot <- function(...) {
plot(..., col = 'blue', las = 1, cex = .5, pch = 19, cex.axis = .7)
}
  • singleton see this gist
  • fluent function interfacetidyverse 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.

RaukR 2022 • 23/32

Constructor, Validator

  • Constructor
new_Animal <- function(species, age) {
stopifnot(is.character(species))
stopifnot(is.numeric(age))
structure(
species,
age = age,
class = "Animal"
)
}
  • Validator
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)
}
RaukR 2022 • 24/32

Helper

  • Helper
Animal <- function(x) {
species <- x[[1]]
age <- x[[2]]
validate_Animal(new_Animal(species, age))
}
RaukR 2022 • 25/32

Helper

  • Helper
Animal <- function(x) {
species <- x[[1]]
age <- x[[2]]
validate_Animal(new_Animal(species, age))
}
# Testing
dog <- Animal(list('Canis familiaris', 7))
class(dog)
## [1] "Animal"
RaukR 2022 • 25/32

Helper

  • Helper
Animal <- function(x) {
species <- x[[1]]
age <- x[[2]]
validate_Animal(new_Animal(species, age))
}
# Testing
dog <- 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"
RaukR 2022 • 25/32

Building S3 Classes -- Styles

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"
)
}
RaukR 2022 • 26/32

Introduction to R6 classes

  • require(R6),
  • do not rely on S4 like RC, but on S3,
  • are faster than RC,
  • do not do copy-on-modify,
  • thus provide OO model similar to C++ or Java.
  • methods belong to objects, not to generics.
RaukR 2022 • 27/32

R6 Class Example

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"))
}
)
)
RaukR 2022 • 28/32

R6 in Action

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)
RaukR 2022 • 29/32

R6 in Action

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)
RaukR 2022 • 29/32

R6 copy-on-modify

kate$hair
## [1] "red"
RaukR 2022 • 30/32

R6 copy-on-modify

kate$hair
## [1] "red"
ann <- kate
ann$set_hair('blue')
ann$hair
## [1] "blue"
RaukR 2022 • 30/32

R6 copy-on-modify

kate$hair
## [1] "red"
ann <- kate
ann$set_hair('blue')
ann$hair
## [1] "blue"
kate$hair
## [1] "blue"
RaukR 2022 • 30/32

Session

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
RaukR 2022 • 31/32

Thank you

RaukR 2022 • 32/32

OOP example

RaukR 2022 • 2/32
Paused

Help

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