блестящий - свернуть боковую панель при использовании appendTab - PullRequest
Новая
       10

блестящий - свернуть боковую панель при использовании appendTab

0 голосов
/ 06 февраля 2019

Я пытаюсь свернуть боковую панель в новой вкладке, как только один из маркеров в примере щелкает.Боковая панель должна оставаться на вкладке «Главная панель»

Небольшой пример приложения с данными 

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

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

пользовательский интерфейс с id="Sidebar" для элемента боковой панели, который должен быть скрыт, и useShinyjs()

ui <- dashboardPage(      
  dashboardHeader(title = "Test"),
  dashboardSidebar(
    sidebarMenu(id="Sidebar",
                actionLink("remove", "Remove detail tabs"))),
  dashboardBody(
    useShinyjs(), # not really sure where this has to go?
    tabsetPanel(
    id = "tabs",
    tabPanel(
      title = "Main Dashboard",
      value = "page1",
      fluidRow(tabsetPanel(id='my_tabsetPanel',
                               tabPanel('Map1',
                                        leafletOutput('map1')   
                               )))))))

серверная часть, где я добавляю Eventobserver() в appendTab, который должен распознавать, что открыта новая вкладка, и скрывать боковую панель 

###server   
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)   
    appendTab(inputId = "my_tabsetPanel",
              tabPanel(
                tab_title,
                fluidRow(                      
                  box('test')
                )))
    tab_list <<- c(tab_list, tab_title) 

    observeEvent(input$tabs == "my_tabsetPanel", { #also not sure if this is at the right place?
        shinyjs::hide(id = "Sidebar")
      })
    updateTabsetPanel(session, "my_tabsetPanel", selected = tab_title)       
  })

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

shinyApp(ui = ui, server = server)

Ссылка на аналогичная, но другая проблема !

...