функция hideTab () не работает в Shinydashboard для отдельных динамических вкладок - PullRequest
Новая
       10

функция hideTab () не работает в Shinydashboard для отдельных динамических вкладок

0 голосов
/ 23 января 2019

Я создаю динамические вкладки, основанные на щелчках по таблице данных с кнопкой действия на каждой вновь созданной вкладке, которая при нажатии скрывает эту вкладку.Новые вкладки создаются должным образом, но кнопка скрытия не работает, когда я открываю более одной вкладки.Что-то мне не хватает? 

    library(shiny)
    library(DT)
    library(shinydashboard)

    ui <- function(request) {
        dashboardPage(
            dashboardHeader(title = "Tabs not Hiding"),
            dashboardSidebar(disable = TRUE),
            dashboardBody(
                tabBox(id = "tabs",
                    width = 12, 
                    tabPanel("Cars overview",
                                h1("Cars overview"),
                                div("Click any cell"),
                                br(),
                                DT::dataTableOutput("mtcars")
                            )
                )
            )
        )
    }

    server <- function(input, output, session) {

        tab_list <- NULL

        # Generate data table
        output$mtcars <- DT::renderDataTable({
            DT::datatable(mtcars)
            })

        observeEvent(input$mtcars_cell_clicked, {

            info <- as.numeric(input$mtcars_cell_clicked$row)

            outputID <- glue::glue("dt-{info}")

            req(info)

            if(!(info %in% tab_list)){
                print(info)
                appendTab(inputId = "tabs",
                        tabPanel(title = outputID,
                                fluidRow(
                                    box(
                                        actionButton("TabHide", "Hide this tab"),
                                        width = 3
                                    ),
                                    box(
                                        DT::dataTableOutput(outputID),
                                        width = 9
                                        )
                                    )
                                )
                        )
                tab_list <<- c(tab_list, outputID)
            }

            output[[outputID]] <- DT::renderDataTable({
                mtcars[info, ]
            })

            showTab(inputId = "tabs", target = outputID, select = TRUE)

            observeEvent(input$TabHide,{
                hideTab(input = "tabs", target = outputID)
            }, ignoreInit = TRUE)
    }, ignoreInit = TRUE)
    }

    shinyApp(ui, server)

1 Ответ

0 голосов
/ 23 января 2019

Пожалуйста, проверьте эту версию функции сервера, я добавляю комментарии к изменениям, которые я сделал: 

server <- function(input, output, session) {

  tab_list <- NULL

  # Generate data table
  output$mtcars <- DT::renderDataTable({
    DT::datatable(mtcars)
  })

  # Add proxy object to manipulate DT
  dtProxy <- dataTableProxy('mtcars')

  observeEvent(input$mtcars_rows_selected, {

    info <- as.numeric(input$mtcars_row_last_clicked)

    # Clear DT selection via proxy
    selectRows(dtProxy, NULL)

    outputID <- glue::glue("dt-{info}")

    req(info)

    # Check for 'outputID' in tab_list instead of 'info' variable (missprint?)
    if(!(outputID %in% tab_list)){
      appendTab(inputId = "tabs",
                tabPanel(title = outputID,
                         fluidRow(
                           box(
                             # Create buttons with unique inputId
                             actionButton(paste0("TabHide", outputID), "Hide this tab"),
                             width = 3
                           ),
                           box(
                             DT::dataTableOutput(outputID),
                             width = 9
                           )
                         )
                )
      )
      tab_list <<- c(tab_list, outputID)
    }

    output[[outputID]] <- DT::renderDataTable({
      mtcars[info, ]
    })

    showTab(inputId = "tabs", target = outputID, select = TRUE)

    # Add observer for actionButton from opened tab (part 'input[["some_inputId"]]')
    observeEvent(input[[paste0("TabHide", outputID)]],{
      # Use 'removeTab' instead of 'hideTab', be cause of tab duplicates
      removeTab(input = "tabs", target = outputID)
      # Remove tab from 'tab_list', as we know this observer will delete tab from page
      tab_list <<- tab_list[!tab_list %in% outputID]
      # Add 'once = TRUE' to destroy observer after tab closed (we will create new observer again when open tab)
    }, ignoreInit = TRUE, once = TRUE)
  }, ignoreInit = TRUE)
}

В целом : просто внимание к деталям.

...