Динамически добавлять / удалять вкладки в tabBox - PullRequest
Новая
       12

Динамически добавлять / удалять вкладки в tabBox

0 голосов
/ 21 мая 2019

Я все еще учусь кодировать блестяще, так что это пост с несколькими вопросами, так как есть несколько вещей на одни и те же темы, которые я не могу понять.

Я создаю приложение, в котором у пользователя есть возможность выбрать данные из того же набора данных, но отфильтровать их по дате. Один из вариантов заключается в том, что пользователь может выбирать данные по частям в разные даты. Выбранные данные затем отображаются в другом поле таблицы. Поэтому приложение позволяет пользователю динамически добавлять необходимое количество дат - я называю это «шаги». Каждая добавленная дата создает новую таблицу, которая отображается на новой вкладке в 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. данные не приведены в таблице. На вкладках, кроме шага 1, отображается «Нет данных в таблице». Я предполагаю, что это может быть то, что output[[reviewTableId]] находится внутри того же observeEvent, что и appendTab, но это скорее предположение.

  2. Когда пользователь удаляет дату, правильная вкладка во вкладке также должна быть удалена. Однако лучшее, что я мог сделать, это удалить активную вкладку. Правильно было бы: если я удаляю вторую дату, вторая вкладка также должна быть удалена, независимо от того, какая вкладка активна. Я знаю, что проблема заключается в target из removeTab. Я пытался removeTab("TabBox", target=tabBoxId), но ничего не получается.

  3. У меня есть tabBox внутри виджета box, но tabBox не простирается через сторону box. Это особенно проблема при отображении данных с большим количеством переменных.

Или, возможно, мои проблемы являются только результатом неуместного динамического добавления новых вкладок в tabBox?

...