How to update selectizeInput using values from a filtered reactive dataframe?-CodePudding

In my shiny app, I need to filter the data according to:

Date
Parameter

But not all parameters are available for all dates, so once date is selected I need to update the list of parameters available.

MRE:

# Libraries
library(shiny)
library(bslib)
library(plotly)
library(modeldata)
library(DataExplorer)
library(tidyverse)
library(ggplot2)
library(httr)
library(jsonlite)
library(data.table)
library(tidyjson)
library(dplyr)
require(reshape2)
library(purrr)
library(sp)
library(leaflet)
library(RColorBrewer)
library(shinyWidgets)
library(conflicted)

# Make API call to get locations
res1 <- GET("http://environment.data.gov.uk/water-quality/id/sampling-point?&area=1-1") # area=1-1: East Anglia # nolint
data1 <- fromJSON(rawToChar(res1$content), flatten = TRUE)
items1 <- data1$items
coords <- select(items1, c("notation", "label", "lat", "long"))
df1 <- data.frame(coords)

# Make API call to get data for all locations in df1
ids <- df1$notation
url <- "http://environment.data.gov.uk/water-quality/data/measurement?"
df2 <- data.frame()
for (id in ids) {
  res2 <- GET(url = url, query = list(samplingPoint = toString(id))) # nolint
  data2 <- fromJSON(rawToChar(res2$content), flatten = TRUE)
  items2 <- data2$items
  values <- select(items2, c("sample.samplingPoint.notation", "sample.samplingPoint.label", "sample.sampleDateTime", "determinand.label", "result", "determinand.unit.label")) # nolint
  df <- data.frame(values)
  df2 <- rbind(df2, df)
}

# Change df2 colnames
colnames(df2) <- c("notation", "label", "date", "determinand", "value", "unit")

# Add lat and long values to df2 from df1
temp <- left_join(df1,df2, on='notation')
master <- data.table(temp[, c("notation","label","lat","long","date","determinand","value","unit")])
determinands <- as.vector(unique(master$determinand))


# Shiny app
ui <- fluidPage(
  titlePanel("Environment Agency sampling sites in East Anglia"),
  hr(),
  sidebarLayout(
    sidebarPanel(
      h4("Select the date:"),
      tags$head(tags$style('.selectize-dropdown {z-index: 10000}')),
      sliderInput("date", "Date", min=as.Date(min(master$date)), max=as.Date(max(master$date)), value=as.Date(min(master$date))),
      hr(),
      h4("Select the determinand:"),
      selectizeInput("select", "Determinand", choices = sort(determinands), options=NULL, multiple=FALSE)
    ),
    mainPanel(
      h4("Output:"), 
      textOutput("points"),
      leafletOutput("mymap")
    )
  )
)

server <- function(input, output, session) {
  
  # Filter data according to determinand and time
  data <- reactive({
    master[master$determinand==input$select & master$date==input$date]
  })
  
  # Update dropdown menu with list of available determinands for the selected date
  observeEvent(input$date, 
               {possible_determinands <- master[master$determinand==input$select & master$date==input$date, "determinand"] 
                updateSelectizeInput(session, "select", choices=possible_determinands, server=TRUE)}
               )
  
  points <- reactive({nrow(data())})
  
  output$points <- renderText({paste(points(), "sites available out of", length(unique(master$label)))})
  
  output$mymap <- renderLeaflet({
    
    # Check if dataframe is empty
    if(points()>0){
    
      binpal <- colorBin("RdBu", data()$value, n=5, pretty=TRUE) 
      radius=200*data()$value
      leaflet() %>%
      addTiles() %>%
      addRectangles(
        lng1=1.5, lat1=51.3,
        lng2=-1.5, lat2=53.3,
        fillColor = "transparent",
        color="#000000",
        weight=2,
        opacity=1
        ) %>%
      addCircles(lng=data()$long,lat=data()$lat, radius=radius, color=binpal(data()$value), label=data()$label, opacity=1, fillOpacity=0.5) %>%
      addLegend("bottomright", pal=binpal, values=data()$value, opacity=1)
    } 
    
    else {
      
      radius=100
      leaflet() %>%
      addTiles() %>%
      addRectangles(
        lng1=1.5, lat1=51.3,
        lng2=-1.5, lat2=53.3,
        fillColor = "transparent",
        color="#000000",
        weight=2,
        opacity=1
      ) %>%
        addCircles(lng=master$long,lat=master$lat, radius=radius, color="#000000", label=master$label, opacity=1, fillOpacity=0.5) 
    }
    
  })
}

runApp(shinyApp(ui, server))

However, if I run this, R complains saying: Warning: Error in : Operation not allowed without an active reactive context.

When calling choices=..., how can I reference the updated list of unique parameters available?

EDIT

Using

observe({ updateSelectizeInput(session, "select", choices=unique(mydata()$parameter), server=TRUE) })

returns an empty dropdown menu when launching the app.

CodePudding user response：

You need to add an observer to tell the updateSelectizeInput function when to update. In your case, it probably makes sense to listen to changes in data.

observeEvent(data(), {
    updateSelectizeInput(session, "select", choices=data()$parameter, server=TRUE)
})

However, you need to make sure that you don't run into loops (because select gets updated, data gets updated etc.) I'm not sure if this is the case for your example. If yes and the calculation of data is not too expensive, you can directly do it in the observer and just listen to changes in input$date:

observeEvent(input$date, {
  possible_params <- mydata[mydata$parameter==input$select & mydata$date==input$date,
                            "parameter"]
  updateSelectizeInput(session, "select", choices=possible_params, server=TRUE)
})

CodePudding user response：

I'm thinking about this empty dropdown menu and I think the problem could be with this:

selectizeInput("select", "Parameter", choices = sort(parameters), options=NULL, multiple=FALSE)

connected with this:

data <- reactive({
    mydata[mydata$parameter==input$select & mydata$date==input$date]
  })

observe({ updateSelectizeInput(session, "select", choices=unique(mydata()$parameter), server=TRUE) })

Because you said you want to filter the data based on date and show only parameters linked to this date. But what you actually do is you are filtering data based on date AND parameter, so - as I think - you don't need this mydata$parameter==input$select (EDIT: I understand you may need to filter the dataset by parameter, but I think you need at least two steps - one to filter dataset only by date to display limited set of parameters and then filer again [already filterd dataset by date] the dataset by chosen parameter).

It also feels somehow quite bad that you are trying to update dropdown menu based on the values chosen in the same dropdown menu (because you are updating selectizeInput with id "select" and uses the same selectizeInput with id "select" to filter the dataset and display new values in the same selectizeInput with id "select")