Questions
General question
How would you go about starting to implement the PicoContainer-Framework in R?
Specific question
How would the "pico registry (mechanism)" actually look like? I came up with a "poor man's version" that only works for a single registration process (see class DefaultPicoContainer in the example below; at this point method getComponentInstance() doesn't actually make use of the information getRefClass("MovieLister") to find registered components)
Example
AFAIU, there aren't any implementations of the PicoContainer-Framework in R yet, so I thought about how this might look like.
This is what I could come up with so far. It's inspired by Martin Fowler's article on dependency injection.
1. Example for Business Logic Layer
Interface (class) MovieFinder
setRefClass(
Class="MovieFinder",
contains=c("VIRTUAL"),
methods=list(
findAll=function() {}
)
)
Class MovieLister
setRefClass(
Class="MovieLister",
fields=list(
finder="MovieFinder"
),
methods=list(
initialize=function(finder=NULL) {
callSuper(finder=finder)
},
moviesDirectedBy=function(arg) {
allMovies <- finder$findAll()
out <- lapply(seq(along=nrow(allMovies)), function(ii) {
movie <- allMovies[ii,]
out <- movie
if (movie$director != arg) {
out <- NULL
}
return(out)
})
out
}
)
)
Class ColonMovieFinder
setRefClass(
Class="ColonMovieFinder",
contains=c("MovieFinder"), ## Implements the 'MovieFinder' interface
fields=list(
filename="character"
),
methods=list(
initialize=function(filename) {
callSuper(filename=filename)
},
findAll=function() {
read.table(.self$filename)
}
)
)
2. Adaption of Pico Container Framework in R
Class ConstantParameter
setRefClass(
Class="ConstantParameter",
fields=list(
para="ANY"
),
methods=list(
initialize=function(para) {
callSuper(para=para)
}
)
)
Class DefaultPicoContainer
setRefClass(
Class="DefaultPicoContainer",
fields=list(
.class="refObjectGenerator",
.dependency="list"
),
methods=list(
registerComponentImplementation=function(...) {
x <- list(...)
if (length(x) == 1) {
.self$.class <- x[[1]]
} else {
.self$.dependency <- x
}
TRUE
},
getComponentInstance=function(classobj) {
deps <- rev(.self$.dependency)
inst <- NULL
for (ii in 1:length(deps)) {
inst.args <- NULL
if (ii == 1) {
inst.args <- lapply(deps[[ii]], "[[", "para")
inst.gen <- deps[[ii + 1]]
inst <- do.call(inst.gen$new, args=inst.args)
} else if (ii < length(deps)){
inst.gen <- deps[[ii + 1]]
if (!isVirtualClass(Class=inst.gen$className)) {
inst <- do.call(inst.gen$new, args=list(inst))
}
}
}
inst
}
)
)
Function configurecontainer
configureContainer <- function() {
pico <- new("DefaultPicoContainer")
finderParams <- list(
new("ConstantParameter", "movies1.txt")
)
pico$registerComponentImplementation(
getRefClass("MovieFinder"),
getRefClass("ColonMovieFinder"),
finderParams
)
pico$registerComponentImplementation(
getRefClass("MovieLister")
)
return(pico)
}
3. Testing
I used a unit test even though I know that this test actually exceeds the scope of a pure unit test.
require("testthat")
test_that(desc="test_testWithPico",
code={
## Example 'movies1.txt' file //
movies <- data.frame(
movie=c("A", "B", "C"),
director=c("Director 1", "Director 2", "Director 3")
)
write.table(x=movies, file="movies1.txt", sep="")
## Create new pre-configured pico container //
pico <- configureContainer()
## Use pico container in Business Logic Layer //
lister <- new("MovieLister",
finder=pico$getComponentInstance(getRefClass("MovieLister"))
)
movies <- lister$moviesDirectedBy("Director 1")
## Assert //
target <- list(data.frame(movie="A", director="Director 1"))
expect_that(
movies,
is_equivalent_to(target)
)
}
)
Background
I'm starting to get fascinated by the SOLID principles of Object-Oriented Design, especially by the concepts/principles Inversion of Dependency and Dependency Injection, and would like to start following them in my R programs.
Any pointers to how these principles might best be followed in R are greatly appreciated
