Purpose

This is a short illustration of

It borrows from the SOLID principles of object-oriented design as well as from concepts of dependency injection frameworks such as Autofac or Spring

Design without inversion of dependency

Class definitions

library(R6)
TestC <- R6Class(
  classname = "TestC",
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    baz = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = sample(c(TRUE, FALSE), 5, TRUE), 
    main = letters)
)

TestB <- R6Class(
  classname = "TestB",
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    bar = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = 1:5, main = TestC$new())
)

TestA <- R6Class(
  classname = "TestA",
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    foo = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = letters[1:5], main = TestB$new())
)

Instantiation

inst_a <- TestA$new()
inst_a$getMain()
#> <TestB>
#>   Public:
#>     bar: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: environment
#>     x: 1 2 3 4 5
inst_a$foo(3)
#> [1] "a" "b" "c"

inst_b <- TestB$new()
inst_b$getMain()
#> <TestC>
#>   Public:
#>     baz: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: a b c d e f g h i j k l m n o p q r s t u v w x y z
#>     x: FALSE FALSE FALSE FALSE TRUE
inst_b$bar(3)
#> [1] 1 2 3

inst_c <- TestC$new()
inst_c$getMain()
#>  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q"
#> [18] "r" "s" "t" "u" "v" "w" "x" "y" "z"
inst_c$baz(3)
#> [1] FALSE FALSE FALSE

Notice that

This violates the D of the SOLID principles of object-oriented design as it leads to tight coupling of code components.

We can overcome this by also using the respective interfaces in the classes’ fields as this results in inversion of dependency.

Design with inversion of dependency

Interface classes

These classes, allthough not being abstract, mimick interfaces (or abstract classes).

Their only job is to define abstract methods that concrete classes implementing the respective interface need to actually implement.

That’s the reason for the stop("I'm an abstract interface method") part. These methods should never actually be called, but they define “what the interface can do”.

IGeneral <- R6Class(
  classname = "IGeneral",
  portable = TRUE,
  public = list(
    getCounter = function() stop("I'm an abstract interface method"),
    setCounter = function(value) stop("I'm an abstract interface method"),
    getMain = function() stop("I'm an abstract interface method"),
    setMain = function(value) stop("I'm an abstract interface method")
  )
)

ITestA <- R6Class(
  classname = "ITestA",
  inherit = IGeneral,
  portable = TRUE,
  public = list(
    foo = function(n = 1) stop("I'm an abstract interface method")
  )
)

ITestB <- R6Class(
  classname = "ITestB",
  inherit = IGeneral,
  portable = TRUE,
  public = list(
    bar = function(n = 1) stop("I'm an abstract interface method")
  )
)

ITestC <- R6Class(
  classname = "ITestC",
  inherit = IGeneral,
  portable = TRUE,
  public = list(
    baz = function(n = 1) stop("I'm an abstract interface method")
  )
)

Concrete classes

Notice that we substituted any statements of concrete classes with statements to the respective interface that should be used - no matter of how exactly they are/will be implemented (e.g. ITestC$new() instead of TestC$new())

TestC <- R6Class(
  classname = "TestC",
  inherit = ITestC,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    baz = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = sample(c(TRUE, FALSE), 5, TRUE),
    main = letters)
)

TestB <- R6Class(
  classname = "TestB",
  inherit = ITestB,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    bar = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = 1:5, main = ITestC$new())
)

TestA <- R6Class(
  classname = "TestA",
  inherit = ITestA,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    foo = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = letters[1:5], main = ITestB$new())
)

Even though we are using actual instances of interface classes (that’s the part that is a bit off with regard to how it’s done in other programming languages which do not allow this), we’ve made sure that these instances can’t really do anything useful.

For our purposes, that’s a good thing: we want nothing more than to inform the class containing fields with interface instances in them:

“Hey, the object in your field here has an interface xy and it lets you call methods x, y and z. How actual objects that implement this interface look like is none of your business.”

That’s why something like this will and should fail:

inst <- ITestA$new()
print(try(inst$foo()))
#> [1] "Error in inst$foo() : I'm an abstract interface method\n"
#> attr(,"class")
#> [1] "try-error"
#> attr(,"condition")
#> <simpleError in inst$foo(): I'm an abstract interface method>

Manual dependency injection

As our concrete classes now depend on interfaces instead of concrete classes, we are free to choose any implementation of those interface “at runtime” without changing the class that holds the dependencies.

We simply need to make sure that instances of those implementations are injected to the right places (i.e. to the respective fields of instances of our concrete classes in our case).

For example, we could define alternative implementations for TestB and TestC:

TestB2 <- R6Class(
  classname = "TestB2",
  inherit = ITestB,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    bar = function(n = 1) private$x[n, 1, drop = FALSE]
  ),
  private = list(counter = 0, x = data.frame(x = 1:5), main = ITestC$new())
)

TestC2 <- R6Class(
  classname = "TestC2",
  inherit = ITestC,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$main,
    setMain = function(value) private$main <- value,
    baz = function(n = 1) private$x[n, 1, drop = FALSE]
  ),
  private = list(counter = 0, 
    x = data.frame(x = sample(c(TRUE, FALSE), 5, TRUE)), main = letters)
)

And then inject whatever alternative we see fit:

## Class TestA
inst_a <- TestA$new()
inst_a$setMain(TestB$new())
## --> inject instance of `TestB`
inst_a$getMain()
#> <TestB>
#>   Implements interface: <ITestB>
#>   Implements interface: <IGeneral>
#>   Public:
#>     bar: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: environment
#>     x: 1 2 3 4 5
inst_a$getMain()$bar(3)
#> [1] 1 2 3

inst_a$setMain(TestB2$new())
## --> inject instance of `TestB2`
inst_a$getMain()
#> <TestB2>
#>   Implements interface: <ITestB>
#>   Implements interface: <IGeneral>
#>   Public:
#>     bar: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: environment
#>     x: data.frame
inst_a$getMain()$bar(3)
#>   x
#> 3 3

## Class TestB
inst_b <- TestB$new()
inst_b$setMain(TestC$new())
## --> inject instance of `TestC`
inst_b$getMain()
#> <TestC>
#>   Implements interface: <ITestC>
#>   Implements interface: <IGeneral>
#>   Public:
#>     baz: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: a b c d e f g h i j k l m n o p q r s t u v w x y z
#>     x: FALSE FALSE TRUE TRUE FALSE
inst_b$getMain()$baz(3)
#> [1] FALSE FALSE  TRUE

inst_b$setMain(TestC2$new())
## --> inject instance of `TestC2`
inst_b$getMain()
#> <TestC2>
#>   Implements interface: <ITestC>
#>   Implements interface: <IGeneral>
#>   Public:
#>     baz: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: a b c d e f g h i j k l m n o p q r s t u v w x y z
#>     x: data.frame
inst_b$getMain()$baz(3)
#>      x
#> 3 TRUE

Automatic dependency injection

We could leverage the concept of dependency injection by making sure that generator objects of interface classes are automatically substituted with generator objects of the actual concrete classes we would like to use at runtime.

The following code outlines a very basic implementation of how one could do this. Of course, there are much more elaborate ways and this implementation is by no means comprehensive!

Register classes

Function definitions

registerType <- function(name, as, inst = NULL, singleton = FALSE,
  overwrite = FALSE, strict = 3, repo = getOption("solidr.repo")) {
  gen <- get(name)
  ## TODO: inherits = TRUE/FALSE? Some other restrictions necessary
  ## (e.g. `as.environment("package:xyz")`)?

  if (!exists(as, envir = repo, inherits = FALSE) || overwrite) {
    if (!singleton) {
      assign(as, gen, repo)
    } else {

      if (is.null(inst)) {
        attributes(gen)$singleton <- TRUE
        assign(as, gen, repo)
      } else {
        attributes(inst)$singleton <- TRUE
        assign(as, inst, repo)
      }
    }
  } else {
    if (strict == 3) {
      stop(sprintf("Already registered: %s as %s",
        get(as, repo)$classname, as))
    }
  }
}

handleOndemandSingletonRegistration <- function(
  name,
  gen,
  inst,
  repo = getOption("solidr.repo")
) {
  if (!is.null(attributes(gen)$singleton)) {
    registerType(name = gen$classname, as = name, inst = inst,
      singleton = TRUE, overwrite = TRUE, repo = repo)
  }
}

Actual registering:

options("solidr.repo" = new.env())

## Register concrete class/implementation `TestA` as interface `ITestA`
registerType("TestA", "ITestA")

## Register concrete class/implementation `TestA` as interface `ITestA`
registerType("TestB", "ITestB")

## Register concrete class/implementation `TestA` as interface `ITestA`
registerType("TestC", "ITestC")

## Investigate repo state
repo <- getOption("solidr.repo")
ls(repo)
#> [1] "ITestA" "ITestB" "ITestC"
repo$ITestA$new()$getMain()
#> <ITestB>
#>   Implements interface: <ITestB>
#>   Implements interface: <IGeneral>
#>   Public:
#>     bar: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value)
repo$ITestB$new()$getMain()
#> <ITestC>
#>   Implements interface: <ITestC>
#>   Implements interface: <IGeneral>
#>   Public:
#>     baz: function (n = 1) 
#>     clone: function (deep = FALSE) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value)
repo$ITestC$new()$getMain()
#>  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q"
#> [18] "r" "s" "t" "u" "v" "w" "x" "y" "z"

Resolve class instances

Function definitions:

resolveType <- function(name, repo = getOption("solidr.repo")) {
  gen <- repo[[name]]

  if (!is.null(gen)) {
    res <- if (inherits(gen, "R6ClassGenerator")) {
      gen <- resolveTypeInner(gen, "public_fields", repo)
      gen <- resolveTypeInner(gen, "private_fields", repo)
      res <- gen$new()

      ## Register singleton if is any //
      handleOndemandSingletonRegistration(name = name, gen = gen,
        inst = res, repo = repo)

      res
    } else {
      gen
    }
    res
  } else {
    NULL
  }
}

resolveTypeInner <- function(gen, what, repo) {
  x <- gen[[what]]
  for (field in 1:length(x)) {
    value <- x[[field]]
    cls <- class(value)
    if (inherits(value, "R6")) {
      if (!is.null(this <- resolveType(name = cls[1], repo = repo))) {
        gen[[what]][[field]] <- this
      }
    }
  }
  gen
}

Actual resolve:

## Registered implementation of interface `ITestA`
inst_a <- resolveType("ITestA")
class(inst_a$getMain())
#> [1] "TestB"    "ITestB"   "IGeneral" "R6"
inst_a$getMain()$bar(3)
#> [1] 1 2 3

## Registered implementation of interface `ITestB`
inst_b <- resolveType("ITestB")
class(inst_b$getMain())
#> [1] "TestC"    "ITestC"   "IGeneral" "R6"
inst_b$getMain()$baz(3)
#> [1] FALSE FALSE  TRUE

## Registered implementation of interface `ITestC`
inst_c <- resolveType("ITestC")
class(inst_c$getMain())
#> [1] "character"

Singletons

Sometimes you want to define singletons, i.e. instances that have a longer life cycle than transient objects (default type when registering classes in the repository):

Register singletons:

options("solidr.repo" = new.env())

registerType("TestA", "ITestA", singleton = TRUE)
registerType("TestB", "ITestB")
registerType("TestC", "ITestC")

repo <- getOption("solidr.repo")
attributes(repo$ITestA)
#> $name
#> [1] "TestA_generator"
#> 
#> $class
#> [1] "R6ClassGenerator"
#> 
#> $singleton
#> [1] TRUE
## --> note that this class instance is denoted as being a singleton

Implications upon resolve:

While instances of transient (i.e. non-singleton) classes that where registered for an interface are constructed on demand, singletons are constructed/instantiated only once and then cached.

This means, that everytime a singleton is resolved from the repo, classes working with it see that same object.

This becomes best clear in a little example:

inst_a <- resolveType("ITestA")
inst_c <- resolveType("ITestC")

## Transient instances //
inst_c$getCounter()
#> [1] 0
inst_c$setCounter(1)
inst_c$getCounter()
#> [1] 1
inst_c <- resolveType("ITestC")
inst_c$getCounter()
#> [1] 0
## --> "new resolve" means "new instation"

## Singleton instances //
inst_a$getCounter()
#> [1] 0
inst_a$setCounter(1)
inst_a$getCounter()
#> [1] 1
inst_a <- resolveType("ITestA")
inst_a$getCounter()
#> [1] 1
## --> "new resolve" does NOT mean "new instation"

Design with interfaces and concrete base classes

If we would agree that some sort of mimicking interface classes makes sense, we run into a little problem with respect to inheritance:

as our concrete classes already inherit from an interface class, we can’t define any other inheritance even though it might be desirable (e.g. for inheriting from base classes). We’ve sort of already “used up” our value for inherit in our call to R6::R6Class.

I therefore tweaked R6 a bit so it would allow us to state that

Disclaimer

This is totally experimental stuff and it is still completely unclear if the author of R6 favors such a distinction/feature!

Base classes

This is an example for a base classes that concrete classes can inherit from in order to simplify the overall design of your software architecture.

In this particular case, BaseClass simply spares us the fact that we need to implement methods getCounter, setCounter and foo for each of the other concrete classes below (TestA, TestB, TestC).

BaseClass <- R6Class(
  classname = "BaseClass",
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    setCounter = function(value) private$counter <- value,
    getMain = function() private$counter,
    setMain = function(value) private$counter <- value
  )
)

Tweaked version of R6::R6Class

In order to test it out, you would currently need to install my forked version of R6

devtools::install_github("rappster/R6", ref = "feat_interface")
#> Downloading GitHub repo rappster/R6@feat_interface
#> Installing R6
#> "C:/PROGRA~1/R/R-32~1.3/bin/x64/R" --no-site-file --no-environ --no-save  \
#>   --no-restore CMD INSTALL  \
#>   "C:/Users/Thyson/AppData/Local/Temp/RtmpAhLdrw/devtools28186a567b68/rappster-R6-f61cb17"  \
#>   --library="C:/Program Files/R/R-3.2.3/library" --install-tests
#> 
#> Reloading installed R6
#> unloadNamespace("R6") not successful. Forcing unload.
library(R6)

Actual class definitions:

TestC <- R6Class(
  classname = "TestC",
  implement = ITestC,
  inherit = BaseClass,
  portable = TRUE,
  public = list(
    baz = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = sample(c(TRUE, FALSE), 5, TRUE),
    main = letters)
)

TestB <- R6Class(
  classname = "TestB",
  implement = ITestB,
  inherit = BaseClass,
  portable = TRUE,
  public = list(
    bar = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = 1:5, main = ITestC$new())
)

TestA <- R6Class(
  classname = "TestA",
  implement = ITestA,
  inherit = BaseClass,
  portable = TRUE,
  public = list(
    foo = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = letters[1:5], main = ITestB$new())
)

Test drive

TestA$new()
#> <TestA>
#>   Implements interface: <ITestA>
#>   Inherits from: <BaseClass>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     foo: function (n = 1) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: environment
#>     x: a b c d e

Note the distinction:

R6::R6Class would complain in case a class does not implement an interface completely.

Here’s an example where only the getter methods, but not the setter methods were implemented:

Foo <- R6Class(
  classname = "Foo",
  implement = ITestA,
  portable = TRUE,
  public = list(
    getCounter = function() private$counter,
    getMain = function() private$main,
    foo = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = letters[1:5], main = NA)
)
print(try(Foo$new()))
#> [1] "Error in Foo$new() : \n\nNon-implemented interface method: setCounter\nNon-implemented interface method: setMain\n"
#> attr(,"class")
#> [1] "try-error"
#> attr(,"condition")
#> <simpleError in Foo$new(): 
#> 
#> Non-implemented interface method: setCounter
#> Non-implemented interface method: setMain>

Once we bring BaseClass back into the game, everything is fine again as BaseClass does implement the methods that we happened to forget in the definition of Foo above:

Foo <- R6Class(
  classname = "Foo",
  implement = ITestA,
  inherit = BaseClass,
  portable = TRUE,
  public = list(
    foo = function(n = 1) private$x[1:n]
  ),
  private = list(counter = 0, x = letters[1:5], main = ITestB$new())
)
Foo$new()
#> <Foo>
#>   Implements interface: <ITestA>
#>   Inherits from: <BaseClass>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     foo: function (n = 1) 
#>     getCounter: function () 
#>     getMain: function () 
#>     setCounter: function (value) 
#>     setMain: function (value) 
#>   Private:
#>     counter: 0
#>     main: environment
#>     x: a b c d e