我们有一个shiny 的应用程序,我正在寻找一种方法来创建/下载屏幕截图(PNG,JPG)或导出/下载PDF. 最好的方法是如果这个文件只包含视觉效果(绿色),但如果只有一种方法可以做到这一点,我也会很高兴.

enter image description here

有什么简单的方法可以做到这一点吗?就像点击一个按钮,下载就开始了.


MWE

library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
library(bslib)

################################################################################
################################ S E R V E R ###################################
################################################################################

server = shinyServer(function(input,output){
  
  output$histogram = renderPlot(
    hist(faithful$eruptions, breaks=input$days_plot)
  )
  
  output$histogram2 = renderPlot(
    hist(faithful$eruptions, breaks=input$days_plot)
  )
  
  output$active_cases = DT::renderDataTable(
    mtcars, selection = 'single', options=list(scrollX=TRUE))
  
})

################################################################################
#################################### U I #######################################
################################################################################

ui = shinyUI(
  dashboardPage(
    dashboardHeader(
      title="just a test"
    ),
    dashboardSidebar(
      #h3("Downstream", style="text-align:center; 
      #                        color:white;
      #                        background-color:red'"
      #   ),
      sidebarMenu(id="tabs",
                  menuItem("Tab1", tabName="active_cases", icon = icon("magnifying-glass-location")),
                  menuItem("Tab2", tabName="archive", icon = icon("box-archive")),
                  menuItem("Configuration", sliderInput("days_plot", "Days into past", 1, 60, 30))
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName="active_cases", shiny::h2("Active Cases"),
                fluidRow(
                  box(title="Table", status="primary", solidHeader=TRUE, div(DT::dataTableOutput("active_cases")))
                ),
                fluidRow(
                  box(title="Visual1", status="primary", solidHeader=TRUE, plotOutput("histogram")),
                  box(title="Visual2", status="primary", solidHeader=TRUE, plotOutput("histogram2"))
                )
        ),
        tabItem(tabName="archive", shiny::h2("Archive"))
      )
    )
  )
)

################################################################################
################################### R U N ######################################
################################################################################

shinyApp(ui, server)

推荐答案

我按照建议(非常感谢,斯蒂芬)用shinyscreenshot美元解决了这个问题.

library(shiny)
library(shinydashboard)
library(shinyscreenshot)
library(data.table)
library(DT)
library(bslib)
library(plotly)

################################################################################
################################ S E R V E R ###################################
################################################################################

server = shinyServer(function(input,output){
  
  output$histogram = renderPlotly(
    ggplotly(ggplot(mtcars, aes(x=disp, y=hp, color=gear)) + geom_point())
  )
  
  
  output$active_cases = DT::renderDataTable(
    mtcars)
  
  ######################### SCREENSHOT REACTIVE FUNCTION #########################  
  observeEvent(input$go,{
    screenshot(id = "to_plot") # plot only ID "to_plot"
  })
  ######################### SCREENSHOT REACTIVE FUNCTION #########################
  
})


################################################################################
#################################### U I #######################################
################################################################################

ui = shinyUI(
  dashboardPage(
    dashboardHeader(
      title="just a test"
    ),
    dashboardSidebar(
      sidebarMenu(id="tabs",
                  menuItem("Tab1", tabName="active_cases", icon = icon("magnifying-glass-location"))
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName="active_cases", shiny::h2("Active Cases"),
          fluidRow(actionButton("go", "go")),
              fluidRow(
                box(title="Table", status="primary", solidHeader=TRUE, div(DT::dataTableOutput("active_cases")))
              ),
          div(id="to_plot",
              fluidRow(
                box(title="Visual1", status="primary", solidHeader=TRUE, plotlyOutput("histogram"))
              )
          )
)))))


################################################################################
################################### R U N ######################################
################################################################################

shinyApp(ui, server)

R相关问答推荐

Select R中列未排序的收件箱中的最后一个按顺序编号的列

基于2行删除重复项指定每列要执行的操作

通过Plotly绘制线串几何形状的3D图

在数据表中呈现数学符号

在通过最大似然估计将ODE模型与数据匹配时,为什么要匹配实际参数的转换值?

使用ggplot将平滑线添加到条形图

在R中查找每个组不同时间段的总天数

找出疾病消失的受试者

在垂直轴中包含多个ggplot2图中的平均值

在使用ggroove后,将图例合并在gplot中

在另一个函数中调用ggplot2美学

R Sapply函数产生的值似乎与for循环方法略有不同

计算时间段的ECDF(R)

如何根据嵌套元素的名称高效而优雅地确定它属于哪个列表?

在保留列表元素属性的同时替换列表元素

函数可以跨多个列搜索多个字符串并创建二进制输出变量

安全地测试文件是否通过R打开

警告消息";没有非缺失的参数到min;,正在返回数据中的inf";.表分组集

如何将宽格式的患者信息数据高效地转换为患者计数的时间序列?

ggplot斜体轴刻度标签中的单个字符-以前的帖子建议不工作