Шаблон Singleton

Шаблон проектирования — это проверенное решение задачи проектирования, которая возникает снова и снова. Шаблон одиночка гарантирует наличие ровно одного экземпляра чего-либо, доступного из любого места. В R функция-акцессор создаёт экземпляр при первом вызове, сохраняет его в переменной, созданной с помощью local(), и каждый раз возвращает тот же экземпляр:

get_config <- local({
  instance <- NULL
  function() {
    if (is.null(instance)) {
      instance <<- new.env()
      instance$theme <- "light"
    }
    instance
  }
})
a <- get_config()
a$theme <- "dark"
b <- get_config()
cat(b$theme, identical(a, b))

Результат:

dark TRUE

Экземпляр является окружением, поэтому изменение, внесённое через один вызов, видно из любой другой части программы. Две функции в разных местах записывают данные в один и тот же журнал:

get_log <- local({
  instance <- NULL
  function() {
    if (is.null(instance)) {
      instance <<- new.env()
      instance$lines <- character(0)
    }
    instance
  }
})
page_a <- function() {
  log <- get_log()
  log$lines <- c(log$lines, "a visited")
}
page_b <- function() {
  log <- get_log()
  log$lines <- c(log$lines, "b visited")
}
page_a()
page_b()
page_a()
print(get_log()$lines)

Вывод:

[1] "a visited" "b visited" "a visited"

Экземпляр создаётся только тогда, когда он впервые требуется. Подсчёт созданных экземпляров показывает, что это происходит один раз, независимо от того, сколько раз вызывается средство доступа:

created <- 0
get_db <- local({
  instance <- NULL
  function() {
    if (is.null(instance)) {
      created <<- created + 1
      instance <<- new.env()
    }
    instance
  }
})
for (i in 1:5) db <- get_db()
cat("created", created, "time(s)")

Вывод:

created 1 time(s)

Используйте синглтоны умеренно. Синглтон — это глобальное состояние: любой код может его изменить, а тест не может начать с чистой копии, не сбросив его. Он подходит для вещей, которые действительно существуют в единственном экземпляре на программу, например для логгера или настроек; часто понятнее передавать объект в качестве аргумента:

# яснее для тестирования: log передаётся
process <- function(order, log) {
  log$lines <- c(log$lines, paste("processing", order$id))
}