依赖注入：如何在R中使用/实现PicoContainer Framework

Question

问题

一般问题

您将如何开始实施R中的PicoContainer-Framework

具体问题

“pico注册表（机制）”实际上会是什么样子？我提出了一个“穷人的版本”，它仅适用于单个注册过程（请参阅下面示例中的类DefaultPicoContainer;此时方法getComponentInstance()实际上并未使用这些信息{ {1}}查找已注册的组件）

---

实施例

AFAIU，R中没有PicoContainer-Framework的任何实现，所以我想到了它的外观。

到目前为止，这是我能想到的。它受到Martin Fowler's article关于依赖注入的启发。

1。 业务逻辑层

的示例

界面（类）getRefClass("MovieLister")

MovieFinder

班级setRefClass( Class="MovieFinder", contains=c("VIRTUAL"), methods=list( findAll=function() {} ) )

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

ColonMovieFinder

2。 R

中Pico容器框架的适应性

班级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) } ) )

ConstantParameter

班级setRefClass( Class="ConstantParameter", fields=list( para="ANY" ), methods=list( initialize=function(para) { callSuper(para=para) } ) )

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

configurecontainer

3。测试

我使用了单元测试，尽管我知道这个测试实际上超出了纯单元测试的范围。

configureContainer <- function() {
    pico <- new("DefaultPicoContainer")
    finderParams <- list(
        new("ConstantParameter", "movies1.txt")
    )

    pico$registerComponentImplementation(
        getRefClass("MovieFinder"),
        getRefClass("ColonMovieFinder"),
        finderParams
    )
    pico$registerComponentImplementation(
        getRefClass("MovieLister")
    )
    return(pico)
}

---

背景

我开始对面向对象设计的SOLID原则着迷，特别是概念/原则Inversion of Dependency和Dependency Injection，并希望开始关注它们我的R计划。

非常感谢任何有关如何在R中遵循这些原则的指示

Answer 1

到目前为止，这是我对特定问题的最佳看法：

班级DefaultPicoContainer

setRefClass(
    Class="DefaultPicoContainer",
    fields=list(
        .registry="environment",
        .buffer="environment"
    ),
    methods=list(
        registerComponentImplementation=function(...) {
            x <- list(...)
            if (length(x) > 1 & length(.self$.buffer)) {
                env <- new.env(parent=emptyenv())
                env$deps <- x
                .self$.buffer <- env 
            } else {
                ## Push to registry //
                assign(x[[1]], .self$.buffer$deps, envir=.self$.registry)
                ## Clean buffer //
                rm(list="deps", envir=.self$.buffer)
            }           
            TRUE
        },
        getComponentInstance=function(
            name
        ) {
            if (!exists(x=name, envir=.self$.registry)) {
                stop(paste0("No dependencies registered for class '", name, "'"))
            }
            deps <- rev(get(name, envir=.self$.registry))
            inst.0 <- NULL
            for (ii in 1:length(deps)) {
                inst.args <- NULL
                if (ii == 1) {
                    inst.args   <- lapply(deps[[ii]], "[[", "para")
                    inst.class  <- deps[[ii + 1]]
                    if (!isClass(inst.class)) {
                        stop(paste0("Not a class: '", inst.class, "'"))
                    }
                    inst.gen    <- getRefClass(inst.class)
                    inst.0      <- do.call(inst.gen$new, args=inst.args)
                } else if (ii < length(deps)){
                    inst.class  <- deps[[ii + 1]]
                    if (!isClass(inst.class)) {
                        stop(paste0("Not a class: '", inst.class, "'"))
                    }
                    inst.gen    <- getRefClass(inst.class)
                    if (!isVirtualClass(Class=inst.gen$className)) {
                        inst.0 <- do.call(inst.gen$new, args=list(inst.0))
                    }
                }
            }
            inst.0
        }
    )
)

功能configureContainer

configureContainer <- function() {
    pico <- new("DefaultPicoContainer2")
    finderParams <- list(
        new("ConstantParameter", "movies1.txt")
    )

    pico$registerComponentImplementation(
        MovieFinder="MovieFinder",
        ColonMovieFinder="ColonMovieFinder",
        finderParams
    )
    pico$registerComponentImplementation("MovieLister")
    return(pico)
}

测试

require("testthat")
test_that(desc="test_testWithPico",
    code={

        pico <- configureContainer()
        movies <- data.frame(
            movie=c("A", "B", "C"),
            director=c("Director 1", "Director 2", "Director 3")
        )
        write.table(x=movies, file="movies1.txt", sep="")
#        movies <- read.table("movies1.txt")

        lister <- new("MovieLister", 
            finder=pico$getComponentInstance("MovieLister")
        )

        movies <- lister$moviesDirectedBy("Director 1")
        target <- list(
            data.frame(movie="A", director="Director 1")
        )
        expect_that(
            movies,
            is_equivalent_to(target)
        )

    }
)