Question

我有一个闪亮的应用程序，当您单击标记并跳入该选项卡时，它将打开一个选项卡。现在，您可以返回到地图选项卡，然后单击另一个标记，这将打开另一个选项卡，依此类推。我希望能够使用操作按钮删除所有打开的选项卡。

下面是一个小的示例代码，您可以在单击标记时添加并跳至选项卡，但是操作按钮Remove detail tabs不起作用。

library(shiny)
library(leaflet)
library(shinydashboard)
library(purrr)

pts <- data.frame(
  id= letters[seq( from = 1, to = 10 )],
  x = rnorm(10, mean = -93.625), 
  y = rnorm(10, mean = 42.0285)
)


ui <- fluidPage(
  dashboardSidebar(

    actionLink("remove", "Remove detail tabs")),

  tabsetPanel(id='my_tabsetPanel',
              tabPanel('Map1',
                       leafletOutput('map1')   
              )))



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

  output$map1 <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      setView(-93.65, 42.0285, zoom = 6)
  })


  observe({        
    input$my_tabsetPanel        
    tab1 <- leafletProxy('map1', data = pts) %>%
      clearMarkers() %>% 
      addCircleMarkers(lng = ~x, lat = ~y, radius = 4, layerId = ~id)   

  })


  observeEvent(input$map1_marker_click, { 
    tab_title <- input$map1_marker_click[1]
    appendTab(inputId = "my_tabsetPanel",
              tabPanel(
                tab_title, #paste0("tab_",tab_title),
                value = paste0("tab_",tab_title),
                fluidRow(                      
                  box('test')
                )))

    tab_list <<- c(tab_list, tab_title)        
    updateTabsetPanel(session, "my_tabsetPanel", selected = paste0("tab_",tab_title))       
  })
  observeEvent(input$remove,{
    print(tab_list)
    tab_list %>%
      walk(~removeTab("my_tabsetPanel", .x))
      tab_list <<- NULL
  })

}
shinyApp(ui = ui, server = server)

以下操作使“操作”按钮起作用，但不包括您自动跳入我要保留的新创建的选项卡的功能。

ui <- fluidPage(
  dashboardSidebar(

    actionLink("remove", "Remove detail tabs")),

  tabsetPanel(id='my_tabsetPanel',
              tabPanel('Map1',
                       leafletOutput('map1')   
              )))

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

  output$map1 <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      setView(-93.65, 42.0285, zoom = 6)
  })     

  observe({        
    input$my_tabsetPanel        
    tab1 <- leafletProxy('map1', data = pts) %>%
      clearMarkers() %>% 
      addCircleMarkers(lng = ~x, lat = ~y, radius = 4, layerId = ~id)        

  })


  observeEvent(input$map1_marker_click, { 
    tab_title <- input$map1_marker_click[1]
    appendTab(inputId = "my_tabsetPanel",
              tabPanel(
                tab_title, 
                fluidRow(                      
                  box('test')                      
                )))        
    tab_list <<- c(tab_list, tab_title)        
    updateTabsetPanel(session, "my_tabsetPanel", selected = tab_title) 

  })
  observeEvent(input$remove,{
    print(tab_list)
    tab_list %>%
      walk(~removeTab("my_tabsetPanel", .x))

    tab_list <<- NULL
  })

}


shinyApp(ui = ui, server = server)

我努力将两种版本组合成一个可行的版本。

示例link，一切正常。

Answer 1

好，因此带有选项Multiple = TRUE的removeUI（）函数将删除除第一个（在此情况下为Map选项卡本身）之外的所有列表元素。

library(shiny)
library(leaflet)
library(shinydashboard)
library(purrr)

pts <- data.frame(
  id= letters[seq( from = 1, to = 10 )],
  x = rnorm(10, mean = -93.625), 
  y = rnorm(10, mean = 42.0285)
)


ui <- fluidPage(
  dashboardSidebar(

    actionLink("remove", "Remove detail tabs")),

  tabsetPanel(id='my_tabsetPanel',
              tabPanel('Map1',
                       leafletOutput('map1')   
              )))



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

  output$map1 <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      setView(-93.65, 42.0285, zoom = 6)
  })


  observe({        
    input$my_tabsetPanel        
    tab1 <- leafletProxy('map1', data = pts) %>%
      clearMarkers() %>% 
      addCircleMarkers(lng = ~x, lat = ~y, radius = 4, layerId = ~id)   

  })


  observeEvent(input$map1_marker_click, { 
    tab_title <- input$map1_marker_click[1]
    appendTab(inputId = "my_tabsetPanel",
              tabPanel(
                tab_title, #paste0("tab_",tab_title),
                value = paste0("tab_",tab_title),
                fluidRow(                      
                  box('test')
                )))

    tab_list <<- c(tab_list, tab_title)        
    updateTabsetPanel(session, "my_tabsetPanel", selected = paste0("tab_",tab_title))       
  })
  observeEvent(input$remove,{
    removeUI(
      selector = "ul>li:nth-child(n+2)",
      multiple = TRUE
    )
    removeUI(
      selector = "div.box-body",
      multiple = TRUE
    )
  })

}
shinyApp(ui = ui, server = server)

Answer 2

好的，我实际上找到了一种方法。您需要在标签标题名称元素周围使用paste()。为什么？我不知道。

下面的服务器部分与上面的用户界面结合在一起

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

  output$map1 <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      setView(-93.65, 42.0285, zoom = 6)
  })


  observe({        
    input$my_tabsetPanel        
    tab1 <- leafletProxy('map1', data = pts) %>%
      clearMarkers() %>% 
      addCircleMarkers(lng = ~x, lat = ~y, radius = 4, layerId = ~id)   

  })


  observeEvent(input$map1_marker_click, { 
    clickedMarker <- input$map1_marker_click[1]
    tab_title <- paste(clickedMarker) #add paste() here and it works      

    appendTab(inputId = "my_tabsetPanel",
              tabPanel(
                tab_title,
                fluidRow(                      
                  box('test')
                )))

    tab_list <<- c(tab_list, tab_title) 


    updateTabsetPanel(session, "my_tabsetPanel", selected = tab_title)       
  })


  observeEvent(input$remove,{
    print(tab_list)
    tab_list %>%
      walk(~removeTab("my_tabsetPanel", .x))
    tab_list <<- NULL
  })

}

带有操作按钮的闪亮删除选项卡

2 个答案: