Shiny - Листовка не отображается должным образом с полноэкранным видео - PullRequest
Новая
       18

Shiny - Листовка не отображается должным образом с полноэкранным видео

0 голосов
/ 30 октября 2018

У меня есть две вкладки в моем приложении, и когда я перехожу на вкладку видео и нажимаю на весь экран, а затем возвращаюсь на страницу листовки, карта не отображается должным образом, см. Код и снимок экрана ниже.

  • шаг 1: щелкните вкладку видео
  • шаг 2: нажмите кнопку полного экрана (видео)
  • шаг 3: нажмите ESC
  • шаг 4: щелкните вкладку панели инструментов

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

Спасибо

1 Ответ

0 голосов
/ 30 октября 2018

Мне кажется, что это ошибка, но я не уверен, с какой стороны, листовка / шинишборд или блестящий, так как это также происходит при использовании fluidPage и tabsetPanel.

Обходной путь должен был бы вызвать поддельное событие изменения размера в окне, поскольку это, очевидно, решает проблему, также когда сделано вручную.

jscode ожидает щелчка по списку бокового меню и запускает новое событие изменения размера. Обязательно включите код Jquery в HTML, добавив tags$head(tags$script(jscode)) к 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)
...