Shiny download ggplot

alexra · December 10, 2020, 5:11pm

Hi together,
I am facing a problem with my shiny app. I try to interactively generate some plots, allow manual data selection and subsetting of the dataframes. I am struggling with the download of the interactively generated plot. I get the

Warning: Error in $.shinyoutput: Reading from shinyoutput object is not allowed.

I read several forum posts and tried to get my plot in a reactive state, but since I have multiple interactive settings I do not manage to get it interactive.

Here is a minimal working example:

########### initialise ######
library("flowCore")
library("flowViz")
library("flowUtils")
library("ggplot2")
library("sp")
library("readxl")
library("plotly")
dataSel <- c("Full Data")
plotTypes <- c("XY", "Hist", "Box", "Matrix")
AxisScale <- c("lin", "log")
myCols <- c()

#### UI ##################################################################################
#### sidebar ####

ui <- fluidPage(
  titlePanel(h3("Data Viewer")),
  sidebarLayout(
    sidebarPanel("File to open",
      style = "background-color: LightSteelBlue",
      fileInput(inputId = "dataset1", label = "Input File", multiple = F, buttonLabel = "Load"),
      numericInput(inputId = "skipLine", label = "Numbers of lines to be skipped", value = 9),
      hr(),
      checkboxInput(inputId = "isFCS", label = "Input is FCS file"),
      checkboxInput(inputId = "isExcel", label = "Input is Excel file"),
      hr(),
     width = 2
    ),
#### server ####
      mainPanel(
      fluidPage(
        fluidRow(
          column(
            5,
            wellPanel(
              style = "width: 700px",
              fluidRow(h4("Plot 1"),
                column(3, selectInput("DataSource.plot1", h6("Data Source:"), choices = dataSel, selected = NULL),
                  tags$head(tags$style(HTML(".selectize-input {height: 11px; font-size: 10px}"))),
                  style = "padding:0px;",
                  selectInput("Xaxis.plot1", h6("X Axis:"), "", selected = NULL),
                  selectInput("Yaxis.plot1", h6("Y Axis:"), "", selected = NULL),
                  sliderInput("Xrange.plot1", h6("X range:"), min = 0, max = 100000, value = c(0, 100))
                ),
                column(
                  2, selectInput("PlotType.plot1", h6("Plot Type:"), choices = plotTypes, selected = NULL),
                  selectInput("Xscale.plot1", h6("X Scale:"), choices = AxisScale, selected = "lin"),
                  selectInput("Yscale.plot1", h6("Y Scale:"), choices = AxisScale, selected = "lin")
                ),
                column(
                  3, selectInput("FilterCol1.plot1", h6("1st Col to filter:"), choices = myCols, selected = NULL),
                  selectInput("FilterCol2.plot1", h6("2nd Col to filter:"), choices = myCols, selected = NULL),
                  selectInput("PlotCol.plot1", h6("Color Data:"), choices = c("red"), selected = "red"),
                  sliderInput("Yrange.plot1", h6("Y range:"), min = 0, max = 100000, value = c(25, 75000))
                ),
                column(
                  2, selectInput("FilterOperator1.plot1", h6("Operator:"), choices = c("=", ">", "<", "!="), selected = NULL, width = "50px"),
                  selectInput("FilterOperator2.plot1", h6("Operator:"), choices = c("=", ">", "<", "!="), selected = NULL, width = "50px"),
                  hr(),
                  actionButton("GateApply.plot1", label = h6("Apply Gate"), style = "padding:5px; font-size:80%"),
                  fileInput("GateLoad.plot1", label = "", multiple = F, buttonLabel = "Load Gate")
                ),
                column(
                  2, selectInput("FilterVal1.plot1", h6("Value for filter:"), choices = "", selected = NULL, width = "90px"),
                  selectInput("FilterVal2.plot1", h6("Value for filter:"), choices = "", selected = NULL, width = "90px"),
                  hr(),
                  actionButton("GateReset.plot1", label = h6("Reset Gate"), style = "padding:5px; font-size:80%", width = "80px", height = "11px", size = "small"),
                  actionButton("GateStore.plot1", label = h6("Store Gate"), style = "padding:5px; font-size:80%", width = "80px", height = "11px", size = "small")
                ),
                style = "padding: 15px;overflow:auto !important;"
              ),
              fluidRow(
                plotOutput("plot1", click = "plot1.click", dblclick = dblclickOpts(id = "ToOpenImage", delay = 300))
              ),
              fluidRow(
                column(3, textOutput("numberPoints.plot1")),
                column(3, downloadButton("ExportGraph.plot1", label = h6("Export Graph"), style ="padding:5px; font-size:80%")),
                column(3, downloadButton("ExportData.plot1", label = h6("Export Data"), style ="padding:5px; font-size:80%"))
              )
              
            ) # end panel
          ) # end column  
        ) # end row
      ) # end fluidpage
    ) # end main panel
  ) # end sidebar layout
) # end fluidpage

####################################################### initiates outside of server ##############
valgate1.file1 <- reactiveValues(x = NULL, y = NULL)
valgate2.file1 <- reactiveValues(x = NULL, y = NULL)
valgate3.file1 <- reactiveValues(x = NULL, y = NULL)
valgate4.file1 <- reactiveValues(x = NULL, y = NULL)
valgate5.file1 <- reactiveValues(x = NULL, y = NULL)
valgate6.file1 <- reactiveValues(x = NULL, y = NULL)

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

observeEvent(req(input$isExcel == 1), {
  insertUI(
      selector = "#isExcel",
      where = "afterEnd", multiple = TRUE,
      ui = sliderInput("selectSheet", h6("Which Sheet?"), min = 1, max = 10, value = 1)
    )
  })

  
###### Load dataset ######
  sliderCheck <- 0
  infile <- reactive({
    infile <- input$dataset1
    if (is.null(infile)) {
      # User has not uploaded a file yet
      return(NULL)
    }
    if (input$isFCS==1)
    {
      fulldata<-read.FCS(infile$datapath)
      data<-as.data.frame(fulldata@exprs, stringsAsFactors=F)
    }
    else if (input$isExcel == 1) {
      data <- read_excel(infile$datapath, sheet = input$selectSheet, progress = readxl_progress(), .name_repair = "unique")
    }
    else {
      data <- read.delim2(infile$datapath, skip = input$skipLine, header = T, stringsAsFactors = F)
    }
    ### plot 1
    updateSelectInput(session, inputId = "Xaxis.plot1", choices = names(data), selected = names(data)[1])
    updateSelectInput(session, inputId = "Yaxis.plot1", choices = names(data), selected = names(data)[2])
    updateSelectInput(session, inputId = "PlotCol.plot1", choices = c("red", "heatmap", "contour", names(data)), selected = "red")
    updateSelectInput(session, inputId = "FilterCol1.plot1", choices = c("", names(data)), selected = "")
    updateSelectInput(session, inputId = "FilterCol2.plot1", choices = c("", names(data)), selected = "")
    return(data)
  })

  
##################################   Gates #############################

  ########### getgates
  # plot 1
  observe({
    # Initially will be empty
    if (is.null(input$plot1.click)) {
      return()
    }

    isolate({
      valgate1.file1$x <- c(valgate1.file1$x, input$plot1.click$x)
      valgate1.file1$y <- c(valgate1.file1$y, input$plot1.click$y)
    })
  })

  ## apply gate
  ## initialize gates
  data.gate1 <- reactiveValues(df_data = NULL)
  dataSel<- reactiveValues(gatelist = NULL)
  dataSel$gatelist <- "Full Data"
  
  observeEvent(input$GateApply.plot1, {
    # Initially will be empty
    if (input$GateApply.plot1 == 0) {
      return()
    }
    isolate({
      selectedDataset.plot1 <-input$DataSource.plot1
      gate1.select <- point.in.polygon(reactiveData.plot1$df_data[[input$Xaxis.plot1]], reactiveData.plot1$df_data[[input$Yaxis.plot1]], valgate1.file1$x, valgate1.file1$y) > 0
      data.gate1$df_data <- reactiveData.plot1$df_data[which(gate1.select == TRUE), ]
    })

      dataSel$gatelist<-c(dataSel$gatelist, "Gate 1")
      updateSelectInput(session, inputId = "DataSource.plot1", choices = dataSel$gatelist, selected = selectedDataset.plot1)
      updateSelectInput(session, inputId = "DataSource.plot2", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot3", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot4", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot5", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot6", choices = dataSel$gatelist, selected = NULL)


  })

  ## reset gate
  observeEvent(input$GateReset.plot1, {
    if (input$GateReset.plot1 == 0) {
      return()
    }
	isolate({
      valgate1.file1$x <- c()
      valgate1.file1$y <- c()
      dataSel$gatelist<-dataSel$gatelist[dataSel$gatelist !="Gate 1"]
      updateSelectInput(session, inputId = "DataSource.plot1", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot2", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot3", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot4", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot5", choices = dataSel$gatelist, selected = NULL)
      updateSelectInput(session, inputId = "DataSource.plot6", choices = dataSel$gatelist, selected = NULL)
    })
  })



  ## store gate
  observeEvent(input$GateStore.plot1, {
    # Initially will be empty
    if (input$GateStore.plot1 == 0) {
      return()
    }
    isolate({
      exp.gate1 <- data.frame(valgate1.file1$x, valgate1.file1$y)
      write.table(exp.gate1, "gate1.coords.txt", sep = "\t", quote = F, row.names = F)
    })
  })

  ## load gate

  ingate.plot1 <- reactive({
    infilegate.plot1 <- input$GateLoad.plot1
    if (is.null(infilegate.plot1)) {
      return(NULL)
    }
    read.delim2(infilegate.plot1$datapath, header = T, stringsAsFactors = F)
  })
  observe({

    # output$table <- renderTable(ingate())
    valgate1.file1$x <- as.numeric(as.character(ingate.plot1()[, 1]))
    valgate1.file1$y <- as.numeric(as.character(ingate.plot1()[, 2]))
  })

  
  ######################### export data and plots ##################
  
  

  ######################### scale axis #############################
  observeEvent(c(input$Xaxis.plot1, input$Yaxis.plot1), {
    rngX.plot1 <- c(min(infile()[[input$Xaxis.plot1]]), max(infile()[[input$Xaxis.plot1]]))
    rngY.plot1 <- c(min(infile()[[input$Yaxis.plot1]]), max(infile()[[input$Yaxis.plot1]]))
    updateSliderInput(session, inputId = "Xrange.plot1", value = rngX.plot1, min = rngX.plot1[1], max = rngX.plot1[2])
    updateSliderInput(session, inputId = "Yrange.plot1", value = rngY.plot1, min = rngY.plot1[1], max = rngY.plot1[2])
  })

  ################## Histogram Selector ############################

  observeEvent(req(input$PlotType.plot1 == "Hist"), {
    insertUI(
      selector = "#plot1",
      where = "afterEnd", multiple = TRUE,
      ui = sliderInput("Nbins.plot1", h6("No of Bins:"), min = 1, max = 1000, value = 20)
    )
  })
 
  ################## Box Selector ############################

  observeEvent(req(input$PlotType.plot1 == "Box"), {
    insertUI(
      selector = "#plot1",
      where = "afterEnd",
      ui = selectInput("GroupingFactor.plot1", h6("Group by:"), choices = c("",names(infile())), selected = NULL)
    )
  })

 ############################# Plotting ##################
  reactiveData.plot1 <- reactiveValues(df_data = NULL)

  #plot 1 data
  output$plot1 <- renderPlot({
    req(infile())

    if(input$DataSource.plot1 == "Full Data") {reactiveData.plot1$df_data<-infile()}
    if(input$DataSource.plot1 == "Gate 1") {reactiveData.plot1$df_data<-data.gate1$df_data}
    if(input$DataSource.plot1 == "Gate 2") {reactiveData.plot1$df_data<-data.gate2$df_data}
    if(input$DataSource.plot1 == "Gate 3") {reactiveData.plot1$df_data<-data.gate3$df_data}
    if(input$DataSource.plot1 == "Gate 4") {reactiveData.plot1$df_data<-data.gate4$df_data}
    if(input$DataSource.plot1 == "Gate 5") {reactiveData.plot1$df_data<-data.gate5$df_data}

      if (input$PlotType.plot1 == "XY") {
      gplot <- ggplot(reactiveData.plot1$df_data, aes_(as.name(input$Xaxis.plot1), as.name(input$Yaxis.plot1), color = reactiveData.plot1$df_data[[input$PlotCol.plot1]])) + theme_bw() + labs(x = input$Xaxis.plot1, y = input$Yaxis.plot1) + coord_cartesian(xlim = c(input$Xrange.plot1[1], input$Xrange.plot1[2]), ylim = c(input$Yrange.plot1[1], input$Yrange.plot1[2]))
      if (input$Xscale.plot1 == "log") {
        gplot <- gplot + scale_x_log10()
      }
      if (input$Yscale.plot1 == "log") {
        gplot <- gplot + scale_y_log10()
      }
      if (input$PlotCol.plot1 == "red") {
        gplot <- gplot + geom_point(color = "red")
      }
      if ((input$PlotCol.plot1 != "red") & (input$PlotCol.plot1 != "heatmap") & (input$PlotCol.plot1 != "contour")) {
        gplot <- gplot + geom_point()
      }
      if (input$PlotCol.plot1 == "contour") {
        gplot <- gplot + geom_density_2d() + geom_point(size = 0.3, color = "#FF000020")
      }
      if (input$PlotCol.plot1 == "heatmap") {
        d <- densCols(reactiveData.plot1$df_data[[as.name(input$Xaxis.plot1)]], reactiveData.plot1$df_data[[as.name(input$Yaxis.plot1)]], colramp = colorRampPalette(rev(rainbow(10, end = 4 / 6))))
        gplot <- gplot + geom_point(size = 0.3, color = d) + scale_color_identity()
      }
      if (length(valgate1.file1$x) > 3) {
        gatevalues.plot1 <- data.frame(valgate1.file1$x, valgate1.file1$y)
        names(gatevalues.plot1) <- c("x", "y")
        gplot <- gplot + geom_polygon(data = gatevalues.plot1, aes(x = x, y = y), fill = "#FF000020", colour = "blue1", show.legend = FALSE)
        gplot <- gplot + geom_text(x = mean(gatevalues.plot1$x) * 0.9, y = mean(gatevalues.plot1$y) * 0.9, label = " Gate 1")
      }
      return(gplot)
    }
    else if (input$PlotType.plot1 == "Hist") {
      gplot <- ggplot(reactiveData.plot1$df_data, aes_(as.name(input$Xaxis.plot1))) + geom_histogram(bins = input$Nbins.plot1) + labs(x = input$Xaxis.plot1) + coord_cartesian(xlim = c(input$Xrange.plot1[1], input$Xrange.plot1[2])) + theme_bw()
      if (input$Xscale.plot1 == "log") {
        gplot <- gplot + scale_x_log10()
      }
      if (input$Yscale.plot1 == "log") {
        gplot <- gplot + scale_y_log10()
      }
      return(gplot)
    }
    else if (input$PlotType.plot1 == "Box") {
      gplot <- ggplot(reactiveData.plot1$df_data, aes_(x = as.name(input$Xaxis.plot1), y = as.name(input$Yaxis.plot1), fill=as.name(input$GroupingFactor.plot1))) + geom_boxplot() + theme_bw()
      if (input$Yscale.plot1 == "log") {
        gplot <- gplot + scale_y_log10()
      }
      return(gplot)
    }
    else if (input$PlotType.plot1 == "Matrix") {
      by1 <- reactiveData.plot1$df_data[[as.name(input$Xaxis.plot1)]]
      by2 <- reactiveData.plot1$df_data[[as.name(input$Yaxis.plot1)]]
      matrixDF.plot1 <- aggregate(reactiveData.plot1$df_data[[as.name(input$PlotCol.plot1)]], by = list(by1, by2), mean) + theme_bw()

      ggplot(matrixDF.plot1, aes(Group.1, Group.2, fill = x)) + geom_raster()
    }
  })
}
shinyApp(ui, server)

Thanks for the help
Alex

nirgrahamuk · December 10, 2020, 11:14pm

unfortunately its too much effort for me to reengineer your example as I dont find it to be minimal...

but hopefully you can learn the lessons from my example about how to do what you describe

library(shiny)
library(tidyverse)

ui <- fluidPage(
  plotOutput("myplotout"),
  downloadLink("downloadData", "Download Plot")
)

server <- function(input, output) {
  # Our dataset

  
  myplot <- reactive({
    ggplot(data=iris,
           mapping = aes(x=Petal.Width,y=Sepal.Width,colour=Species)) + geom_point()
  })
  output$myplotout <- renderPlot({
    myplot()
  })
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("myplot", Sys.Date(), ".png", sep="")
    },
    content = function(file) {
      png(file=file)
      plot(myplot())
      dev.off()
    }
  )
}

shinyApp(ui, server)

alexra · December 11, 2020, 8:24am

Dear nirgrahamuk,
thanks a lot for your example, that worked very nicely. Although I was sure I tested something like this yesterday. The only difference I found was the "content" part in the downloadHandler section. Nevertheless, you helped me a lot. Many thanks
Alex

system · December 18, 2020, 8:24am

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.