Question

我有一个sidebarLayout应用，我在其中设置了按钮，以便在tabPanel中添加和删除sidebarPanel。但是，我无法弄清楚如何自定义这些tabPanel。我的代码如下：

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 3, fixed=T,
      h3("L2 Machine"),
      actionButton('moreL2', tags$b('Add L2')),
      actionButton('lessL2', tags$b('Remove L2')),
      uiOutput('panelset'),
      tabPanel("L2panel", 
        numericInput(inputId='L2amount', 'Select L2 Amount', value=0),
        selectInput(inputId='L2type', 'Select L2 Type', c('Percent', 'Absolute')),
        uiOutput('L2daterange')
      )
    ),
    mainPanel(
      verbatimTextOutput('L2a'),
      verbatimTextOutput('L2t')
    )
  )
)

server <- function(input, output) {

  output$L2a <- renderPrint(input$L2amount)
  output$L2t <- renderPrint(input$L2type)

  output$panelset <- renderUI({
    n <- seq(max(input$moreL2 - input$lessL2 + 1, 1))
    tabList <- lapply(paste("Pan", n), tabPanel)
    do.call(tabsetPanel, tabList)
  })

  output$L2daterange <- renderUI({
    dateRangeInput(inputId='L2daterange', 
      label='Select Adjustment Period', 
      start='01-01-2010', end='01-12-2015'
    )
  })
}

shinyApp(ui, server)

目前，我numericInput()内有selectInput()，uiOutput()和tabPanel()。相反，我希望通过单击按钮＆＃34;添加L2＆＃34;创建每个tabPanel。拥有它自己的numericInput，selectInput和uiOutput。

Answer 1

您确实创建了不同的tabPanel但它们是空的 - numericInput和selectInput都不在动态tabPanel中。该解决方案基于https://gist.github.com/wch/5436415/，你可以找到一个广泛的解释，为什么你需要一个函数local来呈现带有for循环的输出。

如上所述，您创建了正确的动态tabPanel但它们是空的。在lapply中，您应该将唯一小部件指定为tabPanel的参数。

output$panelset <- renderUI({
    n <- seq(max(input$moreL2 - input$lessL2 + 1, 1))
    tabList <- lapply(paste("Pan", n), tabPanel)
    do.call(tabsetPanel, tabList)
  })

在这里，我编写了一个如何以正确方式执行此操作的示例。每次使用一组唯一的小部件创建唯一的tabPanel时。

tabList <- lapply(n, function(i) {
      tabPanel(
        title = paste0('Pan', i),

        numericInput(inputId = paste0('L2amount', i), 'Select L2 Amount', value = 0),

        selectInput(inputId = paste0('L2type', i), 'Select L2 Type', c('Percent', 'Absolute')),

        dateRangeInput(inputId = paste0('L2daterange',i), 
                     label = 'Select Adjustment Period', 
                     start = '01-01-2010', end = '01-12-2015'))

    })
    do.call(tabsetPanel, tabList)

  })

然后，对于每个具有唯一小部件集的tabPanel，您必须创建唯一的输出集，然后才能呈现小部件的值。

完整解决方案：

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 3, fixed=T,
                 h3("L2 Machine"),
                 actionButton('moreL2', tags$b('Add L2')),
                 actionButton('lessL2', tags$b('Remove L2')),
                 uiOutput('panelset') 
    ),
    mainPanel(
      uiOutput("dynamic")
    )
  )
)


TMAX <- 10 # specify maximal number of dynamic panels
server <- function(input, output) {



  output$panelset <- renderUI({

    n <- seq(max(input$moreL2 - input$lessL2 + 1, 1))

    # You have to create each time a new set of unique widgets
    tabList <- lapply(n, function(i) {
      tabPanel(
        title = paste0('Pan', i),

        numericInput(inputId = paste0('L2amount', i), 'Select L2 Amount', value = 0),

        selectInput(inputId = paste0('L2type', i), 'Select L2 Type', c('Percent', 'Absolute')),

        dateRangeInput(inputId = paste0('L2daterange',i), 
                     label = 'Select Adjustment Period', 
                     start = '01-01-2010', end = '01-12-2015'))

    })
    do.call(tabsetPanel, tabList)

  })


    output$dynamic <- renderUI({
      n <- seq(max(input$moreL2 - input$lessL2 + 1, 1))

      # You want to render n-times different outputs and each time you have 
      # k different outputs -- > need a list within a list. 
      lapply(n, function(i) {

        list(
          h5(paste0("Pan", i, " widgets")),

          verbatimTextOutput(paste0('L2a', i)),
          verbatimTextOutput(paste0('L2t', i)),
          verbatimTextOutput(paste0('L2dat', i)),

          br()
        )
      })
    })

    for (i in 1:TMAX) {

      local({
        my_i <- i

        # Outputs
        L2a <- paste0('L2a', my_i)
        L2t <- paste0('L2t', my_i)
        L2dat <- paste0('L2dat', my_i)

        list( 
          output[[L2a]] <- renderPrint({ input[[paste0('L2amount', my_i)]] }),

          output[[L2t]] <- renderPrint({ input[[paste0('L2type', my_i)]] }),

          output[[L2dat]] <- renderPrint({ input[[paste0('L2daterange', my_i)]] })
        )
      })
    }

}

shinyApp(ui, server)

如何通过单击Shiny中的按钮来自定义tabPanel

1 个答案: