从checkboxGroupInput中选择多个值并进行绘图

Question

大家好，新年快乐，

使用以下代码，我试图让用户可以过滤数据以查看他们所需的一周中的任何天数组合，因此，例如，他们将能够从“星期一”中选择数据'和'星期四'。目前，ggplot仅绘制了第一个值检查数据，因此，例如，如果同时检查“星期一”和“星期四”，则仅显示“星期一”的数据。 N.B代码中还有一个复选框，工作正常。

    ui <- fluidPage(
  titlePanel("Transfers Analysis App"),


  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("Day", "Days of Week", c("All", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), selected="All"),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
             plotOutput("plot1", height = "600px", width = "100%",
             hover = hoverOpts(id = "plot_hover")),
       verbatimTextOutput("hover_info")

)))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage


    if(Day == "Monday")
      data<-data[data$day == "Monday"]
    if(Day == "Tuesday")
      data<-data[data$day == "Tuesday"]
    if(Day == "Wednesday")
      data<-data[data$day == "Wednesday"]
    if(Day == "Thursday")
      data<-data[data$day == "Thursday"]
    if(Day == "Friday")
      data<-data[data$day == "Friday"]
    if(Day == "Saturday")
      data<-data[data$day == "Saturday"]

    #ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #plot(data$Date,data$NUMBER_OF_TRANSFERS, xlab = "Date", ylab = "Transfers") 

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
      #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })

Answer 1

有一个很棒的%in%运营商可以做你想做的事情：

library(ggplot2)
library(shiny)

ui <- fluidPage(
  titlePanel("Transfers Analysis App"),


  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("Day", "Days of Week", c("All", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), selected="All"),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
      plotOutput("plot1", height = "600px", width = "100%",
                 hover = hoverOpts(id = "plot_hover")),
      verbatimTextOutput("hover_info")

    )))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage
    if(input$Day != "All"){
      data <- data[data$day %in% input$Day,]
    }

    #ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #plot(data$Date,data$NUMBER_OF_TRANSFERS, xlab = "Date", ylab = "Transfers") 

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })
}

shinyApp(ui, server)

我也非常喜欢其shinyWidgets中具有Select All功能的pickerInput包：

library(ggplot2)
library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  titlePanel("Transfers Analysis App"),

  sidebarLayout(
    sidebarPanel(
      pickerInput(inputId = "Day", 
                  label = "Days of Week", 
                  choices = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), options = list(`actions-box` = TRUE), 
                  multiple = T),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
      plotOutput("plot1", height = "600px", width = "100%",
                 hover = hoverOpts(id = "plot_hover")),
      verbatimTextOutput("hover_info")

    )))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage
    data[data$day %in% input$Day,]

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })
}

shinyApp(ui, server)