Shiny: Bedingte Panel und bedingte Liste von checkboxGroupInput

Question

Ich möchte eine glänzende App für die Planung der neuesten PollstR Charts von US-Präsidentschaftsvorwahlen erstellen. Benutzer sollten in der Lage sein, eine Partei (Dem oder Rep), die Kandidaten und die Staaten, in denen die Vorwahlen (oder Caucusus) stattfanden, auszuwählen.

Ich habe drei Probleme:

1. Basierend auf der ausgewählten Partei (Dem oder Rep), Benutzer die nächste checkboxGroupInput bekommen sollte, wo nur die demokratischen oder republikanischen Kandidaten erscheinen. Ich versuche das mit einem conditionalPanel zu lösen. Allerdings kann ich "Candidate" nicht zweimal als Name für das Widget verwenden (später im Server.R Ich brauche Eingabe $ Candidate). Wie kann ich das lösen?

2. Basierend auf der ausgewählten Partei (wieder Dem oder Rep), sollten die Benutzer eine Liste aller Zustände erhalten, in denen bisher Primar- und Caucus-Zustände stattfanden. Im Moment liste ich alle US-Bundesstaaten auf, die ich zuvor definiert habe (und daher bekomme ich Fehler, wenn ich die Ergebnisse von Staaten darstellen will, wo keine Umfragen verfügbar sind). Gibt es eine Möglichkeit, die Liste der Zustände aus dem Dataset zu erhalten, die im Server.R Teil generiert wird (es heißt dort $ State, aber ich kann es nicht verwenden, weil das ui.R jetzt nicht "abfragt") .

3. Ich plotte die Ergebnisse als Balkendiagramme mit ggplot und der facet_wrap-Funktion (mit zwei Spalten). Je mehr Staaten ich wähle, desto kleiner werden die Plots. Gibt es eine Möglichkeit, die Höhe der Diagramme festzulegen und eine vertikale Bildlaufleiste im Hauptfenster einzufügen? Hier

ist der Code für die Benutzeroberfläche:

shinyUI(fluidPage(
    titlePanel("2016 Presidential primaries"), 

    sidebarLayout(position = "right", 
      sidebarPanel(
        helpText("Choose between Democratic (Dem) and Republican (Rep) 
          Primaries and Caucuses:"), 

        selectInput("party", 
           label = "Dem or Rep?", 
           choices = c("Dem", "Rep", 
           selected = "Dem")), 

        conditionalPanel(
          condition = "input.party == 'Dem'", 
          checkboxGroupInput("Candidate", label = h4("Democratic Candidates"), 
               choices = list("Clinton" = "Clinton", "Sanders" = "Sanders"), 
               selected = NULL)), 

        conditionalPanel(
          condition = "input.party == 'Rep'", 
          checkboxGroupInput("Candidate", label = h4("Republican Candidates"), 
               choices = list("Bush" = "Bush", "Carson" = "Carson", "Christie" = "Christie", 
                   "Cruz" = "Cruz", "Kasich" = "Kasich", "Rubio" = "Rubio", 
                   "Trump" = "Trump"), 
               selected = NULL)), 

        checkboxGroupInput("state", 
          label = "Select State", 
          choices = states, 
          inline = TRUE, 
          selected = NULL) 
      ), 

      mainPanel(
        tabsetPanel(
          tabPanel("Plot", plotOutput("plot")), 
          tabPanel("Table", tableOutput("table")) 
        ) 
      ) 


    ) 
)) 

Und hier der Code für die server.R:

### getting and cleaning the data for the shiny app----------------------------- 

# load pollstR-package to get Huffpost opinion polls 
require(pollstR) 

# load dplyr and tidyr for data wrangling 
require(dplyr) 
require(tidyr) 

# load ggplot2 for plotting 
require(ggplot2) 

# download 2016 GOP presidential primaries 
repPoll <- pollstr_charts(topic='2016-president-gop-primary', showall = TRUE) 

# extract and combine columns needed 
choice <- repPoll$estimates$choice 
value <- repPoll$estimates$value 
election <- repPoll$estimates$slug 
party <- repPoll$estimates$party 

rep.df <- data_frame(election, choice, value, party) 


# extract and combine slug and state info to add list of US state abbreviations 
election <- repPoll$charts$slug 
state <- repPoll$charts$state 

r.stateAbb <- data_frame(election, state) 

# join both data frames based on slug 
rep.df <- left_join(rep.df, r.stateAbb, by = "election") 

## download 2016 DEM presidential primaries 
demPoll <- pollstr_charts(topic='2016-president-dem-primary', showall = TRUE) 

# extract and combine columns needed 
choice <- demPoll$estimates$choice 
value <- demPoll$estimates$value 
election <- demPoll$estimates$slug 
party <- demPoll$estimates$party 

dem.df <- data_frame(election, choice, value, party) 

# extract and combine slug and state info to add list of US state abbreviations 
election <- demPoll$charts$slug 
state <- demPoll$charts$state 

d.stateAbb <- data_frame(election, state) 

# join both data frames based on slug 
dem.df <- left_join(dem.df, d.stateAbb, by = "election") 

# combine dem and rep datasets 
polls <- bind_rows(dem.df, rep.df) 

polls$party <- as.factor(polls$party) 
polls$state <- as.factor(polls$state) 
polls$choice <- as.factor(polls$choice) 


shinyServer(function(input, output) { 

     df <- reactive({ 
       polls %>% filter(party %in% input$party) %>% filter(choice %in% input$Candidate) %>% 
         filter(state %in% input$state) 
     }) 

     # generate figures 
     output$plot <- renderPlot({ 
       validate(
         need(input$party, "Please select a party"), 
         need(input$Candidate, "Please choose at least one candidate"), 
         need(input$state, "Please select at least one state") 
       ) 
       p <- ggplot(df()) 
       p <- p + geom_bar(aes(x = choice, weight = value, fill = choice), 
            position = "dodge", width=.5) 

       # colorize bars based on parties   
       if (input$party == "Dem") 
         p <- p + scale_fill_brewer(palette = "Blues", direction = -1) 
       if (input$party == "Rep") 
         p <- p + scale_fill_brewer(palette = "Reds", direction = -1) 

       # add hlines for waffle-design 
       p <- p + geom_hline(yintercept=seq(0, 100, by = 10), col = 'white') + 
         geom_text(aes(label = value, x = choice, y = value + 1), position = position_dodge(width=0.9), vjust=-0.25) + 
         # facet display 
         facet_wrap(~ state, ncol = 2) + 
         # scale of y-axis 
         ylim(0, 100) + 
         # delete labels of x- and y-axis 
         xlab("") + ylab("") + 
         # blank background and now grids and legend 
         theme(panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank(), 
           panel.grid.minor.y = element_blank(), 
           panel.background = element_blank(), legend.position = "none") 
       print(p)  
     } 

     ) 

     # Generate a table view of the data 
     output$table <- renderTable({ 
       polls %>% filter(party %in% input$party) %>% filter(choice %in% input$Candidate) %>% 
         filter(state %in% input$state) 
     }) 

} 
) 

Answer 1

Hier ist die Lösung für Problem 1 und 2:

Ersetzen Sie in conditionalPanel und checkboxGroupInput durch

uiOutput('candidates'), 
    uiOutput('states') 

In server.R, fügen Sie den folgenden Code vor df <- reactive({..... Beachten Sie, dass Sie einige Ihrer input$Candidate Code in Kleinbuchstaben ändern müssen.

observeEvent(input$party, { 
    output$candidates <- renderUI({ 
     checkboxGroupInput(
     "candidate", 
     ifelse(input$party == 'Dem', "Democratic Candidates", "Republican Candidates"), 
     as.vector(unique(filter(polls,party==input$party)$choice)) 
    ) 
    }) 
    }) 

    observeEvent(input$candidate, { 
    output$states <- renderUI({ 
     states_list <- as.vector(unique(filter(polls, party==input$party & choice==input$candidate)$state)) 
     checkboxGroupInput(
     "state", 
     "Select state", 
     # Excluding national surveys 
     states_list[states_list!="US"] 
    ) 
    }) 
    }) 

Für Problem 3, ändern Sie die dfreactive-observe und dann Höhe eingestellt Grundstück je nachdem, wie viele Staaten ausgewählt. Ändern Sie auch diese Zeile p <- ggplot(df)

observe({  
    df <- polls %>% filter(party %in% input$party) %>% filter(choice %in% input$candidate) %>% filter(state %in% input$state) 
    height <- ceiling(length(input$state)/2) * 200 
    output$plot <- renderPlot({ 
     #Your plot code 
    }, height=height) 
    })