r - 全屏查看按钮

Question

我正在用 highcharter 编写一个 Shiny 的应用程序。

在我的应用程序中，我想添加一个独立按钮以全屏查看我的图表。

我想我必须在我的例子中添加带有按钮“action_fs”的JS代码......
这是我的应用程序:

library(shiny)
library(dplyr)
library(highcharter)

ui <- fluidPage(
  fluidRow(
    actionButton("mybutton","launch"),
    br(),
    column(width = 6,
           uiOutput("button_fullscreen"),
           highchartOutput("mygraph")
    )
  )
)

server = function(input, output) {

  mytab <- iris %>% group_by(Species) %>% summarise(mystat=sum(Petal.Length,na.rm = T))

  observeEvent(input$mybutton, {

    output$button_fullscreen <- renderUI({
      actionButton("action_fs","view in full screen")
    })

    output$mygraph <- renderHighchart({
      highchart() %>%
        hc_chart(type = "bar") %>%
        hc_add_series(data = mytab$mystat, name = "Petal.Length") %>%
        hc_xAxis(categories = mytab$Species)
    })
  })
}

shinyApp(ui = ui, server = server)

Answer 1

我无法安装 highcharter (依赖 quantmod 不可用)，所以这里是一个带有 ggplot 的例子:

library(shiny)
library(ggplot2)

js <- "
function openFullscreen(elem) {
  if (elem.requestFullscreen) {
    elem.requestFullscreen();
  } else if (elem.mozRequestFullScreen) { /* Firefox */
    elem.mozRequestFullScreen();
  } else if (elem.webkitRequestFullscreen) { /* Chrome, Safari and Opera */
    elem.webkitRequestFullscreen();
  } else if (elem.msRequestFullscreen) { /* IE/Edge */
    elem.msRequestFullscreen();
  }
}"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  fluidRow(
    column(
      width = 3,
      actionButton(
        "fs", "Full screen", 
        onclick = "openFullscreen(document.getElementById('graphContainer'));"
      )
    ),
    column(
      width = 9,
      div(
        id = "graphContainer",
        plotOutput("ggplot")
      )
    )
  )
)

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

  output[["ggplot"]] <- renderPlot({
    ggplot(iris, aes(Sepal.Length, Sepal.Width)) + geom_point()
  })

}


shinyApp(ui, server)

编辑

上述解决方案的问题在于，当应用程序处于全屏模式时，绘图高度不会改变。使用下面的解决方案，当切换到全屏模式时，绘图高度将变为屏幕高度。

library(shiny)
library(ggplot2)

js <- "
function openFullscreen(elem) {
  if (elem.requestFullscreen) {
    elem.requestFullscreen();
  } else if (elem.mozRequestFullScreen) { /* Firefox */
    elem.mozRequestFullScreen();
  } else if (elem.webkitRequestFullscreen) { /* Chrome, Safari and Opera */
    elem.webkitRequestFullscreen();
  } else if (elem.msRequestFullscreen) { /* IE/Edge */
    elem.msRequestFullscreen();
  }
}"

css <- "
#ggplot:-webkit-full-screen {
  height: 100%;
  margin: 0;
}
#ggplot:-ms-fullscreen {
  height: 100%;
}
#ggplot:fullscreen {
  height: 100%;
}"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js)),
    tags$style(HTML(css))
  ),
  br(),
  fluidRow(
    column(
      width = 3,
      actionButton(
        "fs", "Full screen", 
        onclick = "openFullscreen(document.getElementById('ggplot'));"
      )
    ),
    column(
      width = 9,
      plotOutput("ggplot")
    )
  )
)

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

  output[["ggplot"]] <- renderPlot({
    ggplot(iris, aes(Sepal.Length, Sepal.Width)) + geom_point()
  })

}


shinyApp(ui, server)