Передача аргументов для рендеринга функций в Shiny - PullRequest
Новая
       41

Передача аргументов для рендеринга функций в Shiny

0 голосов
/ 08 июня 2018

Как я могу передать дополнительные аргументы реактивному контексту в Shiny?Цель состоит в том, чтобы передать аргументы реактивному контексту («обратному вызову») при его оценке.

Подумайте о следующем коде блестящего сервера.Как я могу заставить output$some печатать «некоторые», output$different печатать «другие» и так далее? 

for(i in c("some","different","values"){
  output[[i]] <- renderText({
  # i gets evaluated at some later point in time, 
  # and thus will always print "values"
  i
})
}

Пример ниже предназначен для того, чтобы сделать два контекста рендеринга реагирующими на соответствующее реактивное значение text1 и text2, но, конечно, они зависят только от text2. 

library(shiny)
ui <- fluidPage(
   titlePanel("Test"),
   sidebarLayout(
      sidebarPanel(
      ),
      mainPanel(
        htmlOutput("text1"),
        textOutput("text2"),

        actionButton("test_btn1",label="test1"),
        actionButton("test_btn2",label="test2")
      )
   )
)
server <- function(input, output) {
  rv <- reactiveValues(
    "text1"=NULL,
    "text2"=NULL
  )
  bindings <- list(
    list("var"="text1",
         "function"=renderUI),
    list("var"="text2",
         "function"=renderText)
  )
  for(i in bindings){
    output[[i[["var"]]]] <- i[["function"]]({
      # i is always the second element unfortunately
      rv[[i[["var"]]]]
    })
  }
  observeEvent(input$test_btn1,{
    rv$text1 <- tags$p("new value 1")
  })
  observeEvent(input$test_btn2,{
    rv$text2 <- "new value 2"
  })
}
shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 08 июня 2018

Попробуйте использовать Map () вместо цикла for, чтобы функция вызывалась на каждой итерации: 

library(shiny)
ui <- fluidPage(
  titlePanel("Test"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      htmlOutput("text1"),
      textOutput("text2"),

      actionButton("test_btn1",label="test1"),
      actionButton("test_btn2",label="test2")
    )
  )
)
server <- function(input, output) {
  rv <- reactiveValues(
   "text1"=NULL,
    "text2"=NULL
  )
  bindings <- list(
    list("var"="text1",
         "function"=renderUI),
    list("var"="text2",
         "function"=renderText)
  )

  Map(function(i){
    output[[bindings[[i]][["var"]]]] <- bindings[[i]][["function"]]({
      # i is always the second element unfortunately
      rv[[bindings[[i]][["var"]]]]

    })
  }, 1:2)
  observeEvent(input$test_btn1,{
    rv$text1 <- "new value 1"
  })
  observeEvent(input$test_btn2,{
    rv$text2 <- "new value 2"
  })
}
shinyApp(ui = ui, server = server)
...