Home > database >  not able to download the generated plot in shiny
not able to download the generated plot in shiny

Time:04-19

I'm trying to download a generated plot in this shiny app. Here we have a fully functioning shiny, with a data upload, which we can then visualize through ggplot. However, I have tried for hours to download the generated plot through downloadHandler() but have not been able to do that. What am I missing here?

Grateful for all help

library(ggpmisc)
library(shiny)
library(ggplot2)
ui <- navbarPage("ddd",
                 tabPanel("Upload",
                          sidebarLayout(
                            sidebarPanel(
                              shinyjs::useShinyjs(),
                              fluidRow(
                                column(6,
                                       fileInput('file1', 'Choose CSV File',
                                                 accept=c('text/csv', 
                                                          'text/comma-separated-values,text/plain', 
                                                          '.csv'))
                                )
                              ),
                              fluidRow(
                                column(6,
                                       checkboxInput('header', 'Header', TRUE),
                                       tags$hr(),
                                       radioButtons('sep', 'Separator',
                                                    c(Comma=',',
                                                      Semicolon=';',
                                                      Tab='\t'),
                                                    ','),
                                       radioButtons('quote', 'Quote',
                                                    c(None='',
                                                      'Double Quote'='"',
                                                      'Single Quote'="'"),
                                                    '"'),
                                       selectInput(
                                         "disp",
                                         "Display",
                                         choices = c(Head = "head",
                                                     All = "all",
                                                     tail = "tail"
                                         ),
                                         selected = "head"
                                       )
                                )

                              )
                            ),
                            mainPanel(
                              fluidRow(
                                dataTableOutput('contents')
                              )
                              
                            )
                          )
                          
                 ),
                 tabPanel("Vis",
                          sidebarLayout(
                            sidebarPanel(
                              fluidRow(
                                column(6,
                                       selectInput('xcol', 'X Variable', "",width=140),
                                       selectInput('ycol', 'Y Variable', "", selected = "",width=140),
                                       checkboxInput("fit1","Add line of best fit",value = FALSE, width=140 ),
                                       checkboxInput("logysim", "logY", FALSE, width=140),
                                       checkboxInput("logxsim", "logX", FALSE, width=140)

                                )
                              ),
                              fluidRow(
                                column(6,
                                       downloadButton("downloadPlot","download plot")
                                )
                              )
                              
                            ),
                            mainPanel(
                              plotOutput("MyPlot"))
                          ),
                          fluidRow(
                            column(3,
                                   textInput("title1", "Title",value = "", width=140),
                                   textInput("xlabsim", "Xlab",value = "", width=140),
                                   textInput("ylabsim", "Ylab",value = "", width=140)
                            ),
                            column(3,
                                   selectInput("colvar", "Color vairable","", selected = "" , width=140),
                                   colourpicker::colourInput("col", "Background color", value = "#CDDAFA")
                            )

                          )
                 )
)
server <- function(input, output, session) {
  
  
  data <- reactive({ 
    req(input$file1) ## ?req #  require that the input is available
    
    inFile <- input$file1 
    
    df <- read.csv(inFile$datapath, header = input$header, sep = input$sep,
                   quote = input$quote)
    
    
    updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
                      choices = names(df), selected = names(df))
    updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
                      choices = names(df), selected = names(df)[2])
    updateSelectInput(session, inputId = 'colvar', label ='Color vairable',
                      choices = names(df), selected = names(df)[3])

    
    
    return(df)
  })
  
  output$contents <- renderDataTable({
    req(input$file1)
    
    if (input$disp == "head") {
      return(head(data()))
    }else if (input$disp == "tail") {
      return(tail(data()))
    }
    
    else {
      return(data())
    }
    
    
    
  })
  
  output$MyPlot <- renderPlot({
    graph <- ggplot(data(), aes(.data[[input$xcol]], .data[[input$ycol]]))  
      stat_summary(geom='point',fun=mean,shape=21,size=2)  
      geom_point(position='jitter', col = input$col)  
      stat_correlation() 
      ggtitle(input$title1) 
      labs(x=input$xlabsim, y=input$ylabsim)  
      theme_grey()
    
    if (input$fit1) {
      graph <- graph   geom_smooth(method = "lm")
    }
    
    if(input$logysim){
      graph <- graph   scale_y_log10()
    } 
    
    if(input$logxsim){
      graph <- graph    scale_x_log10()
      
    }
    
    if(input$colvar != ""){
      graph <- graph    aes_string(color=input$colvar)
      
      
    }

    graph
    
  })
  
  output$downloadPlot <- downloadHandler(
    filename = function() { paste(input$file1, '.png', sep='') },
    content = function(file) {
      png(file)
      print(graph)
      dev.off()
    })
  

}

shinyApp(ui, server)

CodePudding user response:

Try this in your server

 graph <- reactive({
    graph <- ggplot(data(), aes(.data[[input$xcol]], .data[[input$ycol]]))  
      stat_summary(geom='point',fun=mean,shape=21,size=2)  
      geom_point(position='jitter', col = input$col)  
      stat_correlation() 
      ggtitle(input$title1) 
      labs(x=input$xlabsim, y=input$ylabsim)  
      theme_grey()
    
    if (input$fit1) {
      graph <- graph   geom_smooth(method = "lm")
    }
    
    if(input$logysim){
      graph <- graph   scale_y_log10()
    } 
    
    if(input$logxsim){
      graph <- graph    scale_x_log10()
    }
    
    if(input$colvar != ""){
      graph <- graph    aes_string(color=input$colvar)
    }
    
    graph
  })
  
  output$MyPlot <- renderPlot({graph()  })
  
  output$downloadPlot <- downloadHandler(
    filename = function() { paste(input$file1, '.png', sep='') },
    content = function(file) {
      png(file)
      print(graph())
      dev.off()
    }
  )
  • Related