Question

我仍在学习闪亮的代码，所以这是一个多问题的帖子，因为同一主题上有很多东西我无法弄清楚。

我正在创建一个应用程序，用户可以选择从同一数据集中选择数据，但可以根据日期对其进行过滤。选项之一是，用户可以在不同日期逐段选择数据。然后，所选数据将显示在表格的另一个框中。因此，应用程序使用户能够动态添加所需的日期数-我称之为“步骤”。每个添加的日期都会创建一个新表，该表将显示在tabBox的新选项卡中。还有一个功能是，如果不需要日期（和表格），则将其删除。

这是我的程序：

library(shiny)
library(shinydashboard)
library(shinyjs)

start_date <- "2019-06-30"
end_date <- "2021-06-30"

VP_all <- data.frame(code= c("VP001", "VP002", "VP003", "VP004", "VP005", "VP006", "VP007", "VP008"),
                     available = c("Yes", "Yes", "No", "No", "Yes", "Yes", "No", "No"), 
                     date = c("2019-09-28", "2021-09-28", "2024-07-12", "2022-11-03", "2021-11-26", "2019-09-28", "2021-09-28", "2024-07-12"))

#Recovery option 5 specific function
select <- function(df, x){
  VP_EB <- subset(df, df$available == "Yes" & as.Date(df$date, format = "%Y-%m-%d")> x)

  return(VP_EB)
}

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(

    useShinyjs(),  #Set up shinyjs

    tabsetPanel(
      tabPanel("Settings",
               br(),
               fluidRow(
                 column(width = 8,
                        box(
                          title = "Set parameters", id = "RO_05_param_box", width = NULL, solidHeader = TRUE, status ="primary", collapsible = TRUE,
                          fluidRow(
                            box(h6("this box contains other elements")),
                            box(id= "step_box", dateRangeInput("RO05_date1", h6("Start and end date"), start = start_date, end = end_date, min = start_date, max = end_date), 
                                tags$div(id = 'placeholder_dateRangeInput'),
                                actionButton("add_lag", "Add step"))
                          )
                        )
                 ),
                 column(width = 12,
                        box(title = "Review available financial assets", id = "RO_05_rewiew_box", width = NULL, solidHeader = TRUE, status = "primary", collapsed = FALSE, collapsible = TRUE, 
                            tabBox(id = "TabBox",
                                   tabPanel("Step1", dataTableOutput("available_step1"))
                                   )
                          )
                        )
               )
      )
    )
  )
)
#################################

server <- function(input, output) {

  Rvariables <- reactiveValues(add = 1)

  #dynamically adding and removing elements
  observeEvent(input$add_lag, {
    Rvariables$add <- Rvariables$add + 1
    addID <- paste0("Step", Rvariables$add)  #id of ui part, where dateRangeInput and action button are added
    daterangeID <- paste0('RO05_date', Rvariables$add) #id of dynamically added dateRangeInput
    removeID <- paste0('remove_lag', Rvariables$add) #id of dynamically added remove button
    reviewTableId <- paste0("available_step", Rvariables$add, sep='') #id of dynamically added renderDataTables
    tabBoxId <- paste0("Step", Rvariables$add, sep='') #id of dynamically added tabs in the tabBox

    #adding date widget into the paramter box
    insertUI(
      selector = '#placeholder_dateRangeInput',
      ui = tags$span(id = addID, 
                     tags$span(dateRangeInput(daterangeID, h6("Near lag and far lag"), start = start_date, end = end_date, min = start_date, max = end_date)), 
                     tags$span(actionButton(removeID, label= '', icon("minus")))
      )
    )

    #Add a new tab to a tabBox
    appendTab("TabBox", 
              tabPanel(id=tabBoxId, 
                       title = paste("Step ", Rvariables$add, sep=''),
                       dataTableOutput(reviewTableId)
              ), select=TRUE)

    output[[reviewTableId]] <- renderDataTable({
      df_RO05 <- select(VP_all, daterangeID[2])
    }, options = list(scrollX = TRUE, scrollY = "400px"))


    observeEvent(input[[removeID]], {
      removeUI(selector = paste0('#', addID))
      removeTab("TabBox", target=input$TabBox)

      Rvariables$add <- Rvariables$add - 1
    })

  })
}

# Run the application 
shinyApp(ui = ui, server = server)

但是，我在很多事情上苦苦挣扎：

数据。在除“步骤1”以外的选项卡中，显示为“表中无可用数据”。我认为可能是output[[reviewTableId]]与observeEvent位于同一appendTab内，但这只是一个猜测。
当用户删除日期时，选项卡框中的正确选项卡也应删除。但是，我能做的最好的事情就是删除一个活动标签。正确的做法是：如果我删除第二个日期，则无论哪个选项卡处于活动状态，第二个选项卡也应删除。我知道问题出在target的{{1}}中。我尝试了removeTab，但是它什么也没做。
我在removeTab("TabBox", target=tabBoxId)小部件中有一个tabBox，但是box并没有穿过tabBox的侧面。当显示带有大量变量的数据时，这尤其是个问题。

也许我的问题仅仅是由于不适当地向box动态添加新标签导致的？

动态添加/删除tabBox中的标签

0 个答案: