简体   繁体   中英

Change graph when clicking checkbox in shiny-app

## libraries used ##
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)

## dataset ##
dates <- seq.Date(as.Date("2017-01-01"), length = 1000, by = "days")
mydata <- as.data.frame(dates) %>%
  mutate(satisfaction = runif(1000, 1, 100))

## ui ##
ui <- dashboardPage(

  dashboardHeader(disable = TRUE),

  dashboardSidebar(
    sidebarMenu(
      dateRangeInput("dateRange", "Please choose date", "2018-05-01", "2018-06-30"),
      checkboxInput("comparePreviousPeriod", "Compare to previous period", FALSE)
    )
  ),

  dashboardBody(
    fluidRow(
      box(width = 12, plotOutput("satisfactionGraph"))
    )
  )
)

server <- function(input, output) {
  changing_data <- reactive({
    req(input$dateRange)
    mydata[mydata$dates >= input$dateRange[1] & mydata$dates <= input$dateRange[2],]
  })

  output$satisfactionGraph <- renderPlot(
    ggplot(changing_data(), aes(dates, satisfaction, group = 1)) + 
      geom_line() + 
      theme_minimal() +
      xlab("Day of the year") + 
      ylab("Satisfaction level") + 
      ggtitle("User satisfaction") + 
      theme(axis.text.x = element_text(angle = 90, hjust = 1))
  )
}


shinyApp(ui, server)

I have a shiny dashboard with a checkbox and a dateRange . Upon clicking the checkbox I want the ggplot to reveal an additional line with data from the previous period eg If my dates are "2018-05-01" & "2018-06-30" I want the new line to show data from "2018-03-01" & "2018-04-31".

The problem is that your reactive values will change automatically when ever you change your date input. Here is an easy way you can have the 2 periods overlapping with 2 date inputs.

## ui ##
ui <- dashboardPage(

  dashboardHeader(disable = TRUE),

  dashboardSidebar(
    sidebarMenu(
      dateRangeInput("dateRange", "Please choose date", "2018-05-01", "2018-06-30"),
      dateRangeInput("dateRange2", "Please choose date", "2018-05-01", "2018-06-30"),
      checkboxInput("comparePreviousPeriod", "Compare to previous period", FALSE)
    )
  ),

  dashboardBody(
    fluidRow(
      box(width = 12, plotOutput("satisfactionGraph"))
    )
  )
)

server <- function(input, output) {
  changing_data <- reactive({
    req(input$dateRange)
    mydata[mydata$dates >= input$dateRange[1] & mydata$dates <= input$dateRange[2],]
  })

  changing_data_2<- reactive({
    req(input$dateRange2)
    mydata[mydata$dates >= input$dateRange2[1] & mydata$dates <= input$dateRange2[2],]
  })

  pd <- position_jitter(0.5)
  output$satisfactionGraph <- renderPlot({

    p <- ggplot(changing_data(), aes(dates, satisfaction, group = 1, color="blue")) + 
      geom_line() + 
      theme_minimal() +
      xlab("Day of the year") + 
      ylab("Satisfaction level") + 
      ggtitle("User satisfaction") + 
      theme(axis.text.x = element_text(angle = 90, hjust = 1))

    if(input$comparePreviousPeriod == FALSE){
      p
    }

    else if(input$comparePreviousPeriod == TRUE){

      p + geom_line(data= changing_data_2(), aes(dates, satisfaction, color= "red"), position= pd)

    }

    else{NULL}

    })


}


shinyApp(ui, server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM