R/mod_waffle_ggplot_chart.R

In jacciz/shiny_wisdot_crash_dashboard: WisDOTcrashdashboard

#' waffle_chart UI Function
#'
#' @description A shiny Modul
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_waffle_ggplot_chart_ui <- function(id){
  tagList(plotOutput(shiny::NS(id, "waffle_ggplot_chart"), height = "150px", width = "100%", fill = TRUE))
}

#' waffle_chart Server Function
#' 
#' @noRd 
mod_waffle_ggplot_chart_server <- function(id, person_df, filter_role = "Pedestrian", role_type = "pedestrians", use_glyph = 'bicycle'){
  shiny::moduleServer(id, function(input, output, session) {
    
    output$waffle_ggplot_chart <- renderPlot({
      
      if (nrow(person_df()) == 0) {
        return(ggplot2::ggplot() + ggplot2::labs(title = paste("No", role_type, "injured or killed")) + ggplot_config(12))
      } else {
        
        bikeped_count = person_df() |>
          dplyr::filter(.data[["ROLE"]] == filter_role, # , "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[["inj"]], .drop = FALSE) |> # .data[["ROLE"]],
          # mutate(for_colors = paste0(.data[["ROLE"]], .data[["inj"]])) |>
          data.table::as.data.table()
      }
     
      if (sum(bikeped_count[["n"]]) == 0) {
        return(ggplot2::ggplot() + ggplot2::labs(title = paste("No", role_type, "injured or killed")) + ggplot_config(12))
      }
    require(emojifont)
      # require(extrafont)
      
    x = bikeped_count[["n"]]
   
    inj_format = scales::comma(x[1])
    ftl_format = scales::comma(x[2])
    bikeped_title <- sprintf(
      paste0(
        "<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 via if else depending on total
    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)))

    p = ggplot2::ggplot(df, aes(xvals, yvals, color = fill)) +
      ggplot2::geom_text(label = emojifont::fontawesome(paste('fa', use_glyph, sep = '-')),
                family = 'fontawesome-webfont', size = glyph_size) +
      ggplot2::coord_equal(expand = TRUE) +
      ggplot2::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::labs(
        title = bikeped_title
      )
    return(p)
    })
  })
}

get_number_of_rows <- function(total) {
  
  if (is.na(total) | total < 20){
    rows = c(rows = 1, glyph_size = 8)
  }
  else if
  (total >= 20 & total < 50){
    rows = c(rows = 2, glyph_size = 6)
  }
  else if
  (total >= 50 & total < 200){
    rows = c(rows = 3, glyph_size = 3)
  }
  else if
  (total >= 200 & total < 600){
    rows = c(rows = 6, 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
}