如何下载R Shiny中动态的图? [英] How to download graphs which are dynamic in R Shiny?

问题描述

在选项卡的Shiny Dashboard中，根据复选框输入的选择，我正在一个图的下方绘制另一个图.相应地选中复选框后，图形将在另一个下方显示.请找到下面使用的代码.

In Shiny Dashboard in a Tab I am plotting graphs one below the another, based on the selection of checkbox inputs. When the check boxes are selected accordingly the graphs will get displayed one below the another. Kindly find the code below which i used.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
d <-
  data.frame(
    year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
    Product_Name = c(
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed"
    ),
    Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
    Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
  )

ui <- shinyUI(fluidPage(
  useShinydashboard(),
  tabPanel(
    "Plot",
    sidebarLayout(
      sidebarPanel(
        radioButtons(
          "Choose",
          "Choose One",
          c("Year" = "p", "Numbers" = "l")
        ),
        uiOutput('checkbox'),
        #width = 2,
        position = "bottom"),
      mainPanel(uiOutput("graph"),
                uiOutput("graph_1"))
      
    )
  )
))

server <- function(input, output, session) {
  
  z_1 <- reactiveValues(years = NULL)
  z_2 <- reactiveValues(numbers = NULL)
  
  observeEvent(input$X, {
    z_1$years <- input$X
  })
  
  observeEvent(input$X_1, {
    z_2$numbers <- input$X_1
  })
  
  output$checkbox <- renderUI({
    if (input$Choose == "p") {
      checkboxGroupInput("X",
                         "year",
                         choices = (unique(d$year)),selected = z_1$years)
      
    } else{
      checkboxGroupInput("X_1",
                         "Numbers",
                         choices = c("1","2","3","4"), ,selected = z_2$numbers)
    }
    
  })
  
  output$graph <- renderUI({
    ntabs = length(input$X)
    if(input$Choose == "p"){
    myTabs = lapply(seq_len(ntabs), function(i) {
      
      fluidRow(plotOutput(paste0("plot", i)))
    })
    }else return(NULL)
  })
  
  
  output$graph_1 <- renderUI({
    ntabs = length(input$X_1)
    if(input$Choose == "l"){
    myTabs = lapply(seq_len(ntabs), function(i) {
      
      fluidRow(plotOutput(paste0("plot_1", i)))
    })
    }else return(NULL)
  })
  
  
  observe (lapply(length(input$X), function(i) {
    output[[paste0("plot", i)]] <- renderPlot({
      if (length(input$X) > 0) {
        d %>%
          ggplot(aes(Product_Name, Cost)) +
          geom_col(aes(fill = Product_desc),
                   position = position_dodge(preserve = "single")) +
          facet_wrap( ~ input$X[i],
                      scales = "free_x",
                      strip.position = "bottom") +
          theme(strip.placement = "outside") +
          theme_bw()
      }
    })
    
  }))
  
  
  observe (lapply(length(input$X_1), function(i) {
    output[[paste0("plot_1", i)]] <- renderPlot({
      if (length(input$X_1) > 0) {
        d %>%
          ggplot(aes(Product_Name, Cost)) +
          theme(strip.placement = "outside") +
          theme_bw()
      }
    })
    
  }))
  
}

shinyApp(ui, server)

我现在想做的是我想下载这些图".根据用户复选框输入动态生成的内容.如果用户生成了1张图，我想下载它.如果用户生成了3张图，那么我想将所有生成的图下载到一个jpeg文件中.

What I am trying to do now is I "Wanted to download these plots" which are getting dynamically generated based on the user check box input. If the user had generated 1 graph I wanted to download it. If the user had generated 3 graphs then i want to download all the generated graphs in one single jpeg file.

我尝试使用downloadHandler，但是不幸的是我没有成功.

I tried using downloadHandler, but unfortunately i was very very unsuccessful in it.

在这种情况下，我面临的问题是图在自然界中是动态的，因此我无法在downloadHandler中存储或编写代码.图的动态性质使其变得困难.

The issue which I am facing in this case is as the graphs are dynamic in Nature I am not able to store or write a code in the downloadHandler. The dynamic Nature of the Graph is making it difficult.

有人可以建议我如何克服这个问题.

Can someone please suggest me how to overcome this.

推荐答案

发光模块 [*]在这里很有可能.

Shiny Modules [*] would be a neat possibility here.

注意.我不完全了解您对动态 checkboxGroup 所做的尝试，因此我将其替换为静态的.另外，我不太清楚要特别绘制的 .但是，这对于当前的问题并不是至关重要的，可以描述如下

Note. I did not fully understand what you tried with your dynamic checkboxGroup, so I replaced it by a static one. Also I was not quite clear what you want to plot in particular. This is however anyways not crucial to the problem at hand, which can be described as follows

将动态数量的图形下载到一个文件中.

Download a dynamic amount of figures in one file.

所以我们开始，下面进行解释.

So here we go, explanation below.

设置

library(shiny)
library(dplyr)
library(gridExtra)

d <- data.frame(
   year         = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
   Product_Name = c("Table", "Chair", "Bed", "Table", "Chair", "Bed", "Table",
                    "Chair", "Bed"),
   Product_desc = rep(LETTERS[24:26], each = 3),
   Cost         = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)

发光模块

plot_ui <- function(id) {
   ns <- NS(id)
   plotOutput(ns("graph"))
}

plot_server <- function(input, output, session, my_data, graph_type) {
   
   get_graph <- reactive({
      base_plot <- ggplot(my_data,
                          aes(Product_Name, Cost)) +
         theme(strip.placement = "outside") +
         theme_bw()
      if (graph_type() == "b") {
         res <- base_plot +
            geom_col(aes(fill = Product_desc),
                     position = position_dodge(preserve = "single")) +
            facet_wrap(~year)
      } else if (graph_type() == "p") {
         res <- base_plot +
            geom_point()
      }
      res
   })
   
   output$graph <- renderPlot({
      get_graph()
   })
   
   list(graph = get_graph)
}

主应用

ui <- fluidPage(
   titlePanel("Modules to the Rescue!"),
   sidebarLayout(
      sidebarPanel(
         radioButtons(
            "type",
            "Graph Type",
            c(Bars = "b", Points = "p")
         ),
         checkboxGroupInput("selector",
                            "Year",
                            choices = unique(d$year)),
         downloadButton("download", "Download Graphs")
         ),
      mainPanel(div(id = "container", div("test content")))
   )
)

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

   ## store active plot handlers
   all_plots <- reactiveVal()
   
   ## counter to ensure unique ids for the module uis
   cnt <- reactiveVal(0)
   
   ## when we change selector draw plots anew
   observe({
      ## remove all existing plots
      removeUI("#container *", immediate = TRUE, multiple = TRUE)
      ## for each selection create a new plot
      ## SIDE EFFECT: create the UI
      handlers <- lapply(input$selector, function(x) {
         cnt(isolate(cnt()) + 1)
         my_dat <- d %>%
            dplyr::filter(year == x)
         new_id <- paste("plot", isolate(cnt()))
         insertUI("#container", ui = plot_ui(new_id))
         callModule(plot_server, new_id, 
                    my_data = my_dat, 
                    graph_type = reactive(input$type))
      })
      all_plots(handlers)
   })
   
   output$download <- downloadHandler(
      filename = function() {
         paste0("plots-", Sys.Date(), ".png")
      }, content = function(file) {
         my_plots <- all_plots()
         ggsave(file,
                plot = marrangeGrob(lapply(my_plots, function(handle) handle$graph()),
                                    ncol = 1, nrow = length(my_plots)))
      }
   )
}

shinyApp(ui, server)

说明

(链接的文档详细描述了正在执行的模块，因此我将重点放在使用上，而不是它们在总体上的工作原理.)

(The linked document describes in depth what modules are doing so I focus on I used them, rather on how they work in general.)

1. 我们创建一个模块，为我们做图.
2. 该模块创建一个反应式，该反应式生成图.
3. 此反应式使用了两次:一次在 renderPlot 函数中绘制图，一次作为模块的返回参数.
4. 在主应用程序中，我们跟踪所有已创建的模块( all_plots )，通过这些模块我们可以与模型进行通信，尤其是检索图.
5. 要绘制图，我们会听 checkboxGroup ，每当有变化时，我们都会动态删除所有图，并重新添加它们并更新 all_plots ，通过该图我们可以在最后一步中，获取 downloadHandler 的图.
6. 在 downloadHandler 中，我们遍历所有图并使用 gridExtra :: marrange 通过将所有 ggplots 放入一个文件中> ggsave .

1. We create a module whihc does the plotting for us.
2. The module creates a reactive which produces the plot.
3. This reactive is used twice: once in the renderPlot function to render the plot, and once as a return parameter of the module.
4. In the main app, we keep track about all created modules (all_plots), through which we can communicate with the model and in particular to retrieve the plot.
5. To draw the plots, we listen to the checkboxGroup and whenever there is a change we dynamically remove all plots, and add them afresh and update all_plots through which we can in the last step retrieve the plots for the downloadHandler.
6. In the downloadHandler we loop through all plots and use gridExtra::marrange to put all of the ggplots into one file via ggsave.

---

[*]请注意，由于我还没有升级Shiny.我仍然使用旧的 callModule 语法.

这篇关于如何下载R Shiny中动态的图?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！