Как я могу заставить оба виджета в моем блестящем коде работать одновременно? - PullRequest
Новая
       3

Как я могу заставить оба виджета в моем блестящем коде работать одновременно?

0 голосов
/ 13 марта 2020

В настоящее время я работаю над созданием интерактивного графика с использованием блестящего. Мой файл ui.R содержит два виджета, флажок и selectInput: 

checkboxGroupInput(inputId = "checkbox", 
                         label = h3("Education Level"), 
                         choices = c("Bachelor's Degree" = 'Bachelor', 
                                      "Master's Degree" = 'Master'
                         ),
      ),
      selectInput(inputId = "select", 
                  label = h3("Gender"),
                  choices = c("Female" = 'F', 
                              "Male" = 'M', 
                              "Both" = 'B'
                              ),
      )

В моем файле server.R я могу успешно запустить свой selectInput. Тем не менее, мой флажок в настоящее время не работает. Вот пример: 

server <- function(input, output) {

  output$locksley_plot <- renderPlot({

    choice_button <- input$select
    check_box <- input$checkbox

    BM <- ggplot(data = tech_salaries_bachelor) +
      geom_point(
        mapping = aes(x = Education, y = Male, color = "blue")
      ) +
      scale_color_manual(labels = c("Men"), values=c("blue")) +

      labs(
        title = "Tech Salary Gender Comparison",
        x = "Education Level",
        y = "Salary ($)"
      )

    if(choice_button == 'M' && check_box == 'Bachelor') {
      return(BM)
    }
})
}

shinyServer(server)

1 Ответ

0 голосов
/ 14 марта 2020

@ Locksley Вот пример блестящего приложения, которое использует оба виджета. Я не совсем уверен, какой результат вы ищете, но подумал, что это может быть полезно. 

tech_salaries_bachelor <- data.frame(
  Education = c("Bachelor", "Bachelor", "Master", "Master", "Bachelor"),
  Salary = c(30000, 35000, 55000, 50000, 27000),
  Gender = c("F", "F", "F", "M", "M")
)

library(shiny)
library(tidyverse)

ui <- fluidPage(

  checkboxGroupInput(inputId = "checkbox", 
                     label = h3("Education Level"), 
                     choices = c("Bachelor's Degree" = 'Bachelor', 
                                 "Master's Degree" = 'Master'
                     ),
  ),
  selectInput(inputId = "select", 
              label = h3("Gender"),
              choices = c("Female" = 'F', 
                          "Male" = 'M', 
                          "Both" = 'B'
              ),
  ),
  plotOutput("locksley_plot")

)

server <- function(input, output, session) {

  my_data <- reactive({
    req(input$checkbox)
    tech_salaries_bachelor %>%
      filter(Education %in% input$checkbox,
             if(input$select != 'B') (Gender == input$select) else TRUE) %>%
      group_by(Education, Gender) %>%
      dplyr::summarise(Mean_Salary = mean(Salary))
  })

  output$locksley_plot <- renderPlot({
    ggplot(data = my_data(), aes(x = Education, y = Mean_Salary, fill = Gender)) +
      geom_bar(stat = "identity", position = position_dodge()) +
      scale_fill_manual(labels = c("F" = "Female", "M" = "Male"), values=c("F" = "pink", "M" = "blue")) +
      labs(
        title = "Tech Salary Gender Comparison",
        x = "Education Level",
        y = "Average Salary ($)"
      )
  })

}

shinyApp(ui, server)
...