简体   繁体   中英

SelectInput not resetting with updateSelectInput in Shiny

I am having difficulty figuring out how to subset, then "un-subset" a reactive dataset based upon a bunch of inputs using updateSelectInput() or updateSelectizeInput() . I am trying to let users pick any of the choices from a select input, in no particular order, then update the options they can pick in a second, third, fourth, fifth, etc. select input based upon the values in the reactive dataset...and show the updated data table. I am working with data about boats, countries, ports, and dates. I can get the functionality I want drilling down, but unselecting options does not reset the input choices. I have spent a couple hours making a reproducible example with fake data. You should be able to run my example by copying and pasting into an R markdown document. Code will pull data from my GitHub. I am hoping someone has had this problem before and can help me. I'd love to hear your thoughts. Thank you, Nate

---
title: "Trying to figure out multiple select inputs"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    social: menu
    source_code: embed
runtime: shiny
---

```{r global, include=FALSE}
# Attach packages
library(dplyr)
library(ggplot2)
library(DT)
library(shiny)
library(flexdashboard)
library(RCurl)
url<- "https://raw.githubusercontent.com/ngfrey/StackOverflowQ/master/dfso2.csv"
x<- getURL(url) 
df<- read.csv(text=x, header = TRUE, row.names = 1)

days_of_week <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
months_of_year <- c("November", "December", "January", "February", "March", "April", "May", "June","July", "August", "September", "October")


df[,c("month", "day_of_week", "boat_id", "port_id", "country_id")]<- lapply(df[,c("month", "day_of_week", "boat_id", "port_id", "country_id")],factor)
df$month<- factor(df$month, levels = months_of_year, ordered = TRUE)
df$day_of_week<- factor(df$day_of_week, levels = days_of_week, ordered = T)
df$date_time<- as.Date(df$date_time)


```


Sidebar {.sidebar}
========================================================================
### Input Selectors
```{r shinyinputs}
# Shiny Inputs for Date Range

# Shiny Inputs for Month, Country, MMSI, Name, Port ID, Port Name

uiOutput("dateRangeUI")
uiOutput("monthUI")
uiOutput("dayofweekUI")
uiOutput("countryUI")
uiOutput("portidUI")
uiOutput("boatUI")

plot_data<- reactive({

  if(!is.null(input$dateRangeIn)){if(nchar(input$dateRangeIn[1]>1)){df<- df[(as.Date(df$date_time) >= input$dateRangeIn[1] & as.Date(df$date_time) <= input$dateRangeIn[2]),] }} # else{df<- df}
  if(!is.null(input$monthIn)){df<- df[df$month %in% input$monthIn,]} # else {df<- df}
  if(!is.null(input$dayofweekIn)){ if(nchar(input$dayofweekIn[1])>1){df<- df[df$day_of_week %in% input$dayofweekIn,]}} # else {df<- df}
  if(!is.null(input$countryIn)){ if(nchar(input$countryIn[1])>1){df<- df[df$country_id %in% input$countryIn,]}} #else {df<- df}
  if(!is.null(input$boatIn)){if(nchar(input$boatIn[1])>1){  df<- df[df$boat_id %in% input$boatIn,]}} #else {df<- df}
  if(!is.null(input$portidIn)){ df<- df[df$port_id %in% input$portidIn,]} #else {df<- df}
  return(df)

})



output$dateRangeUI <- renderUI({dateRangeInput(inputId ="dateRangeIn",label   = 'Date Range:', start = min(df$date_time), end = max(df$date_time))})
output$monthUI  <- renderUI({ selectizeInput("monthIn", "Select Month(s)", choices = unique(df$month), selected = NULL, multiple = TRUE, options = list(placeholder = "Click to Select")) })
output$dayofweekUI  <- renderUI({selectizeInput("dayofweekIn", "Day of Week", choices = unique(df$day_of_week), selected =NULL, multiple = TRUE, options = list(placeholder = "Click to Select"))  })
output$countryUI  <- renderUI({selectizeInput("countryIn", "Select Country", choices = unique(df$country_id), selected = NULL, multiple = TRUE, options = list(placeholder = "Click to Select"))  })
output$portidUI  <- renderUI({selectizeInput("portidIn", "Select Port ID(s)", choices = unique(df$port_id), selected = NULL, multiple = TRUE, options = list(placeholder = "Click to Select"))  })
output$boatUI  <- renderUI({selectizeInput("boatIn", "Select Boat ID(s)", unique(df$boat_id), selected = NULL, multiple = TRUE, options = list(placeholder = "Click to Select"))  })



observeEvent(input$dateRange, {
  updateSelectizeInput(session, "monthIn", choices = unique(plot_data()$month))
  updateSelectizeInput(session, "dayofweekIn", choices = unique(plot_data()$day_of_week))
  updateSelectizeInput(session, "countryIn", choices = unique(plot_data()$country))
  updateSelectizeInput(session, "boatIn", choices = unique(plot_data()$boat_id))
  updateSelectizeInput(session, "portidIn", choices = unique(plot_data()$port_id))
})


observeEvent(input$monthIn, {
  updateDateRangeInput(session, "dateRange", start = min(plot_data()$date_time), end = max(plot_data()$date_time))
  updateSelectizeInput(session, "dayofweekIn", choices = unique(plot_data()$day_of_week))
  updateSelectizeInput(session, "countryIn", choices = unique(plot_data()$country))
  updateSelectizeInput(session, "boatIn", choices = unique(plot_data()$boat_id))
  updateSelectizeInput(session, "portidIn", choices = unique(plot_data()$port_id))
})

observeEvent(input$dayofweekIn, {
  updateDateRangeInput(session, "dateRange", start = min(plot_data()$date_time), end = max(plot_data()$date_time))
  updateSelectizeInput(session, "monthIn", choices = unique(plot_data()$month))
  updateSelectizeInput(session, "countryIn", choices = unique(plot_data()$country))
  updateSelectizeInput(session, "boatIn", choices = unique(plot_data()$boat_id))
  updateSelectizeInput(session, "portidIn", choices = unique(plot_data()$port_id))
})

observeEvent(input$countryIn,{
  updateDateRangeInput(session, "dateRange", start = min(plot_data()$date_time), end = max(plot_data()$date_time))
  updateSelectizeInput(session, "monthIn", choices = unique(plot_data()$month))
  updateSelectizeInput(session, "dayofweekIn", choices = unique(plot_data()$day_of_week))
  updateSelectizeInput(session, "boatIn", choices = unique(plot_data()$boat_id))
  updateSelectizeInput(session, "portidIn", choices = unique(plot_data()$port_id)) 
})

observeEvent(input$portidIn,{
  updateDateRangeInput(session, "dateRange", start = min(plot_data()$date_time), end = max(plot_data()$date_time))
  updateSelectizeInput(session, "monthIn", choices = unique(plot_data()$month))
  updateSelectizeInput(session, "dayofweekIn", choices = unique(plot_data()$day_of_week))
  updateSelectizeInput(session, "countryIn", choices = unique(plot_data()$country))
  updateSelectizeInput(session, "boatIn", choices = unique(plot_data()$boat_id))
})

observeEvent(input$boatIn,{
  updateDateRangeInput(session, "dateRange", start = min(plot_data()$date_time), end = max(plot_data()$date_time))
  updateSelectizeInput(session, "monthIn", choices = unique(plot_data()$month))
  updateSelectizeInput(session, "dayofweekIn", choices = unique(plot_data()$day_of_week))
  updateSelectizeInput(session, "countryIn", choices = unique(plot_data()$country))
  updateSelectizeInput(session, "portidIn", choices = unique(plot_data()$port_id)) 
})







```


Data Overview
===============================================================

Row
-----------------------------------------------------------------------

### Data details

```{r, DT::datatable, fig.height=7}
# Only look at filtered data:
DT::renderDataTable({
  DT::datatable(plot_data(), options = list(scrollX = TRUE, sScrollY = '75vh', scrollCollapse = TRUE), extensions = list("Scroller")) 
  })
#sScrollY = "300px"
```

The deal with your code is that you don't need all of this "updateSelectizeInput" lines. Also, flexdashboard don't require some UI elements, like "uiOutput". Just writing the code will show the object as you want, without the need to tell the app that is an UI or server type of thing. The code that worked for me is above for you to adapt (I supressed somethings). I included two other ways of selection because i think they're prettier:

---
title: "Trying to figure out multiple select inputs"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    social: menu
    source_code: embed
runtime: shiny
---

```{r global, include=FALSE}
# Attach packages
library(dplyr)
library(shiny)
library(flexdashboard)
library(RCurl)

library(shinydashboard)

url<- "https://raw.githubusercontent.com/ngfrey/StackOverflowQ/master/dfso2.csv"
x<- getURL(url) 
df<- read.csv(text=x, header = TRUE, row.names = 1)

days_of_week <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
months_of_year <- c("November", "December", "January", "February", "March", "April", "May", "June","July", "August", "September", "October")

df[,c("month", "day_of_week", "boat_id", "port_id", "country_id")]<- lapply(df[,c("month", "day_of_week", "boat_id", "port_id", "country_id")],factor)
df$month<- factor(df$month, levels = months_of_year, ordered = TRUE)
df$day_of_week<- factor(df$day_of_week, levels = days_of_week, ordered = T)
df$date_time<- as.Date(df$date_time)


```


Page 
========================================================================
Row {.sidebar}
-----------------------------------------------------------------------

```{r shinyinputs}
# Shiny Inputs for Date Range

# Shiny Inputs for Month, Country, MMSI, Name, Port ID, Port Name

dateRangeInput(inputId ="dateRangeIn",
                                               label   = 'Date Range:', 
                                               start = min(df$date_time), 
                                               end = max(df$date_time))

selectizeInput("monthIn", 
                                             choices = unique(df$month), 
                                             selected = "", 
                                             label = "Month")

checkboxGroupInput("dayofweekIn", "Day of Week", 
                                                choices = unique(df$day_of_week), 
                                                selected ="")  

selectizeInput("dayofweekIn", "Day of Week", choices = unique(df$day_of_week), selected =NULL, multiple = TRUE, options = list(placeholder = "Click to Select")) 

```


```{r}

plot_data<- reactive({

  if(!is.null(input$dateRangeIn)){if(nchar(input$dateRangeIn[1]>1)){df<- df[(as.Date(df$date_time) >= input$dateRangeIn[1] & as.Date(df$date_time) <= input$dateRangeIn[2]),] }} # else{df<- df}
  if(!is.null(input$monthIn)){df<- df[df$month %in% input$monthIn,]} # else {df<- df}
  if(!is.null(input$dayofweekIn)){ if(nchar(input$dayofweekIn[1])>1){df<- df[df$day_of_week %in% input$dayofweekIn,]}} # else {df<- df}
  if(!is.null(input$countryIn)){ if(nchar(input$countryIn[1])>1){df<- df[df$country_id %in% input$countryIn,]}} #else {df<- df}
  if(!is.null(input$boatIn)){if(nchar(input$boatIn[1])>1){  df<- df[df$boat_id %in% input$boatIn,]}} #else {df<- df}
  if(!is.null(input$portidIn)){ df<- df[df$port_id %in% input$portidIn,]} #else {df<- df}
  return(df)

})



```



Row {.tabset, data-width=600}
-----------------------------------------------------------------------
### Data
```{r, DT::datatable, fig.height=7}
# Only look at filtered data:
DT::renderDataTable({
  DT::datatable(plot_data(), options = list(scrollX = TRUE, sScrollY = '75vh', scrollCollapse = TRUE), extensions = list("Scroller")) 
  })
#sScrollY = "300px"
```

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM