блестящие удаления вкладок с помощью кнопки действий

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)

Я изо всех сил пытаюсь объединить обе версии в одну, которая работает.

Пример ссылка где все работает как надо.

Answer 1

Хорошо, я действительно нашел способ. Вам нужно использовать 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
  })

}

Answer 2

Хорошо, так что функция removeUI () с параметром множественное = ИСТИНА удалит все элементы списка, кроме первого (в данном случае, самой вкладки «Карта»).

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)