Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
317 views
in Technique[技术] by (71.8m points)

r - Use checkboxGroupInput in Shiny to make selectable plots from one tibble with plot_grid

I'm trying to make a Shiny app which will take an uploaded CSV file and convert it into a tibble and then make a series of plots with the same X but using different columns for Y data, one per plot. I want the user to be able to use check boxes to select which plots they want to display and plot the result using plot_grid.

So far I managed to get the script to render the plots the way I want them and to draw them all on the fly from plot_grid if I name them manually. I'm having trouble including checkboxGroupInput output as an input for plot_grid, the characted vector returned cannot be used as a grob object. Here's the relevant code:

ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
    sidebarPanel(
                 #Select which plots will be displayed
                 checkboxGroupInput(inputId = "whichPlot",
                                    label = "Select data to plot",
                                    choices = c("Temperature" = "tempChart()",
                                                "Pressure" = "pressureChart()",
                                                "Dissolved Oxygen" = "airsat()",
                                                "pH" = "phChart()",
                                                "Air flow" = "airChart()",
                                                "Oxygen flow" = "O2Chart()"),
                                   selected = "Temperature"),
                 #Select time scale
                 selectInput("timeScale",
                              "Choose time scale to plot",
                              choices = c("Minutes",
                                          "Hours",
                                          "Days"),
                             selected = "Minutes"),
                 #Apply button to make graphs
                 actionButton("DoIt", "Plot data"),
                 br(),
                
    ),
                
    mainPanel( 
              plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
              textOutput("tableTitle"),
              tableOutput("table"),
              textOutput("selection"),
              tableOutput("dataSummary")
              
              
              ) 
    )
)   

server <- function(input, output) {

    #A dummy tibble that I use for testing. will be replaced by Load button
   dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
                temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
                pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
                airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
                level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
                mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
   output$table <- renderTable(head(dataDF))

   #This changes the X axis scale and works well
        colsel <- reactive({
    switch(input$timeScale,
                      "Minutes" = 13,
                      "Hours" = 14,
                      "Days" = 15)
        })
           dataT <- reactive({
              df <-dataDF[, 3:8]
              df$runTime = pull(dataDF, colsel())
              df
           })


     #A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
                    head(dataT())})

     #Create a list of plots to be drawn from the checkboxes
plots <- reactive({
        paste(input$whichPlot, sep = ",")
     })

#save all the plots to individual objects to be chosen from later
  
     airChart <- reactive({
        ggplot(dataT(), aes(x = runTime, y = airflow))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(0, 1)
     })

     tempChart <- reactive({
        ggplot (dataT(), aes(runTime, temp))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(15, 45)
     })

     airsat <- reactive({
        ggplot(dataT(), aes(runTime, pO2))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(80, 100)
     })


     phChart <- reactive({
        ggplot(dataT(), aes(runTime, pH))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = "pH")+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(1,15)
     })


     O2Chart <- reactive({
        ggplot(dataT(), aes(runTime, O2flow))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(0,10)
     })


     pressureChart <- reactive({
        ggplot(dataT(), aes(runTime, pressure))+
             geom_line(size = 1, color = "#00B388")+
             labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
             scale_x_continuous(breaks = breaks_extended(n = 10))+
             ylim(0,220)
     })

#Plot my charts
observeEvent(input$DoIt,{
       output$plot <- renderPlot({
               (plot_grid(plots(), ncol = 2, labels = "auto"))
})

})  
}
shinyApp(ui = ui, server = server)

When I try to use it, I get an error

Warning in as_grob.default(plot) : Cannot convert object of class character into a grob. Warning in grid.echo.recordedplot(dl, newpage, prefix) : No graphics to replay

If I replace the last line with

output$plot <- renderPlot({
               (plot_grid(tempChart(), airsat(), O2Chart(), pressureChart(), ncol = 2, labels = "auto"))

it works just fine. I'm not sure if there's a way to bypass the character to grob issue or if I'm making it unnecessarily too difficult. I looked at other solutions with if (which I don't fully understand) but I don't think they'll help here. It's my first contact with Shiny, so don't be too harsh please.

question from:https://stackoverflow.com/questions/66048682/use-checkboxgroupinput-in-shiny-to-make-selectable-plots-from-one-tibble-with-pl

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

I'd use a different strategy here. Instead of storing every plot separately in a reactive, you can store them all in one list. Here I used a reactiveValues object that gets updated via an observeEvent. (In principal, you could even use a simple list to store the plots, because in your case the reactivity comes from the observeEvent. Using reactiveValues allows you to use single plots outside the cowplot with reactivity.)

Then you can use input$whichPlot just to index the list of plots. Also, putting an output$plot <- renderPlot inside an observeEvent isn't usually considered good practice, because renderPlot itself already has reactivity.

In order to only update the plot when input$DoIt is pressed, I use the bindEvent from the brand new shiny 1.6.0.

library(shiny)
library(cowplot)
library(ggplot2)
library(scales)
library(dplyr)

ui <- fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
      #Select which plots will be displayed
      checkboxGroupInput(inputId = "whichPlot",
                         label = "Select data to plot",
                         choices = c("Temperature" = "temperature",
                                     "Pressure" = "pressure",
                                     "Dissolved Oxygen" = "dissolved_oxygen",
                                     "pH" = "ph",
                                     "Air flow" = "air_flow",
                                     "Oxygen flow" = "oxygen_flow"),
                         selected = "Temperature"),
      #Select time scale
      selectInput("timeScale",
                  "Choose time scale to plot",
                  choices = c("Minutes",
                              "Hours",
                              "Days"),
                  selected = "Minutes"),
      #Apply button to make graphs
      actionButton("DoIt", "Plot data"),
      br(),
      
    ),
    
    mainPanel( 
      plotOutput("plot"),
      #the outputs below are not necessary, I just use them to see if I'm going in the right direction
      textOutput("tableTitle"),
      tableOutput("table"),
      textOutput("selection"),
      tableOutput("dataSummary")
      
      
    ) 
  )
)   

server <- function(input, output) {
  
  #A dummy tibble that I use for testing. will be replaced by Load button
  dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
                   temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
                   pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
                   airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
                   level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
                   mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
  output$table <- renderTable(head(dataDF))
  
  #This changes the X axis scale and works well
  colsel <- reactive({
    switch(input$timeScale,
           "Minutes" = 13,
           "Hours" = 14,
           "Days" = 15)
  })
  dataT <- reactive({
    df <-dataDF[, 3:8]
    df$runTime = pull(dataDF, colsel())
    df
  })
  
  
  #A control table output to make sure tibble transformation worked (it works!)
  output$dataSummary <- renderTable({
    head(dataT())})
  
  # initialise reactiveValues object
  plots <- reactiveValues(
    temperature = NULL,
    pressure = NULL,
    dissolved_oxygen = NULL,
    ph = NULL,
    air_flow = NULL,
    oxygen_flow = NULL
  )
  
  # the plots only change when dataT or input$timeScale changes
  observeEvent(c(dataT(), input$timeScale), {
    plots$temperature <- ggplot (dataT(), aes(runTime, temp))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(15, 45)
    
    plots$pressure <- ggplot(dataT(), aes(runTime, pressure))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(0,220)
    
    plots$dissolved_oxygen <- ggplot(dataT(), aes(runTime, pO2))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(80, 100)
    
    plots$ph <- ggplot(dataT(), aes(runTime, pH))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = "pH")+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(1,15)
    
    plots$air_flow <- ggplot(dataT(), aes(x = runTime, y = airflow))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(0, 1)
    
    plots$oxygen_flow <- ggplot(dataT(), aes(runTime, O2flow))+
      geom_line(size = 1, color = "#00B388")+
      labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
      scale_x_continuous(breaks = breaks_extended(n = 10))+
      ylim(0,10)
  })
  
  output$plot <- renderPlot({
    premade_plots <- reactiveValuesToList(plots)
    do.call("plot_grid", c(premade_plots[input$whichPlot],
            ncol = 2, labels = "auto"))
  }) %>% 
    bindEvent(input$DoIt) 
}
shinyApp(ui = ui, server = server)

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...