CODEWITHSUNDEEP
rshinyshinydashboardr-leaflet
John Smith
John Smith

Reputation: 209

Leaflet map is not displaying properly with full screen video

I have two tabs in my App and when I go to the video tab and click full screen and then go back to my leaflet page, the map is not displayed properly, please see the code and screenshot below.

ui.R

library("shinydashboard")
library("shiny")
library("leaflet")

dashboardPage(
  header = dashboardHeader(), 
  sidebar = dashboardSidebar(disable = FALSE, 
                             collapsed = FALSE, 
                             sidebarMenu(
                               menuItem("Dashboard", tabName = "dashboard"),
                               menuItem("Video", tabName = "video")
                             )
  ), 
  body = dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
        fluidRow(
          column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
        )
      ),
      tabItem(
        tabName = "video",
        fluidRow(
          column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px", 
                                       weight = "640px", controls = "controls")
          )
        )
      )
    )
  )
)

server.R

library("shinydashboard")
library("shiny")
library("leaflet")

function(input, output, session){
  output$map <- renderLeaflet(
    leaflet() %>% 
      addTiles() %>% 
      setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
  )
}

messed up

Upvotes: 2

Views: 1577

Answers (1)

SeGa
SeGa

Reputation: 9809

This seems like a bug to me, but I am not sure on which side, leaflet/shinydashboard or shiny, as this also seems to happen when using fluidPage and tabsetPanel.

A workaround would be to trigger a fake resize event on the window, as this apparently solves the problem, also when done manually.

The jscode waits for a click on the sidebar-menu list and triggers a new resize Event. Make sure to include the Jquery code in the HTML by adding tags$head(tags$script(jscode)) to the dashboardBody.

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

jscode = HTML("
$(document).on('shiny:connected', function() {
  $('.sidebar-menu li').on('click', function(){
    window.dispatchEvent(new Event('resize'));
  });
});
")

ui <- {dashboardPage(
  header = dashboardHeader(), 
  sidebar = dashboardSidebar(disable = FALSE, 
                             collapsed = FALSE, 
                             sidebarMenu(
                               menuItem("Dashboard", tabName = "dashboard"),
                               menuItem("Video", tabName = "video")
                             )
  ), 
  body = dashboardBody(
    tags$head(tags$script(jscode)),
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow(
                column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
              )
      ),
      tabItem(
        tabName = "video",
        fluidRow(
          column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px", 
                                       weight = "640px", controls = "controls")
          )
        )
      )
    )
  )
)}

server <- function(input, output, session){
  output$map <- renderLeaflet(
    leaflet() %>% 
      addTiles() %>% 
      setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
  )
}

shinyApp(ui, server)

Upvotes: 2

Related Questions