2017-01-30 10 views
0

Ich habe Schwierigkeiten herauszufinden, wie zu subset, dann "un-subset" ein reaktiver Datensatz basierend auf einer Reihe von Eingaben mit updateSelectInput() oder updateSelectizeInput(). Ich versuche, die Benutzer eine Auswahl aus einer ausgewählten Eingabe in keiner bestimmten Reihenfolge auszuwählen und dann die Optionen zu aktualisieren, die sie in einer zweiten, dritten, vierten, fünften usw. Auswahleingabe basierend auf den Werten im reaktiven Dataset auswählen können ... und zeigen Sie die aktualisierte Datentabelle an. Ich arbeite mit Daten über Boote, Länder, Häfen und Daten. Ich kann die Funktionalität erhalten, die ich durchbohren möchte, aber die Auswahl von Optionen setzt die Eingabeauswahl nicht zurück. Ich habe ein paar Stunden damit verbracht, ein reproduzierbares Beispiel mit gefälschten Daten zu machen. Sie sollten mein Beispiel ausführen können, indem Sie in ein R-Abschriftdokument kopieren und einfügen. Code zieht Daten von meinem GitHub. Ich hoffe, dass jemand dieses Problem vorher hatte und mir helfen kann. Ich würde gerne deine Gedanken hören. Danke, NateSelectInput nicht mit updateSelectInput in Shiny zurücksetzen

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

Antwort

0

Der Deal mit Ihrem Code ist, dass Sie alle diese „updateSelectizeInput“ Linien nicht brauchen. Flexdashboard benötigt auch keine UI-Elemente wie "uiOutput". Wenn Sie nur den Code schreiben, wird das Objekt wie gewünscht angezeigt, ohne dass Sie der App mitteilen müssen, dass es sich um eine UI- oder Server-Art handelt. Der Code, der für mich funktionierte, ist oben für dich, damit du dich anpassen kannst (ich habe etwas unterdrückt). Ich fügte zwei andere Arten der Auswahl hinzu, weil ich denke, dass sie hübscher sind:

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

Ich gebe diesem einen Wirbel. Danke für das Antworten! Prost, Nate – nate

Verwandte Themen