dynamic UI that allows filters to be updated and plot made in shiny

[KWANGER]

I apologize if this is something very simple ... but I can't seem to figure it out. I have created an app that has a plot that is reactive to 4 drop down menus. The first two drop menus are for the x and y axis ( I have these working fine). The second two are based on unique values in my data frame. I would like these two drop down menus to be reactive to each other and then reactive to the plot. So basically I would like the user to pick a parameter in the first drop down menu then the data frame will be filtered (plot filtered as well) and then also the choices for the second drop down menu would be filtered to the unique matches to the first drop down menu and vise versa. I have tried multiple things but nothing has worked. Any guidance or help would be greatly appreciated!

Sample Data:

 df<-structure(list(stdate = structure(c(16611, 16611, 16615, 16615, 
 14004, 14004, 16616, 16616, 16616, 17485, 17485, 17483, 17483, 
 16678, 16678, 14000, 14000, 17211, 17211, 17210), class = "Date"), 
     sttime = structure(c(37800, 37800, 35100, 35100, 42600, 42600, 
     38700, 38700, 32400, 35400, 35400, 33000, 33000, 49800, 49800, 
     34200, 34200, 37800, 37800, 30600), class = c("hms", "difftime"
     ), units = "secs"), locid = c("USGS-01388500", "USGS-01388500", 
     "USGS-01464585", "USGS-01464585", "USGS-01464515", "USGS-01464515", 
     "USGS-01407330", "USGS-01407330", "USGS-01466500", "USGS-01387500", 
     "USGS-01387500", "USGS-01395000", "USGS-01395000", "USGS-01400860", 
     "USGS-01400860", "USGS-01377000", "USGS-01377000", "USGS-01367625", 
     "USGS-01367625", "USGS-01398000"), Specific_conductance = c(525, 
     525, 184, 184, 226, 226, 203, 203, 41, 674, 674, 466, 466, 
     312, 312, 540, 540, 844, 844, 683), HUC14 = c("HUC02030103110020", 
     "HUC02030103110020", "HUC02040201100030", "HUC02040201100030", 
     "HUC02040201060020", "HUC02040201060020", "HUC02030104070070", 
     "HUC02030104070070", "HUC02040202030070", "HUC02030103100030", 
     "HUC02030103100030", "HUC02030104050060", "HUC02030104050060", 
     "HUC02030105090020", "HUC02030105090020", "HUC02030103170060", 
     "HUC02030103170060", "HUC02020007010010", "HUC02020007010010", 
     "HUC02030105030060"), tds = c(294L, 275L, 119L, 100L, 155L, 
     116L, 155L, 115L, 43L, 403L, 382L, 286L, 274L, 177L, 173L, 
     328L, 277L, 435L, 440L, 347L), Chloride = c(109, 109, 31.9, 
     31.9, 33, 33, 36.4, 36.4, 3.38, 153, 153, 72.6, 72.6, 41.5, 
     41.5, 105, 105, 179, 179, 161)), row.names = c(NA, -20L), class = c("tbl_df", 
 "tbl", "data.frame"), .Names = c("stdate", "sttime", "locid", 
 "Specific_conductance", "HUC14", "tds", "Chloride"))

What I have tried:

library(ggplot2)
library(shiny)
library(shinydashboard)

header<-dashboardHeader()
sidebar<-dashboardSidebar()
body<-dashboardBody(


fluidRow(
    box(width = 12, plotOutput("plot5"))),

fluidRow(
  box(selectInput("x","x",choices = c("tds","Chloride","Specific_conductance"),selected = "Specific_conductance")),
  box(selectInput("y","y",choices =c("tds","Chloride","Specific_conductance") ,selected = "tds")),
  uiOutput("locid1"),
  uiOutput("huc1")))

ui<- dashboardPage(
  header = header,
  sidebar = sidebar,
  body = body
  
)
### Create server of app ###
server<- function(input,output,session){

  output$locid1<- renderUI({
    selectizeInput("locid","Select Locid",
                   choices = as.character(unique(df$locid)))
  })
  
  datasub<-reactive({
    df[df$locid == input$locid,]
  })
  
  output$huc1<- renderUI({
    selectizeInput("huc","Select HUC",
                   choices = unique(datasub()[,"HUC14"]),
                   selected = unique(datasub()[,"HUC14"])[1])
  })
  
  datasub2<-reactive({
    datasub()[df$HUC14 == input$huc,]
  })
  
  
  output$plot5 <- renderPlot({
    ggplot(data= datasub2(),aes_string(x=input$x,y=input$y))+
      geom_point()+
      geom_smooth(method = "lm", se = FALSE) +
      ggtitle(input$locid,input$huc)
  })
}

shinyApp(ui,server)

[hinkelman]

What is roadsalt_corr? I can't run your example without it.

[KWANGER]

Sorry... I forgot to change it to df, the sample dataset. It should work now.

[hinkelman]

In output$huc1, you've run into one of the differences between data frames and tibbles. You can learn more about those differences in the Advanced R book.

Tibbles default to drop = FALSE , and [ will never return a single vector.

By using [[, you can extract a column from a tibble as a vector.

  output$huc1<- renderUI({
    selectizeInput("huc","Select HUC",
                   choices = unique(datasub()[["HUC14"]]),
                   selected = unique(datasub()[["HUC14"]])[1])
  })

For dependent filtering, you might also be interested in the pickerGroup-module from the shinyWidgets package.

[KWANGER]

Thanks for your answer! This solved my problem! Curious though... is there any way to have it work both ways?

[hinkelman]

You can get a vector from a tibble with [ if you include drop = TRUE.

df[,"HUC14", drop = TRUE]

With a data frame, drop = TRUE is the default value and doesn't need to be specified. You can "have it work both ways" if you use data frames instead of tibbles. Tibbles are an opinionated take on data frames and preserving dimensionality is seen as an important feature. Again, quoting from Advanced R:

The default drop = TRUE behaviour is a common source of bugs in functions: you check your code with a data frame or matrix with multiple columns, and it works. Six months later you (or someone else) uses it with a single column data frame and it fails with a mystifying error. When writing functions, get in the habit of always using drop = FALSE when subsetting a 2d object.