R Shiny：编写反应函数以减少代码重复

Question

我有一个闪亮的应用程序，它由许多相同的部分组成，只是它们处理数据集的不同部分。这是一个独立操作和显示初始数据集的两个子集的玩具示例：

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

这是大量的代码重复，并且随着组数的增加变得非常难以维护。

我想做的是编写函数，根据初始 df 中看到的组生成 ui 和 server 代码，以相同的方式处理每个组。

对于 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 调用分开，因为在我的实际应用程序中，我有多个输出（表格、图表、按钮等），它们反应性地依赖于组子集数据，因此理想的解决方案将允许这种扩展。

Answer 1

您也可以在 server.R 中使用 lapply：

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 是列表，因此您可以使用 [[

set/access 元素

如果要将数据保存在列表中，可以使用 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)

虽然对于这个玩具示例来说有点矫枉过正，但在具有更多组和输出的更大应用程序中，这种代码重复的减少导致应用程序更易于维护。

需要注意的一些重要事项是在索引到 data 时使用 as.character 并且需要在 MakeOutputs() 中用另一个 reactive 包装 df 所以它在构建输出时可以更轻松地多次引用。

R Shiny：编写反应函数以减少代码重复

RShiny: Writing reactive functions to reduce code repetition

r

dry

shiny