RShiny: написание реактивных функций для уменьшения повторения кода

У меня есть блестящее приложение, состоящее из множества одинаковых частей, за исключением того, что они работают с разными фрагментами набора данных. Вот игрушечный пример, который независимо манипулирует и отображает два подмножества исходного набора данных:

# app.R
library(shinydashboard)

df <- data.frame(
  id    = 1:10,
  group = rep(c("A", "B"), times = 5),
  val   = seq(1, 100, 10)
)


ui <- fluidPage(
  fluidRow(
    numericInput(
      "A_multiplier",
      "Multiplier:",
      value = 1
    ),
    tableOutput("A_table")
  ),
  fluidRow(
    numericInput(
      "B_multiplier",
      "Multiplier:",
      value = 1
    ),
    tableOutput("B_table")
  )
)


server <- function(input, output) {

  A_data <- reactive({
    df <- df[df$group == "A", ]
    df$val <- df$val * input$A_multiplier
    df
  })

  output$A_table <- renderTable(A_data())

  B_data <- reactive({
    df <- df[df$group == "B", ]
    df$val <- df$val * input$B_multiplier
    df
  })

  output$B_table <- renderTable(B_data())
}


shinyApp(ui = ui, server = server)

Это тонна повторения кода, и ее становится очень сложно поддерживать по мере увеличения количества групп.

Что я хочу сделать, так это написать функции для генерации кода ui и server на основе групп, видимых в исходном df, обрабатывая каждую группу одинаково.

Для ui это довольно просто; Я могу заменить блок ui следующим:

MakeGroupElements <- function(group) {

  namer <- function(name) paste(group, name, sep = "_")

  fluidRow(
    numericInput(
      namer("multiplier"),
      "Multiplier:",
      value = 1
    ),
    tableOutput(namer("table"))
  )
}

ui <- do.call(fluidPage, lapply(unique(df$group), MakeGroupElements))

для создания того же приложения, что и раньше, но более удобным для сопровождения.

Чего я не могу понять, так это того, как провести аналогичный рефакторинг на стороне сервера. Было бы легко, если бы у меня не было входных данных, но мне трудно правильно справляться с реактивностью.

Как я могу реорганизовать блок server, чтобы предотвратить повторение кода?

Пояснение:

Сначала я не упомянул, что отделил генерацию данных от вызовов renderTable, потому что в моем реальном приложении у меня есть множество выходных данных (таблиц, диаграмм, кнопок и т. д.), которые реактивно зависят от группового подмножества. данные, поэтому идеальное решение позволит такое расширение.


r dry shiny
person ClaytonJY    schedule 13.01.2016    source источник
comment
@jenesaisquoi Я уже разобрался с пользовательским интерфейсом; нет необходимости отображать его на стороне сервера. Я хочу кодировать сторону server гибким, удобным для сопровождения способом, подобно тому, как я рефакторил сторону ui выше.   -  person ClaytonJY    schedule 14.01.2016

Ответы (1)


arrow_upward
2
arrow_downward

Вы также можете использовать lapply в своем server.R:

server <- function(input, output) {
        lapply(unique(df$group),function(x){
                output[[paste0(x,"_table")]] <- renderTable({
                        df <- df[df$group == x, ]    
                        df$val <- df$val * input[[paste0(x,"_multiplier")]]
                        df
                })
        })
}

input и output — это списки, поэтому вы можете устанавливать/получать доступ к элементам, используя [[

Вы можете использовать reactiveValues, если хотите сохранить данные в списке:

server <- function(input, output) {
  data <- reactiveValues()

  lapply(
    unique(df$group),
    function(x) {
      data[[as.character(x)]] <- reactive({
        df <- df[df$group == x, ]
        df$val <- df$val * input[[paste(x, "multiplier", sep = "_")]]
        df
      })
    }
  )

  lapply(
    unique(df$group),
    function(x) {
      output[[paste(x, "table", sep = "_")]] <- renderTable({data[[as.character(x)]]()})
    }
  )
}

Дополнительные результаты и рефакторинг:

Мы можем добавить еще один вывод (график) и провести дальнейший рефакторинг, чтобы разбить все на небольшие функции, подобные этой:

# app.R
library(shinydashboard)

df <- data.frame(
  id    = 1:10,
  group = rep(c("A", "B"), times = 5),
  val   = seq(1, 100, 10)
)


MakeNamer <- function(group) {
  function(name) {paste(group, name, sep = "_")}
}


MakeGroupElements <- function(group) {

  namer <- MakeNamer(group)

  fluidRow(
    numericInput(
      namer("multiplier"),
      "Multiplier:",
      value = 1
    ),
    tableOutput(namer("table")),
    plotOutput(namer("plot"))
  )
}


ui <- do.call(fluidPage, lapply(unique(df$group), MakeGroupElements))


MakeReactiveData <- function(df, input) {

  data <- reactiveValues()

  lapply(
    unique(df$group),
    function(group) {
      data[[as.character(group)]] <- reactive({
        namer <- MakeNamer(group)
        df <- df[df$group == group, ]
        df$val <- df$val * input[[namer("multiplier")]]
        df
      })
    }
  )

  data
}


MakeOutputs <- function(groups, data, output) {

  lapply(
    groups,
    function(group) {
      namer <- MakeNamer(group)
      df <- reactive({data[[as.character(group)]]()})
      output[[namer("table")]] <- renderTable({df()})
      output[[namer("plot")]] <- renderPlot({plot(df()$id, df()$val)})
    }
  )
}


server <- function(input, output) {

  data <- MakeReactiveData(df, input)

  MakeOutputs(unique(df$group), data, output)
}


shinyApp(ui = ui, server = server)

Хотя для этого игрушечного примера это излишне, в более крупном приложении с большим количеством групп и выходных данных такое сокращение повторения кода приводит к гораздо более удобному сопровождению приложения.

Некоторые важные вещи, на которые следует обратить внимание, — это использование as.character при индексировании в data и необходимость обернуть df другим reactive внутри MakeOutputs(), чтобы на него можно было легко ссылаться более одного раза при построении выходных данных.

person NicE    schedule 13.01.2016
comment
Что, если у меня есть несколько выходных данных, которые извлекаются из реактивного набора данных, что помешает мне включить генерацию данных в вызов renderTable? Извините, я не указал это в вопросе; редактирую сейчас. Кроме того, возникнут ли проблемы, если я разобью эту анонимную функцию на именованную функцию, содержащуюся в отдельном файле? - person ClaytonJY; 14.01.2016