caizhong_app.R

# Load packages -----------------------------------------------------
library(shiny)
library(highcharter)
library(dplyr)
library(tidyr)

# Load data ---------------------------------------------------------
births <- read.csv('https://raw.githubusercontent.com/rstudio/shiny-examples/master/118-highcharter-births/data/births.csv')

# Determine years in data -------------------------------------------
years <- unique(births$year)

# UI ----------------------------------------------------------------
ui <- fluidPage(
  
  # App title -------------------------------------------------------
  titlePanel("The Friday the 13th effect"),
  
  # Sidebar layout with a input and output definitions --------------
  sidebarLayout(
    
    # Inputs --------------------------------------------------------    
    sidebarPanel(
      
      sliderInput("year", 
                  label = "Year",
                  min = min(years), 
                  max = max(years), 
                  step = 1,
                  sep = "",
                  value = range(years)),
      
      selectInput("plot_type", 
                  label = "Plot type",
                  choices = c("Scatter" = "scatter", 
                              "Bar" = "column", 
                              "Line" = "line")),
      selectInput("theme", 
                  label = "Theme",
                  choices = c("No theme", 
                              "Chalk" = "chalk",
                              "Dark Unica" = "darkunica", 
                              "Economist" = "economist",
                              "FiveThirtyEight" = "fivethirtyeight", 
                              "Gridlight" = "gridlight", 
                              "Handdrawn" = "handdrawn", 
                              "Sandsignika" = "sandsignika"))
    ),
    
    # Output --------------------------------------------------------    
    mainPanel(
      highchartOutput("hcontainer", height = "500px")
    )
    
  )
)


# SERVER ------------------------------------------------------------
server = function(input, output) {
  
  # Calculate differences between 13th and avg of 6th and 20th ------
  diff13 <- reactive({
    births %>%
      filter(between(year, input$year[1], input$year[2])) %>%
      filter(date_of_month %in% c(6, 13, 20)) %>%
      mutate(day = ifelse(date_of_month == 13, "thirteen", "not_thirteen")) %>%
      group_by(day_of_week, day) %>%
      summarise(mean_births = mean(births)) %>%
      arrange(day_of_week) %>%
      spread(day, mean_births) %>%
      mutate(diff_ppt = ((thirteen - not_thirteen) / not_thirteen) * 100)
  })
  
  # Text string of selected years for plot subtitle -----------------
  selected_years_to_print <- reactive({
    if(input$year[1] == input$year[2]) { 
      as.character(input$year[1])
    } else {
      paste(input$year[1], " - ", input$year[2])
    }
  })
  
  # Highchart -------------------------------------------------------
  output$hcontainer <- renderHighchart({
    
    hc <- highchart() %>%
      hc_add_series(data = diff13()$diff_ppt, 
                    type = input$plot_type,
                    name = "Difference, in ppt",
                    showInLegend = FALSE) %>%
      hc_yAxis(title = list(text = "Difference, in ppt"), 
               allowDecimals = FALSE) %>%
      hc_xAxis(categories = c("Monday", "Tuesday", "Wednesday", "Thursday", 
                              "Friday", "Saturday", "Sunday"),
               tickmarkPlacement = "on",
               opposite = TRUE) %>%
      hc_title(text = "The Friday the 13th effect",
               style = list(fontWeight = "bold")) %>% 
      hc_subtitle(text = paste("Difference in the share of U.S. births on 13th 
                               of each month from the average of births on the 6th 
                               and the 20th,",
                               selected_years_to_print())) %>%
      hc_tooltip(valueDecimals = 4,
                 pointFormat = "Day: {point.x} <br> Diff: {point.y}") %>%
      hc_credits(enabled = TRUE, 
                 text = "Sources: CDC/NCHS, SOCIAL SECURITY ADMINISTRATION",
                 style = list(fontSize = "10px"))
    
    # Determine theme and apply to highchart ------------------------
    if (input$theme != "No theme") {
      theme <- switch(input$theme,
                      chalk = hc_theme_chalk(),
                      darkunica = hc_theme_darkunica(),
                      fivethirtyeight = hc_theme_538(),
                      gridlight = hc_theme_gridlight(),
                      handdrawn = hc_theme_handdrawn(),
                      economist = hc_theme_economist(),
                      sandsignika = hc_theme_sandsignika()
      )
      hc <- hc %>%
        hc_add_theme(theme)
    }
    
    # Print highchart -----------------------------------------------
    hc
  })
  
}