2017-01-30 2 views
0

updateSelectInput()またはupdateSelectizeInput()を使用して、一連の入力に基づいて反応性データセットのサブセット化、サブセット解除の方法を理解するのが難しいです。私はユーザーが特定の順序で選択入力から選択肢のいずれかを選択できるようにしようとしています。次に、反応データセットの値に基づいて入力を2番目、3番目、4番目、5番目などで選択できるオプションを更新します更新されたデータテーブルを表示します。私はボート、国、港、日付に関するデータを扱っています。私は掘り下げたい機能を得ることができますが、オプションを選択解除しても入力の選択肢はリセットされません。私はfakeデータで再現可能な例を作るために数時間を費やしました。 Rマークダウン文書をコピーして貼り付けることで、私の例を実行できるはずです。コードは私のGitHubからデータを引き出します。誰かがこの問題を以前に持っていて、私を助けてくれることを願っています。私はあなたの考えを聞くのが大好きです。ありがとう、ネイトSelectInputがShinyのupdateSelectInputでリセットされない

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

答えて

0

このコードは、この "updateSelectizeInput"行のすべてを必要としないということです。また、flexdashboardは "uiOutput"のようないくつかのUI要素を必要としません。コードを書くだけで、アプリケーションをUIやサーバーの種類のものに伝える必要なく、オブジェクトが必要に応じて表示されます。私のために働いたコードは、あなたが適応するためのものです(私は一生懸命にしました)。私は彼らがもっときれいだと思うので、私は2つの選択方法を追加しました:

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

私はこれを旋風にします。お返事ありがとうございます!乾杯、ネイト – nate

関連する問題