CODEWITHSUNDEEP
rggplot2shinyreactive-programmingshinydashboard
NBE
NBE

Reputation: 651

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

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)

Upvotes: 2

Views: 220

Answers (1)

Vishesh Shrivastav
Vishesh Shrivastav

Reputation: 2129

You can do this by using subset. First, you select only those records where locid is what the user specifies using input$locid to get a reactive dataframe. Next, you subset this dataframe based on HUC14 == input$huc.

Also, see the correct way to generate values for output$huc1 using unique(datasub()$HUC14)

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

  output$locid1<- renderUI({
    selectizeInput("locid","Select Locid",
                   choices = as.character(unique(df$locid)))
  })

  datasub<-reactive({
    foo <- subset(df, locid == input$locid)
    return(foo)
  })

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

  datasub2<-reactive({
    foo <- subset(datasub(), HUC14 == input$huc)
    return(foo)
  })

  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)
  })
}

Upvotes: 3

Related Questions