如何自定義tabPanel添加通過點擊閃爍的按鈕

Question

我有一個sidebarLayout應用程序，其中我設置了按鈕來添加和刪除sidebarPanel中的tabPanel s。但是，我無法弄清楚如何自定義這些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()。相反，我希望通過單擊「添加L2」按鈕創建的每個tabPanel擁有它自己的一組numericInput,selectInput和uiOutput。

Answer 1

您創建了不同的tabPanels，但它們都是空的 - numericInput和selectInput都不在動態tabPanels內。該解決方案基於https://gist.github.com/wch/5436415/，您可以在其中找到一個廣泛的解釋，爲什麼您需要函數local以for循環呈現輸出。

---

如上所述，您創建了正確的動態tabPanels，但它們是空的。在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)