r - 依赖注入(inject) : how to use/implement PicoContainer Framework in R

Question

问题

一般问题

您将如何开始实现 PicoContainer-Framework在 R 中？

具体问题

“pico 注册表(机制)”实际上是什么样子的？我想出了一个只适用于单个注册过程的“穷人版本”(参见下面示例中的类 DefaultPicoContainer；此时方法 getComponentInstance() 不t 实际上使用信息 getRefClass("MovieLister") 来查找已注册的组件)

---

例子

AFAIU，PicoContainer-Framework 没有任何实现在 R 中，所以我考虑了这可能是什么样子。

这是我目前能想到的。它的灵感来自 Martin Fowler's article关于依赖注入(inject)。

1。 业务逻辑层

示例

接口(interface)(类)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

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。 R中Pico容器框架的适配

类 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

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。测试

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

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

    }
)

---

背景

我开始对 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)
        )

    }
)