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)

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

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

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()包裹在一起，以便它可以在构建输出时，不止一次更容易引用。

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

1 个答案: