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