inst/extdata/Templates/chart_formats.R

In jacciz/wisdotcrashdatabase: A package used for internal WisDOT crash database pulls and analysis

colors = wisdotcrashdatabase::crash_helpers("colors")
light_blue = unname(colors["light_blue"])
dark_blue = unname(colors["dark_blue"])
blue = unname(colors["blue"])
red = unname(colors["red"])
green = unname(colors["green"])

# Custom ggplot2 theme
theme_bar_charts <- function(base_size = 12) {
  theme_classic(base_size = base_size) %+replace%
    theme(
      axis.title.x = element_blank(),
      axis.title.y = element_blank(),
      axis.line = element_blank(),
      axis.ticks = element_blank(),
      axis.text = element_text(size = base_size),
      legend.position = "none",
      strip.background=element_rect(fill="#CCD2D4", colour="transparent"),
      strip.text  = ggtext::element_markdown(size = base_size, hjust = 0, margin=margin(0,0,2,2)),
      panel.grid.major.y =  element_line(color = "grey90"),
      plot.title.position = "plot",
      plot.caption.position =  "plot",
      plot.title = ggtext::element_markdown(lineheight = 1.1, size = base_size + 2, hjust = 0, margin=margin(0,0,5,0)), # for title colors
      plot.caption = element_text(hjust = 0, face= "italic")
      # legend.text = element_markdown(size = 11)
    )
}

chart_format <- function(chart_table, title) {
  chart_table |> dplyr::mutate_if(is.numeric, scales::comma_format(1)) |>
    kableExtra::kbl(caption = title) |> kableExtra::kable_paper(html_font = "\"Arial\", \"Source Sans Pro\", sans-serif") |> kableExtra::kable_styling(full_width = TRUE)
}

# Copied from WICrashFacts
gt_table_style_base <- function(df, title){
  df |>
    dplyr::mutate_if(is.numeric, tidyr::replace_na, replace = 0) |> 
    # dplyr::na_if(0) |> # Replace all 0 with NA
    #     mutate_if(is.numeric, scales::comma_format(1)) |>
    # mutate_if(is.character, replace_na, replace = "") |>
    gt::gt(id = "table") |>
    gt::tab_spanner_delim(delim = "_") |>
    gt::tab_header(title = gt::md(title)) |> 
    gt::cols_align(align = "center") |>
    gt::cols_align(align = "left",
               columns = 1) |>
    # For header and spanner
    gt::tab_style(
      style = list(
        gt::cell_fill(color = dark_blue),
        gt::cell_text(color = "white", weight = 600),
        "font-family:Arial; padding-top:1px; padding-bottom:1px; border-bottom-width:0px;"
      ),
      locations = list(gt::cells_column_labels(), gt::cells_column_spanners())
    ) |>
    # All cells in body
    gt::tab_style(
      style = list(
        "font-family:Arial;padding-left:20px; padding-top:0px; padding-bottom:0px; padding-right:0px; text-indent:-15px;"
      ),
      locations = gt::cells_body(columns = gt::everything())
    ) |> gt::sub_missing(columns = gt::everything(),
                     rows = gt::everything(),
                     missing_text = "-") |>
    gt::opt_css(css = "#table .gt_column_spanner {border-bottom-width:1px; padding-top:1px; padding-bottom:1px;}") |> 
    gt::tab_options(row.striping.include_table_body = TRUE) # add grey stripes
}

bar_chart <-
  function(df,
           x_axis,
           y_axis,
           base_size = 14,
           bar_text_size = 3,
           title,
           y_label = scales::comma_format()) {
    max_x = max(df[[y_axis]], na.rm = T)
    
    p = ggplot(df,
               mapping = aes(x = stringr::str_wrap(!!sym(x_axis), width = 30), y = !!sym(y_axis))) +
      geom_bar(fill = light_blue,
               size = 1,
               stat = 'identity') + geom_text(
                 mapping = aes(label = y_label(!!sym(y_axis))),
                 vjust = -.4,
                 size = bar_text_size,
                 color = light_blue,
                 fontface = "bold"
               ) +
      theme_bar_charts(base_size = base_size) +
      theme(axis.text.y = element_blank(),
            panel.grid.major.y =  element_blank()) +
      labs(title = title) +
      scale_y_continuous(labels = y_label, limits = c(0, max_x * 1.2), expand = c(0, 0))
    p
  }

bar_chart_flip <-
  function(df,
           x_axis,
           y_axis,
           base_size = 14,
           bar_text_size = 3,
           reorder_axis = TRUE,
           title,
           y_label = scales::comma_format()) {
    max_x = max(df[[y_axis]], na.rm = T)
    
    if(reorder_axis == TRUE){
      p = ggplot(df,
                 mapping = aes(x = stats::reorder(stringr::str_wrap(!!sym(x_axis), width = 30), !!sym(y_axis)), #stats::reorder(stringr::str_wrap(!!sym(x_axis), width = 30), !!sym(y_axis)),
                               
                               y = !!sym(y_axis)))
    } else {
      p = ggplot(df,
                 mapping = aes(x = stringr::str_wrap(!!sym(x_axis), width = 30),
                               y = !!sym(y_axis)))
    }
    
    
    p = p +
      geom_bar(fill = light_blue,
               size = 1,
               stat = 'identity') + geom_text(
                 mapping = aes(label = y_label(!!sym(y_axis))),
                 hjust = -.1,
                 size = bar_text_size,
                 color = light_blue,
                 fontface = "bold"
               ) +
      theme_bar_charts(base_size = base_size) +
      theme(axis.text.x = element_blank(),
            panel.grid.major.y =  element_blank()) +
      labs(title = title) +
      scale_y_continuous(labels = y_label, limits = c(0, max_x * 1.2), expand = c(0, 0)) +
      coord_flip()
    p
  }

line_chart <- function(df, x_axis, y_axis, title){
  # max_y = max(as.integer(df[[x_axis]]))
  max_x = max(as.integer(df[[y_axis]]))
  # label = as.numeric(df[df[[x_axis]] == max_y, ..y_axis])
  # 
  # if (decimal_point){
  #   label_format = round(label, 2)
  # } else{
  #   label_format = scales::comma(label)
  # }
  
  ggplot() +
    geom_line(
      df,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = light_blue,
      linewidth = 1,
      group = 1
    ) +
    geom_point(
      df,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = light_blue,
      size = 2
    ) +
    theme_bar_charts() + labs(title = title) +
    scale_y_continuous(labels = scales::comma, limits = c(0, max_x * 1.2)) +
    scale_x_discrete()  # label every 2 years
}

line_chart_2lines <- function(df1, df2, x_axis, y_axis, title){
  # max_y = max(as.integer(df[[x_axis]]))
  max_x = max(as.integer(df1[[y_axis]]), as.integer(df2[[y_axis]]))
  # label = as.numeric(df[df[[x_axis]] == max_y, ..y_axis])
  # 
  # if (decimal_point){
  #   label_format = round(label, 2)
  # } else{
  #   label_format = scales::comma(label)
  # }
  ggplot() +
    geom_line(
      df1,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = light_blue,
      linewidth = 1,
      group = 1
    ) +
    geom_point(
      df1,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = light_blue,
      size = 2
    ) +
    geom_line(
      df2,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = dark_blue,
      linewidth = 1,
      group = 1
    ) +
    geom_point(
      df2,
      mapping = aes(x = !!sym(x_axis), y = !!sym(y_axis)),
      color = dark_blue,
      size = 2
    ) +
    theme_bar_charts() + labs(title = title) +
    scale_y_continuous(labels = scales::comma, limits = c(0, max_x * 1.2)) +
    scale_x_discrete()  # label every 2 years
}

bar_chart_flip_2bar <-
  function(df,
           x_axis,
           y_axis,
           fill_value,
           base_size = 14,
           bar_text_size = 3,
           reorder_axis = TRUE,
           title,
           y_label = scales::comma_format()) {
    max_x = max(df[[y_axis]], na.rm = T)
    
    if(reorder_axis == TRUE){
      p = ggplot(df,
                 mapping = aes(x = stats::reorder(stringr::str_wrap(!!sym(x_axis), width = 30), !!sym(y_axis)), #stats::reorder(stringr::str_wrap(!!sym(x_axis), width = 30), !!sym(y_axis)),
                               
                               y = !!sym(y_axis), fill = !!sym(fill_value)))
    } else {
      p = ggplot(df,
                 mapping = aes(x = stringr::str_wrap(!!sym(x_axis), width = 30),
                               y = !!sym(y_axis), fill = !!sym(fill_value)))
    }
    
    
    p = p +
      geom_bar(stat="identity", position=position_dodge()) + geom_text(
        mapping = aes(label = y_label(!!sym(y_axis)), color = !!sym(fill_value)),
        hjust = -.2,
        # stat="identity",
        position=position_dodge(width = .9),
        size = bar_text_size,
        # color = light_blue,
        fontface = "bold"
      ) +
      theme_bar_charts(base_size = base_size) +
      theme(axis.text.x = element_blank(),
            panel.grid.major.y =  element_blank()) +
      labs(title = title) +
      scale_y_continuous(labels = y_label, limits = c(0, max_x * 1.2), expand = c(0, 0)) +
      coord_flip() + scale_fill_manual(values=c(dark_blue, light_blue)) +
      scale_color_manual(values = c(dark_blue, light_blue)) 
    p
  }
inj_bar_chart_flip <- function(df,
                               x_axis,
                               y_axis,
                               # fill_value,
                               base_size = 14,
                               bar_text_size = 3,
                               title1,
                               title2){
  p = df |> 
  ggplot(aes(
    x = stringr::str_wrap(reorder(!!sym(x_axis), desc(-!!sym(y_axis))), width = 30),
    y = !!sym(y_axis),
    fill = inj
  )) + geom_bar(stat = 'identity',  position = 'dodge') + 
    coord_flip() +
    geom_text(
      aes(label = scales::percent(!!sym(y_axis),1), color = inj),
      position = position_dodge(width = .9),
      hjust = -.2,
      size = 6,
      fontface = "bold"
    ) + scale_y_continuous(expand = expansion(mult = c(0, .05)),
                           name = "",
                           limits = c(0, 1.15)) + # 110% 
    scale_color_manual(values = c(
      "Killed" = red,
      "Injured" = light_blue,
      "No Injury" = green
    )) + #for geom_text
    scale_fill_manual(  # for bars
      name = "",
      values = c("Killed" = red,
                 "Injured" = light_blue,
                 "No Injury" = green),
      labels = c("Injured", "Killed", "No Injury")
    ) +
    # labs(title = "Top DRVRPC")
    labs(
      title = paste0(
        "<span>",
        title1,
        " <span style='color:",
        green,
        "'>**non-injured**</span>,
    <span style='color:",
    light_blue,
    "'>**injured**</span>, <br> and
    <span style='color:",
    red,
    "'>**killed**</span> ",
    title2,
    "</span>"
      )
    )
  p +
    theme(axis.text.x = element_blank(),
          panel.grid.major.y = element_blank())
}