我正在基于对数据表的单击来创建动态选项卡,每个新创建的选项卡上都带有一个动作按钮,单击该按钮会隐藏该选项卡。新标签页已按预期创建,但是当我打开多个标签页时,隐藏操作按钮不起作用。有什么我想念的吗?
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)
答案 0 :(得分:1)
请检查此版本的服务器功能,我在所做的更改中添加了注释:
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)
}
总体:只关注细节。