Advanced R programming

Table of Contents

Base types

Basic information on base types: from simple to S4.

typeof( TRUE)
class( TRUE)

typeof( 2L)
class( 2L)

typeof( 2)
class( 2)

typeof( 2 + 2i)
class( 2 + 2i)

typeof( "fox")
class( "fox")

typeof( list( a = 123, b = "fox"))
class( list( a = 123, b = "fox"))

typeof( data.frame( id = 1:5, value = rnorm( 5)))
class( data.frame( id = 1:5, value = rnorm( 5)))

typeof( globalenv())
class( globalenv())

typeof( function(){})
class( function(){})

typeof( quote( x <- 3))
class( quote( x <- 3))

typeof( setClass( "test", slots = list( value = "numeric"))( value = 5))
class( setClass( "test", slots = list( value = "numeric"))( value = 5))

Basic information on functions

From an empty function to ... argument.

f1 <- function(){}
f1()

f2 <- function(){
  print( " Hello world!")
}

x <- f2()
x

f3 <- function( x){
  print( x)
 }

x <- f3( "This fox is brown")
x

f4 <- function( x, y){
  x^y
}

f4( 2, 4)

f5 <- function( x, y = 1){
  x^y
}

f5( 2, 4)
f5( 2)

f6 <- function( x, f, ...){
  plot( x, f( x), ...)
}

f6( seq( -pi, pi, length.out = 100), sin)

f6( seq( -pi, pi, length.out = 100),
   function( x){ sin(x^2) + cos( x^2)},
   type = "o", pch = 20, col = "red", fg = "magenta", main = "This is one crazy plot")

Environments

Construction

  • hashing table
  • pointer to a parent environment
symbol value
x 2
y function

Basic environments

Basic environments

  • empty
  • base
  • global

and respective functions

  • emptyenv()
  • baseenv()
  • globalenv()
  • environment()
emptyenv()
baseenv()
globalenv()
environment()

Environment tree and symbol visibility

Typical functions

  • search()
  • searchpaths()
  • parent.env()
search()
searchpaths()
library( dplyr)

x <- seq( 0, 1, length.out = 100)

base::plot( x, exp( x), type = "o", col = "blue", pch = 20)
plot( x, exp( x), type = "o", col = "blue", pch = 20)


parent.env( baseenv())

plot <- function( ...){
  print( "It's a different function")
}

rm( plot)

x <- ts( cumsum( rnorm( 5 * 24)), start = c( 2000, 1), frequency = 12)
x
plot( x)
stats::plot.ts( x, col = "blue", lwd = 2)
y <- tibble( x = rnorm( 100), y = 1 + 2 * x + rnorm( 100))
y
typeof( y)
plot( y)
graphics:::plot.data.frame( y, pch = 4)
listEnvs( list( environment( graphics:::plot.data.frame)))

Task Write a function searching through a search path (standard and recursive versions).

### Standard version
listEnvs <- function( ret = list( globalenv())){
  while( !identical( emptyenv(), ret[[length( ret)]])){
    ret <- c( ret, parent.env( ret[[ length( ret)]]))
  }
  ret
}

test <- listEnvs()
test

listEnvs( list( baseenv()))


### Recursive version
listEnvs2 <- function( ret = list( globalenv())){
  ## stop condition
  if( identical( emptyenv(), last( ret))){
  return( ret)
  }
  ret <- c( ret, parent.env( last( ret)))
  listEnvs2( ret)
}

listEnvs2()

Searching for symbols

Typical functions

  • where()
  • exists()
library( pryr)

exists( "plot", inherits = FALSE)
exists( "plot", inherits = FALSE, envir = baseenv())
ls( envir = baseenv())
ls( envir = baseenv(), all.names = TRUE)
ls()
ls( all.names = TRUE)

.x <- 321
ls( all.names = TRUE)
.x + 2
.x

e <- where( "plot.ts")
where( "plot.ts", env = e)

Task Write a function searching for a symbol. The function should check for a base type of a symbol and return all occurrences of a symbol (also the overshadowed ones). Write the standard and recursive version.

### Standard versrion
findSymbol <- function( s, e = list( globalenv()), bt){
  ret <- list()
  while( !identical( emptyenv(), last( e))){
    if( exists( s, inherits = FALSE, envir = last( e))){
      if( identical( typeof( get( s, envir = last( e))), bt)){
	ret <- c( ret, last( e))
      }
    }
    e <- c( e, parent.env( last( e)))
  }
  ret
}

findSymbol( "plot", bt = "integer")
findSymbol( "plot", bt = "closure")

Working with environments

  • Creating new.env(), attr() for the attribute name
  • Removing rm(), gc(), gcinfo()
  • Adding elements quote(), eval(), $, assign()
  • Listing and getting elements ls, $, get()
  • Copying and cloning environments as.environment(), as.list()
### Cleaning
rm(list = ls())

### Creating envs
e <- new.env()
e
typeof( e)
parent.env( e)

### Removing envs
ls()
rm( e)
ls()
gc()
gcinfo(verbose = TRUE)
for( j in 1:20){
  x <- rnorm( 10^5)
}
gcinfo(verbose = FALSE)

### Creating trees
e0 <- new.env( parent = emptyenv())
parent.env( e0)
e1 <- new.env( parent = e0)
parent.env( e1)
e0
parent.env( parent.env( e1))
parent.env( baseenv())

e0
attr( e0, "name") <- "myNewEnv"
e0
attr( e1, "name") <- "mySecondEnv"
e0
e1

### Cleaning
rm(list = ls())

### Creating env
e <- new.env()
attr(e, "name") <- "myEnv"
e
parent.env( e)

### Adding elements
a <- list()
a
a <- c(a, list(value =10))
a
a$value
a$id <- 1
a

e$x <- TRUE
e$x
x

assign(x = "y", value = FALSE, envir = e)
e$y
y

eval(quote( x <- FALSE), envir = e)
e$x

ee <- new.env(parent = emptyenv())
attr(ee, "name") <- "evilEnv"
ee

ee$x <- "ok"
ee$x
assign(x = "y", value = "not ok", envir = ee)
ee$y
eval(quote( x <- "awesome"), envir = ee)

x <- 2
x
`<-`(x, 9)
x
`<-`

### Cleaning
rm(list = ls())

### Listing
ls(envir = globalenv())
ls(envir = globalenv(), all.names = TRUE)
ls(envir = baseenv())
ls(envir = baseenv(), all.names = TRUE)

### Getting from envs
base::plot()
graphics:::plot.data.frame()

e <- new.env()
attr( e, "name") <- "myEnv"
e

e$x <- TRUE
e$x
get(x = "x", envir = e)
e[["x"]]
e["x"]
e[[1]]
e[["y"]] <- FALSE
e$y

### Cleaning
rm(list = ls())

### Copying envs
e <- new.env()
e$x <- 123

ee <- e
ee$x
ee$x <- 321
ee$x
e$x

n <- 10^4
e$x <- data.frame( id = 1:n, value = rnorm( n))
x
head( e$x)
object.size( e$x)
object.size( e)
e$x <- 123

eee <- as.environment( as.list( e))
eee
e$x
eee$x
eee$x <- 456
eee$x
e$x

parent.env( eee)
parent.env( eee) <- globalenv()
parent.env( eee)

as.environment( search()[4])

Task Write two functions. The goal of each function is to take a vector of numbers, generate a random number, append it to the vector and return a vector. The first function should accept a vector as an argument, the second should accept an environment as an argument. Evaluate a for loop implementing \( n \)-fold of the function for each function. Check evaluation times and explain the difference.

### Cleaning
rm(list = ls())

### Creating env
e <- new.env(parent = emptyenv())
e$x <- 123

### Function
f <- function( e){
  e$x <- rnorm(1)
}

e$x
f( e)
e$x

  • Simple search path manipulation attach(), detach()
### Cleaning
rm(list = ls())

search()
attach( list( os = "linux"), name = "os")
search() 
detach(name = "os")
search() 

Task Write a function that remembers how many times it's been called. The function should provide means of resetting the counter and should not leave any junk behind.

### Cleaning
rm(list = ls())

f <- function(){
  if(!exists( "x")){
    x <- 0
  }
  x <- x + 1
  x
}

f()

remember <- function( reset = FALSE){
  if( !("remember" %in% search()) ){
    attach( list( rememberCounter = 0), name = "remember", pos = 2)
  }
  e <- as.environment( "remember")
  e$rememberCounter <- e$rememberCounter + 1
  print( e$rememberCounter)
  if( reset){
    detach( name = "remember")
  }
}


remember()
remember( reset = TRUE)
search()

Functions

Construction

  • base type
  • formals (arguments) formals()
  • body body()
  • closure environment()
f <- function(){}
class( f)
typeof( f)
f()

formals( f) <- alist( x = 0) 
f

typeof( body( f))
body( f) <-  quote( print( x^2))
f
f( 2)

environment( f)

Environments realted to a function, static scoping. Applications and typical problems.

  • execution environment
  • enclosing environment environment()
  • binding environment
  • calling environment parent.frame()

Example Checking for execution environment and its parent. Checking for enclosing environment. What is static scoping and how does it work?

rm(list = ls())

f <- function(){
  e <- environment()
  list( exe = e, parent = parent.env( e))
}

f()

e <- new.env()
eval( quote( f <- function(){
  e <- environment()
  list( exe = e, parent = parent.env( e))
}
), envir = e)

f()
e$f()
e

e$x <- "brown fox"
g <- function(){
  print( x)
}
x
g()
environment( g)
environment( g) <- e
environment( g)
e
g()

Example Defining symbols from within a function in an enclosing environment with $ and quote() / eval() combo.

rm(list = ls())

f <- function(){
  e <- parent.env( environment())
  e$x <- "from a function with love"
}

x
f()
x

g <- function(){
  e <- parent.env( environment())
  eval( quote( x <- "another stuff"), envir = e)
}

x
g()
x

e <- new.env( parent = emptyenv())

environment( g) <- e
g()

### More subtle example
rm(list = ls())

f1 <- function(){
  e <- parent.env( environment())
  x <- 10
  e$x <- x^2
}

x
f1()
x

f2 <- function(){
  e <- parent.env( environment())
  x <- 10
  eval( quote( x <- x^2), envir = e)
}

x
f2()
x

Example Functions defining symbols in a given environments with given values.

rm(list = ls())

define <- function( sym, val, env = globalenv()){
  env[[sym]] <- val
}

define <- function( sym, val, env = globalenv()){
  assign( x = sym, value = val, envir = env)
}


ls()
define( "x", FALSE)
x

define( "x", rnorm(4))
x

e <- new.env()
define( "x", rnorm(1), env = e)
x
e$x

Example Functions taking and returning environments (introduction to R6 object model), environment as a data structure.

rm(list = ls())

graph <- function( vertices, edges){
  e <- new.env( parent = globalenv())
  e$vertices <- vertices
  e$edges <- edges
  e$getVertices <- function(){ vertices}
  environment( e$getVertices) <- e
  e
}

v <- 1:10
e <- cbind( sample( v, 5), sample( v, 5))
e

g1 <- graph( vertices = v, edges = e)
g1
g1$vertices
g1$edges
g1$getVertices()

g1$vertices <- 1:5
g1$getVertices()

Example Function factories and retrospective redefinitions in execution environment.

rm(list = ls())

f <- function(){
  if ( !exists( "x", inherits = FALSE)){
    x <- 0
  }
  x <- x + 1
  x
}

f()

makeFun <- function( x){
  function( y){ x + y}
}

g2 <- makeFun( 2)
formals( g2)
body( g2)
g2( 2)
environment( g2)$x <- 100
g2( 2)

### use enclosing as the holder for private vars.
createFun <- function(){
  counter <- 0
  function(){
    e <- parent.env( environment())
    print( counter)
    e$counter <- counter + 1
  }
}

f <- createFun()
f()
ls()
search()

Example Changing enclosing environment and checking for calling environment with parent.frame().

rm(list = ls())

f <- function(){
  list(
    enclosing = parent.env( environment()),
    calling = parent.frame()
  )
}

f()

g <- function(){
  f()
}

g()

e <- new.env()
attr( e, "name") <- "myEnv"
e

environment( f) <- e

f()

g()

Example What is <<- function? A function returning execution, enclosing and calling environments.

rm(list = ls())

ls()

f <- function(){
  x <<- 123
}

f()
ls()
x

environment( f)

e <- new.env()
attr( e, "name") <- "myEnv"

e

environment( f) <- e

rm( x)
x

f()
x

g <- function(){
  list(
    exe = environment(),
    encl = parent.env( environment()),
    calling = parent.frame()
  )
}

g()
environment( g) <- e
g()

Example Data bleeding and pseudo-dynamic scoping.

rm(list = ls())

f <- function(){
  print( x)
}

f()
x <- "global env"
f()

g <- function(){
  x <- "local env"
  f()
}

g()

fds <- function(){
  e <- parent.frame()
  x <- get( "x", envir = e)
  print( x)
}

g <- function(){
  x <- "local env"
  fds()
}

x
g()

g <- function(){
  ## x <- "local env"
  fds()
}

g()

Example Recursion with environements.

rm(list = ls())

f <- function( n){
  if( n == 0) return( 1)
  n * f( n - 1)
}

f( 0)
f( 1)
f( 2)
f( 3)

Object models

Introduction

  • S3
  • S4
  • R5 (RC)
  • R6

S3 object model

  • No class definition
  • Based on a system of generics
  • Generics dispatch methods based on first argument class

Typical functions

  • is.object(), isS4(), is.R6(), otype()
  • ftype() + code
  • methods()
  • attributes(), attr(), structure()
  • UseMethod()

Example Intruduction: various S3 classes.

rm(list = ls())

x <- cumsum( rnorm( 10))
x

typeof( x)
mode( x)
class( x)

y <- ts( cumsum( rnorm( 5 *12)), frequency = 12, start = c( 2001, 1))
y
typeof( y)
mode( y)
class( y)

data( cars)
head( cars)
str( cars)
typeof( cars)
mode( cars)
class( cars)

z <- lm( dist ~ +1 +speed, data = cars)
z
typeof( z)
mode( z)
class( z)

Example Testing for S3 class.

rm(list = ls())

d <- data.frame( id = 1:5, value = rnorm( 5))
d

dd <- as.list( d)
dd

attributes( d)
is.object( d)
is.object( dd)

ddd <- setClass( Class = "test",
	      slots = list( value = "numeric"))( value = 5)

d
isS4( d)
isS4( dd)
isS4( ddd)

library( pryr)
library( dplyr)
otype( d)
otype( dd)
otype( ddd)

Example Defining a simple S3 class.

rm(list = ls())

d <- data.frame( id = 1:5, value = rnorm( 5))
d

attributes( d)
attr( d, "class") <- NULL
attr( d, "row.names") <- NULL
d

attr( d, "class") <- "data.frame"
attr( d, "row.names") <- 1:5
class( d)

plot( d)
print.data.frame( d)
print.default( d)
d

dataframeInfo <- function( info, ...){
  ret <- data.frame( ...)
  structure( ret, "class" = "dataframeInfo", "info" = info)
}

o1 <- dataframeInfo( info = "Data from experiment 1", id = 1:5, value = rnorm( 5))
class( o1)
otype( o1)
o1

Example Testing for S3 generic.

Example Methods in S3 object model. Binding with existing generics.

Example Methods in S3 object model. Creating new generics and binding methods.

Example Inheritance.

Example Implementing undirected graph as an S3 class.

S4 object model

R5 object model (RC)

R6 object model

Date: 2021-02-21 Sun 00:00

Author: Michał Ramsza

Created: 2021-03-24 Wed 17:32

Validate