繁体   English   中英

SelectInput不使用Shiny中的updateSelectInput重置

[英]SelectInput not resetting with updateSelectInput in Shiny

我很难弄清楚如何使用updateSelectInput()updateSelectizeInput()基于一堆输入来对反应数据集进行子集化然后“取消子集化”。 我试图让用户以不特定的顺序从选择输入中选择任何选项,然后更新他们可以在第二,第三,第四,第五等中选择的选项。根据反应性数据集中的值选择输入...并显示更新的数据表。 我正在处理有关船只,国家,港口和日期的数据。 我可以获得要深入研究的功能,但是取消选择选项不会重置输入选项。 我已经花了几个小时用虚假数据制作了可复制的示例。 您应该能够通过复制并粘贴到R markdown文档中来运行我的示例。 代码将从我的GitHub中提取数据。 我希望有人曾经遇到过这个问题,可以为我提供帮助。 我很想听听您的想法。 谢谢你,内特

---
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"
```

处理您的代码的是,您不需要所有这些“ updateSelectizeInput”行。 另外,flexdashboard不需要一些UI元素,例如“ uiOutput”。 只需编写代码即可显示所需的对象,而无需告诉应用程序是UI还是服务器类型的东西。 对我有用的代码在上面,您可以修改(我禁止了某些东西)。 我包括了另外两种选择方式,因为我认为它们更漂亮:

---
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"
```

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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