Reactivity of graph relating to two selectinput items where one is dependent on the other

shiny
,
1

Hi,

I am struggling to sort out the reactive elements of a small dashboard where two selectinput items (1) substance and (2) compartment are required to select data that is then graphed. The substance name is taken from a table (subs_summary) that includes its name (subs_name), id (subs_id) and a whole bunch of other attributes (I have only provided 2 for the example). The tables are stored in an RSQLite database. The compartment comes from a table (subs_cdf) which stores the id (subs_id), compartment and percentiles data (P1 ... P100, I have only provided 4 for the reprex). In order to populate the compartment selectinput we need to lookup the subs_id in the subs_summary table for the selected substance first.

The selectinput drop downs are defined as uiOutput in the UI which I understand are reactive. The observeevent is working for the compartment drop down as it updates appropriately for the substance selected ... the issue is that the graph does not react to the drop down selections. It seems input$compartment.select is not being picked up as if I req(input$compartment.select) the graph never displays and if I drop this then it doesn't plot giving me an error of "Query requires 2 params; 1 supplied". If I try and put the data prep statements within a reactive function I get an unbounded query error.

Any help/suggestions would be greatly appreciated as I am going round the houses on this one.

Thanks in advance
Greg


library(shiny)
library(RSQLite)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(plotly)

#Make some dummy data
subs.summary <- as.data.frame(list(subs_id = c(1, 2), subs_name = c("Substance1", "Substance2")))
subs.cdf <- as.data.frame(list(subs_id = c(1, 1, 2,2), compartment=c("sw", "rw", "sw", "lw")))
subs.cdf$P1 <- seq.int(1,0.7,-0.1)
subs.cdf$P2 <- seq.int(2,1.25,-0.25)
subs.cdf$P3 <- seq.int(2,0.5,-0.5)
subs.cdf$P4 <- seq.int(4,1,-1)
dbconn <- dbConnect(RSQLite::SQLite(), "c:/temp/test.db")
dbWriteTable(conn = dbconn, name = 'subs_summary', value = subs.summary, row.names = FALSE, header = TRUE, overwrite = TRUE)
dbWriteTable(conn = dbconn, name = 'subs_cdf', value = subs.cdf, row.names = FALSE, header = TRUE, overwrite = TRUE)

#UI
ui <- fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("substance.select"),
      uiOutput("compartment.select")
    ),
    mainPanel(
        tabsetPanel(
        tabPanel("CDF",
          plotlyOutput(outputId = 'cdfp1', width='100%', height='600px' )       
        ),
      )
    )
  )
)

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

  dbconn <- dbConnect(RSQLite::SQLite(), "c:/temp/test.db")
  subs.names <- dbGetQuery(dbconn,'SELECT subs_name FROM subs_summary')
  
    output$substance.select <- renderUI ({ 
      selectInput(inputId = "substance.select",label = "Substance selection",
                  choices = subs.names, selected = subs.names$subs_name[1])
    })  
    
    output$compartment.select <- renderUI ({ 
      req(input$substance.select)
      subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(input$substance.select))[1, 1]
      compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
      selectInput(inputId = "compartment.selected",label = "Compartment selection",
                  choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
    })    

    observeEvent(input$substance.select, {
      subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = input$substance.select)[1, 1]
      compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
      updateSelectInput(session, "compartment.select", choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
    })
    
    output$cdfp1 <- renderPlotly({
      #req(input$substance.select)
      #req(input$compartment.select)
      
      subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(input$substance.select))[1, 1]
      subs.cdf.selected <- dbGetQuery(dbconn, 'SELECT * FROM subs_cdf WHERE subs_id = ? AND compartment = ?', params = c(subs.id.selected, input$compartment.select))
      subs.cdf.selected.t <- as.data.frame(t(subs.cdf.selected[,3:6])) %>% dplyr::rename("conc" = "V1")
      subs.cdf.selected.t$prob <- seq.int(0.1,0.4,0.1)
      print(subs.cdf.selected.t) 
      
      cdf1 <- ggplot(cdf_data, aes(x = conc, y = prob)) +
              geom_line() +
              labs(x = "Concentration (µg/L)", y = "Probability")
    
      ggplotly(cdf1)  
    })  
  
}

shinyApp(ui, server)```
2

is the database a critical element of this issue or could you mock it away for the sake of reproducibility ? as I doubt I can get access (or want to have access) to your database.

3

Hi,

Here is an updated version of the code: (i) I have removed the dbconn in the server section as this was not necessary. The create dummy data section before the UI section will create a version of the db with dummy data wherever you path it to; (ii) includes updates from tinkering this weekend. The graph will finally load but there are errors while loading (Query requires 2 params; 1 supplied. and Query needs to be bound before fetching) ... which suggests that I haven't implemented the reactivity appropriately.

Thanks for your help.

library(shiny)
library(RSQLite)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(plotly)

#Make some dummy data
subs.summary <- as.data.frame(list(subs_id = c(1, 2), subs_name = c("Substance1", "Substance2")))
subs.cdf <- as.data.frame(list(subs_id = c(1, 1, 2,2), compartment=c("sw", "rw", "sw", "lw")))
subs.cdf$P1 <- seq.int(1,0.7,-0.1)
subs.cdf$P2 <- seq.int(2,1.25,-0.25)
subs.cdf$P3 <- seq.int(2,0.5,-0.5)
subs.cdf$P4 <- seq.int(4,1,-1)
dbconn <- dbConnect(RSQLite::SQLite(), "c:/temp/test.db")
dbWriteTable(conn = dbconn, name = 'subs_summary', value = subs.summary, row.names = FALSE, header = TRUE, overwrite = TRUE)
dbWriteTable(conn = dbconn, name = 'subs_cdf', value = subs.cdf, row.names = FALSE, header = TRUE, overwrite = TRUE)

#UI
ui <- fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("substance.select"),
      uiOutput("compartment.select")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("CDF",
                 plotlyOutput(outputId = 'cdfp1', width='100%', height='600px' )       
        ),
      )
    )
  )
)

#Server
server <- function(input, output, session) {
  
  subs.names <- dbGetQuery(dbconn,'SELECT subs_name FROM subs_summary')
  
  output$substance.select <- renderUI ({ 
    selectInput(inputId = "substance.select",label = "Substance selection",
                choices = subs.names, selected = subs.names$subs_name[1])
  })  
  
  output$compartment.select <- renderUI ({ 
    subs.name.selected <- input$substance.select
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(subs.name.selected))[1, 1]
    compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
    selectInput(inputId = "compartment.select",label = "Compartment selection",
                choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
  })    
  
  observeEvent(input$substance.select, {
    subs.name.selected <- input$substance.select
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = subs.name.selected)[1, 1]
    compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
    updateSelectInput(session, "compartment.select", choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
  })
  
  output$cdfp1 <- renderPlotly({
    subs.name.selected <- input$substance.select
    compartment.name.selected <- input$compartment.select
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(subs.name.selected))[1, 1]
    subs.cdf.selected <- dbGetQuery(dbconn, 'SELECT * FROM subs_cdf WHERE subs_id = ? AND compartment = ?', params = c(subs.id.selected, compartment.name.selected))
    subs.cdf.selected.t <- as.data.frame(t(subs.cdf.selected[,3:6])) %>% dplyr::rename("conc" = "V1")
    subs.cdf.selected.t$prob <- seq.int(0.1,0.4,0.1)

    cdf1 <- ggplot(subs.cdf.selected.t, aes(x = conc, y = prob)) +
      geom_line() +
      labs(x = "Concentration (µg/L)", y = "Probability")
    
    ggplotly(cdf1)  
  })  
  
}

shinyApp(ui, server)
4

The solution is the appropriate use of req() or equivalent.
read about it here ... req() from mastering-shiny

the code :

library(shiny)
library(RSQLite)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(plotly)

#Make some dummy data
subs.summary <- as.data.frame(list(subs_id = c(1, 2), subs_name = c("Substance1", "Substance2")))
subs.cdf <- as.data.frame(list(subs_id = c(1, 1, 2,2), compartment=c("sw", "rw", "sw", "lw")))
subs.cdf$P1 <- seq.int(1,0.7,-0.1)
subs.cdf$P2 <- seq.int(2,1.25,-0.25)
subs.cdf$P3 <- seq.int(2,0.5,-0.5)
subs.cdf$P4 <- seq.int(4,1,-1)
dbconn <- dbConnect(RSQLite::SQLite(), "")
dbWriteTable(conn = dbconn, name = 'subs_summary', value = subs.summary, row.names = FALSE, header = TRUE, overwrite = TRUE)
dbWriteTable(conn = dbconn, name = 'subs_cdf', value = subs.cdf, row.names = FALSE, header = TRUE, overwrite = TRUE)

#UI
ui <- fluidPage(
  titlePanel("Title"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("substance.select"),
      uiOutput("compartment.select")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("CDF",
                 plotlyOutput(outputId = 'cdfp1', width='100%', height='600px' )       
        ),
      )
    )
  )
)

#Server
server <- function(input, output, session) {
  
  subs.names <- dbGetQuery(dbconn,'SELECT subs_name FROM subs_summary')
  
  output$substance.select <- renderUI ({ 
    selectInput(inputId = "substance.select",label = "Substance selection",
                choices = subs.names, selected = subs.names$subs_name[1])
  })  
  
  output$compartment.select <- renderUI ({ 
    subs.name.selected <- req(input$substance.select)
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(subs.name.selected))[1, 1]
    compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
    selectInput(inputId = "compartment.select",label = "Compartment selection",
                choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
  })    
  
  observeEvent(input$substance.select, {
    subs.name.selected <- input$substance.select
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = subs.name.selected)[1, 1]
    compartments.subs.selected <- dbGetQuery(dbconn, 'SELECT compartment FROM subs_cdf WHERE subs_id = ?', params = subs.id.selected)
    updateSelectInput(session, "compartment.select", choices = compartments.subs.selected, selected = compartments.subs.selected$compartment[1])
  })
  
  output$cdfp1 <- renderPlotly({
    subs.name.selected <- req(input$substance.select)
    compartment.name.selected <- req(input$compartment.select)
    subs.id.selected <- dbGetQuery(dbconn, 'SELECT subs_id FROM subs_summary WHERE subs_name = ?', params = c(subs.name.selected))[1, 1]
    subs.cdf.selected <- dbGetQuery(dbconn, 'SELECT * FROM subs_cdf WHERE subs_id = ? AND compartment = ?', params = c(subs.id.selected, compartment.name.selected))
    step_1 <- as.data.frame(t(subs.cdf.selected[,3:6]))
    req(isTruthy(names(step_1)>0))
    subs.cdf.selected.t <- step_1 %>% dplyr::rename("conc" = "V1")
    subs.cdf.selected.t$prob <- seq.int(0.1,0.4,0.1)
    
    cdf1 <- ggplot(subs.cdf.selected.t, aes(x = conc, y = prob)) +
      geom_line() +
      labs(x = "Concentration (µg/L)", y = "Probability")
    
    ggplotly(cdf1)  
  })  
  
}

shinyApp(ui, server)
5

This topic was automatically closed 54 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.