R Shiny : Writing reactive functions to reduce code repetition

Question

我有一个 Shiny 的应用程序，它由许多相同的部分组成，只是它们适用于数据集的不同切片。这是一个独立操作和显示初始数据集的两个子集的玩具示例:

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

以更易于维护的方式生成与以前相同的应用程序。

我无法弄清楚的是如何类似地重构服务器端。如果我没有输入会很容易，但是我很难正确处理 react 性。

如何重构 server 块以防止代码重复？

澄清:

我最初没有提到我将数据生成与 renderTable 调用分开，因为在我的实际应用程序中，我有多个输出(表格、图表、按钮等)，它们被动地依赖于分组子集的数据，因此理想的解决方案将允许这样的扩展。

Answer 1

您可以使用 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()因此在构建输出时可以更容易地多次引用它。