library(dplyr)
pool <- pool::dbPool(RSQLite::SQLite(), dbname = "inst/app/www/crash_db.db")
person <-DBI::dbReadTable(pool, "person2017")

role_table = 
   person |> 
      dplyr::filter(.data[["ROLE"]] %in% c("Bicycle", "Pedestrian"), .data[["WISINJ"]] != "No Apparent Injury") |> 
      mutate(inj = ifelse(.data[["WISINJ"]] == "Fatal Injury", "Killed","Injured"),
             inj = factor(.data[["inj"]], levels =c("Injured","Killed")),
             ROLE = factor(.data[["ROLE"]], levels =c("Bicycle","Pedestrian")))|> 
      dplyr::count(.data[["ROLE"]], .data[["inj"]], .drop = FALSE) |> data.table::as.data.table()
# use switch??
# get_number_of_rows <- function(total) {
#  
#   if (is.na(total) | total < 20){
#     rows = c(rows = 1, glyph_size = 4)
#   }
#   else if
#   (total >= 20 & total < 50){
#     rows = c(rows = 2, glyph_size = 4)
#   }
#   else if
#   (total >= 50 & total < 200){
#     rows = c(rows = 3, glyph_size = 3)
#   }
#   else if
#   (total >= 200 & total < 600){
#     rows = c(rows = 4, glyph_size = 2)
#   }
#   else if
#   (total >= 600 & total < 1000){
#     rows = c(rows = 8, glyph_size = 2)
#   }
#     else if
#   (total >= 1000){
#     rows = c(rows = 16, glyph_size = 2)
#   }
#   rows
# }
library(emojifont)
library(extrafont)
library(ggplot2)

my_waffle <- function(x, role_type = "pedestrians", use_glyph = 'bicycle') {


  inj_format = scales::comma(x[1])
  ftl_format = scales::comma(x[2])
  bikeped_title <- sprintf(
  glue::glue(
  "<span><p style='color:{inj_blue}'><b>{inj_format}</b></p> {role_type} were <p style='color:{inj_blue}'><b>injured</b></p> and <p style='color:{fatal_red}'><b> {ftl_format} killed</b></p></span>"))
  len <- sum(x)

  inputs = get_number_of_rows(len)
  rows = inputs[1]
  glyph_size = inputs[2]

  waffles <- seq(len) - 1 
  nms <- if(is.null(names(x))) seq_along(x) else names(x)
  df <- data.frame(xvals = waffles %/% rows,
                   yvals = 1 - (waffles %% rows),
                   fill = factor(rep(nms, times = x)))

  ggplot(df, aes(xvals, yvals, color = fill)) +
    geom_text(label = emojifont::fontawesome(paste('fa', use_glyph, sep = '-')), 
              family = 'fontawesome-webfont', size = glyph_size) +
    coord_equal(expand = TRUE) +
    lims(x  = c(min(df$xvals) - 1, max(df$xvals) + 1),
         y  = c(min(df$yvals) - 1, max(df$yvals) + 1)) + 
    ggplot2::scale_color_manual(
            name = NULL,
            values = c(inj_blue, fatal_red)
          ) + ggplot_config(base_size = 12) +
    # ggplot2::theme_classic() +
    #       waffle::theme_enhance_waffle() +
          # ggplot2::theme(panel.background = ggplot2::element_rect(fill =  "#f8f8f8"),
          #       plot.background = ggplot2::element_rect(fill =  "#f8f8f8"),
          # 
          #       axis.line = ggplot2::element_blank(),
          #       axis.ticks = ggplot2::element_blank(),
          #       # plot.margin = margin(10, 10, 10, 10),
          #       legend.position = "none",
          #       plot.title = ggtext::element_markdown(size = 16)) +
          ggplot2::labs(
            title = bikeped_title
          )
}

my_waffle(c(14, 56), "pedestrians", use_glyph = "user")

my_waffle(c(1000, 30), "bicyclists", use_glyph = "bicycle") + ggplot2::theme(
      plot.background = ggplot2::element_rect(fill =  bg_color, color = bg_color))

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.



jacciz/shiny_wisdot_crash_dashboard documentation built on May 4, 2023, 11:36 a.m.