Внедрение зависимостей: как использовать / внедрить PicoContainer Framework в R

Question

Вопросы

Общий вопрос

Как бы вы начали внедрять PicoContainer-Framework в R?

Конкретный вопрос

Как на самом деле будет выглядеть "реестр (механизм)"? Я придумал "версию бедняка", которая работает только для одного процесса регистрации (см. Класс DefaultPicoContainer в приведенном ниже примере; на данный момент метод getComponentInstance() на самом деле не использует информацию getRefClass("MovieLister") найти зарегистрированные компоненты)

---

пример

AFAIU, пока нет реализаций PicoContainer-Framework в R, поэтому я подумал о том, как это может выглядеть.

Это то, что я мог придумать до сих пор. Это вдохновлено статьей Мартина Фаулера о внедрении зависимостей.

1. Пример для уровня бизнес-логики

Интерфейс (класс)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. Адаптация Pico Container Framework в R

Учебный класс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)
        )

    }
)