在动作按钮RShiny中包含反应式UI

时间:2017-06-28 05:22:39

标签: r tabs reactive-programming shiny

我有一个标签式UI,只要用户选择数据表中的行,就会显示(在下面的代码中,输出是随机的,在现实生活中,计算非常复杂)。

我想条件显示单击按钮的选项卡式UI。目前,每次选择其他行时,它都会对已选择的行重新进行计算。当用户选择了他想要查看的所有行时,我想将其限制为一次性计算。

library(shiny)
library(DT)

用户界面:表格,操作按钮和标签部分。

ui <- fluidPage(
  mainPanel(
    fluidRow(
      column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
    ),
    actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
    fluidRow(
      uiOutput("myTabUI")
    )
  )
)

server功能:如果我删除output$myTabUI <- eventReactive(input$launchCalcButton, {部分,而是直接执行output$myTabUI <- renderUI ({ ...,则按预期工作(当然,点击按钮后减去计算)。

server <- function(input,output){

  output$tableCurrencies <- DT::renderDataTable({datatable(data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10)))})

  origTable_selected <- reactive({
    ids <- input$tableCurrencies_rows_selected
    return(ids)
  })

  output$myTabUI <- eventReactive(input$launchCalcButton, {
      selectedTabs <- renderUI({
        myTabs <- lapply(origTable_selected(),function(i) {


          tabName <- paste0("test",i)

          a <- renderPlot({
            hist(rnorm(50))
          })
          output[[paste0(tabName,"rates")]] <- a
          return(tabPanel(
            tabName,
            fluidRow(
              column(6,plotOutput(paste0(tabName,"rates")))
            )
          ))
        })
        return(do.call(tabsetPanel,myTabs))
      })
      selectedTabs
    })
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')

不确定如何解决这个问题。欢迎任何帮助。

1 个答案:

答案 0 :(得分:1)

您可以使用isolate()来限制反应依赖性

library(shiny)
library(DT)

ui <- fluidPage(
  mainPanel(
    fluidRow(
      column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
    ),
    actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
    fluidRow(uiOutput("myTabUI"))
  )
)

server <- function(input,output){
  output$tableCurrencies <- DT::renderDataTable({
    data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10))})     
  origTable_selected <- reactive({
    input$tableCurrencies_rows_selected        
  })      
  output$myTabUI <- renderUI({
    input$showSelectedButton
    myTabs <- lapply(isolate(origTable_selected()),function(i) {          
      tabName <- paste0("test",i)          
      a <- renderPlot({hist(rnorm(50))})
      output[[paste0(tabName,"rates")]] <- a
      return(tabPanel(
        tabName,
        fluidRow(column(6,plotOutput(paste0(tabName,"rates"))))
      ))
    })
    do.call(tabsetPanel,myTabs)
  })
}

shinyApp(ui,server)