From 023a1c2b1ac37a1dfadb2b0d437dc779095f8dda Mon Sep 17 00:00:00 2001 From: mrcaseb Date: Thu, 23 Oct 2025 10:45:37 +0200 Subject: [PATCH] format whole project with `air format .` --- R/build_grobs.R | 62 +++++++---- R/geom_nfl_headshots.R | 31 ++++-- R/geom_nfl_logos.R | 43 ++++++-- R/geom_nfl_wordmarks.R | 43 ++++++-- R/ggpreview.R | 24 ++-- R/gt_nfl.R | 133 +++++++++++++---------- R/nfl_team_factors.R | 8 +- R/nfl_team_tiers.R | 76 ++++++++----- R/scale_nfl.R | 52 +++++---- R/utils.R | 29 +++-- R/zzz.R | 59 ++++++---- data-raw/build_logo.R | 2 +- data-raw/social_preview.R | 45 ++++++-- data-raw/update_headshot_gsis_map.R | 18 ++- tests/testthat/test-geom_nfl_logos.R | 66 ++++++++++- tests/testthat/test-geom_nfl_wordmarks.R | 54 ++++++++- tests/testthat/test-gt_nfl.R | 6 +- tests/testthat/test-nfl_team_tiers.R | 22 ++-- tests/testthat/test-utils.R | 46 +++++++- 19 files changed, 560 insertions(+), 259 deletions(-) diff --git a/R/build_grobs.R b/R/build_grobs.R index 8726f44b..56ad558f 100644 --- a/R/build_grobs.R +++ b/R/build_grobs.R @@ -1,27 +1,34 @@ # INTERNAL HELPER THAT BUILDS THE GROBS FOR # GEOM LOGOS, WORDMARKS AND HEADSHOTS -build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", "wordmarks"), headshot_map = NULL) { +build_grobs <- function( + i, + alpha, + colour, + data, + type = c("teams", "headshots", "wordmarks"), + headshot_map = NULL +) { make_null <- FALSE type <- rlang::arg_match(type) - if(type == "teams") { + if (type == "teams") { team_abbr <- data$team_abbr[i] image_to_read <- logo_list[[team_abbr]] if (is.na(team_abbr) | is.null(image_to_read)) make_null <- TRUE - } else if(type == "wordmarks") { + } else if (type == "wordmarks") { team_abbr <- data$team_abbr[i] image_to_read <- wordmark_list[[team_abbr]] if (is.na(team_abbr) | is.null(image_to_read)) make_null <- TRUE } else { gsis <- data$player_gsis[i] image_to_read <- headshot_map$headshot_nfl[headshot_map$gsis_id == gsis] - if(length(image_to_read) == 0 | all(is.na(image_to_read))){ + if (length(image_to_read) == 0 | all(is.na(image_to_read))) { cli::cli_alert_warning( "No headshot available for gsis ID {.val {data$player_gsis[i]}}. Will insert placeholder." ) image_to_read <- na_headshot() } } - if (isTRUE(make_null)){ + if (isTRUE(make_null)) { cli::cli_alert_warning( "Can't find team abbreviation {.val {data$team_abbr[i]}}. Will insert empty grob." ) @@ -29,9 +36,9 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", " } else if (is.null(alpha)) { img <- reader_function(image_to_read) col <- colour[i] - if (!is.null(col) && col %in% "b/w"){ + if (!is.null(col) && col %in% "b/w") { new <- magick::image_quantize(img, colorspace = 'gray') - } else{ + } else { opa <- ifelse(is.na(col) || is.null(col), 0, 100) col <- ifelse(is.na(col) || is.null(col), "none", col) new <- magick::image_colorize(img, opa, col) @@ -39,14 +46,20 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", " grid <- grid::rasterGrob(new) } else if (length(alpha) == 1L) { if (as.numeric(alpha) <= 0 || as.numeric(alpha) >= 1) { - cli::cli_abort("aesthetic {.var alpha} requires a value between {.val 0} and {.val 1}") + cli::cli_abort( + "aesthetic {.var alpha} requires a value between {.val 0} and {.val 1}" + ) } img <- reader_function(image_to_read) - new <- magick::image_fx(img, expression = paste0(alpha, "*a"), channel = "alpha") + new <- magick::image_fx( + img, + expression = paste0(alpha, "*a"), + channel = "alpha" + ) col <- colour[i] - if (!is.null(col) && col %in% "b/w"){ + if (!is.null(col) && col %in% "b/w") { new <- magick::image_quantize(new, colorspace = 'gray') - } else{ + } else { opa <- ifelse(is.na(col) || is.null(col), 0, 100) col <- ifelse(is.na(col) || is.null(col), "none", col) new <- magick::image_colorize(new, opa, col) @@ -54,14 +67,20 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", " grid <- grid::rasterGrob(new) } else { if (any(as.numeric(alpha) < 0) || any(as.numeric(alpha) > 1)) { - cli::cli_abort("aesthetics {.var alpha} require values between {.val 0} and {.val 1}") + cli::cli_abort( + "aesthetics {.var alpha} require values between {.val 0} and {.val 1}" + ) } img <- reader_function(image_to_read) - new <- magick::image_fx(img, expression = paste0(alpha[i], "*a"), channel = "alpha") + new <- magick::image_fx( + img, + expression = paste0(alpha[i], "*a"), + channel = "alpha" + ) col <- colour[i] - if (!is.null(col) && col %in% "b/w"){ + if (!is.null(col) && col %in% "b/w") { new <- magick::image_quantize(new, colorspace = 'gray') - } else{ + } else { opa <- ifelse(is.na(col) || is.null(col), 0, 100) col <- ifelse(is.na(col) || is.null(col), "none", col) new <- magick::image_colorize(new, opa, col) @@ -76,10 +95,7 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", " height = grid::unit(data$height[i], "npc"), just = c(data$hjust[i], data$vjust[i]), angle = data$angle[i], - name = paste("geom_nfl.panel", data$PANEL[i], - "row", i, - sep = "." - ) + name = paste("geom_nfl.panel", data$PANEL[i], "row", i, sep = ".") ) grid$name <- paste("nfl.grob", i, sep = ".") @@ -87,11 +103,11 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", " grid } -reader_function <- function(img){ - if(is.factor(img)) img <- as.character(img) - if(is.raw(img) || tools::file_ext(img) != "svg"){ +reader_function <- function(img) { + if (is.factor(img)) img <- as.character(img) + if (is.raw(img) || tools::file_ext(img) != "svg") { magick::image_read(img) - } else if(tools::file_ext(img) == "svg"){ + } else if (tools::file_ext(img) == "svg") { magick::image_read_svg(img) } } diff --git a/R/geom_nfl_headshots.R b/R/geom_nfl_headshots.R index 9edc6cb5..acf108a9 100644 --- a/R/geom_nfl_headshots.R +++ b/R/geom_nfl_headshots.R @@ -89,13 +89,16 @@ #' # Restore old options #' options(old) #' } -geom_nfl_headshots <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - show.legend = FALSE, - inherit.aes = TRUE) { - +geom_nfl_headshots <- function( + mapping = NULL, + data = NULL, + stat = "identity", + position = "identity", + ..., + na.rm = FALSE, + show.legend = FALSE, + inherit.aes = TRUE +) { ggplot2::layer( data = data, mapping = mapping, @@ -114,12 +117,18 @@ geom_nfl_headshots <- function(mapping = NULL, data = NULL, #' @rdname nflplotR-package #' @export GeomNFLheads <- ggplot2::ggproto( - "GeomNFLheads", ggplot2::Geom, + "GeomNFLheads", + ggplot2::Geom, required_aes = c("x", "y", "player_gsis"), # non_missing_aes = c(""), default_aes = ggplot2::aes( - alpha = NULL, colour = NULL, angle = 0, hjust = 0.5, - vjust = 0.5, width = 1.0, height = 1.0 + alpha = NULL, + colour = NULL, + angle = 0, + hjust = 0.5, + vjust = 0.5, + width = 1.0, + height = 1.0 ), draw_panel = function(data, panel_params, coord, na.rm = FALSE) { data <- coord$transform(data, panel_params) @@ -133,7 +142,7 @@ GeomNFLheads <- ggplot2::ggproto( data = data, type = "headshots", headshot_map = headshots - ) + ) class(grobs) <- "gList" diff --git a/R/geom_nfl_logos.R b/R/geom_nfl_logos.R index 253b96f4..6445edf1 100644 --- a/R/geom_nfl_logos.R +++ b/R/geom_nfl_logos.R @@ -94,13 +94,16 @@ #' coord_cartesian(xlim = c(0.5,2.5), ylim = c(-0.75, 1.75)) + #' theme_void() #' } -geom_nfl_logos <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - show.legend = FALSE, - inherit.aes = TRUE) { - +geom_nfl_logos <- function( + mapping = NULL, + data = NULL, + stat = "identity", + position = "identity", + ..., + na.rm = FALSE, + show.legend = FALSE, + inherit.aes = TRUE +) { ggplot2::layer( data = data, mapping = mapping, @@ -119,21 +122,37 @@ geom_nfl_logos <- function(mapping = NULL, data = NULL, #' @rdname nflplotR-package #' @export GeomNFLlogo <- ggplot2::ggproto( - "GeomNFLlogo", ggplot2::Geom, + "GeomNFLlogo", + ggplot2::Geom, required_aes = c("x", "y", "team_abbr"), # non_missing_aes = c(""), default_aes = ggplot2::aes( - alpha = NULL, colour = NULL, angle = 0, hjust = 0.5, - vjust = 0.5, width = 1.0, height = 1.0 + alpha = NULL, + colour = NULL, + angle = 0, + hjust = 0.5, + vjust = 0.5, + width = 1.0, + height = 1.0 ), draw_panel = function(data, panel_params, coord, na.rm = FALSE) { data <- coord$transform(data, panel_params) data$team_abbr <- suppressWarnings( - nflreadr::clean_team_abbrs(as.character(data$team_abbr), keep_non_matches = TRUE) + nflreadr::clean_team_abbrs( + as.character(data$team_abbr), + keep_non_matches = TRUE + ) ) - grobs <- lapply(seq_along(data$team_abbr), build_grobs, alpha = data$alpha, colour = data$colour, data = data, type = "teams") + grobs <- lapply( + seq_along(data$team_abbr), + build_grobs, + alpha = data$alpha, + colour = data$colour, + data = data, + type = "teams" + ) class(grobs) <- "gList" diff --git a/R/geom_nfl_wordmarks.R b/R/geom_nfl_wordmarks.R index 1a77be4c..d32440d3 100644 --- a/R/geom_nfl_wordmarks.R +++ b/R/geom_nfl_wordmarks.R @@ -88,13 +88,16 @@ #' theme_void() #' #' } -geom_nfl_wordmarks <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - show.legend = FALSE, - inherit.aes = TRUE) { - +geom_nfl_wordmarks <- function( + mapping = NULL, + data = NULL, + stat = "identity", + position = "identity", + ..., + na.rm = FALSE, + show.legend = FALSE, + inherit.aes = TRUE +) { ggplot2::layer( data = data, mapping = mapping, @@ -113,21 +116,37 @@ geom_nfl_wordmarks <- function(mapping = NULL, data = NULL, #' @rdname nflplotR-package #' @export GeomNFLwordmark <- ggplot2::ggproto( - "GeomNFLwordmark", ggplot2::Geom, + "GeomNFLwordmark", + ggplot2::Geom, required_aes = c("x", "y", "team_abbr"), # non_missing_aes = c(""), default_aes = ggplot2::aes( - alpha = NULL, colour = NULL, angle = 0, hjust = 0.5, - vjust = 0.5, width = 1.0, height = 1.0 + alpha = NULL, + colour = NULL, + angle = 0, + hjust = 0.5, + vjust = 0.5, + width = 1.0, + height = 1.0 ), draw_panel = function(data, panel_params, coord, na.rm = FALSE) { data <- coord$transform(data, panel_params) data$team_abbr <- suppressWarnings( - nflreadr::clean_team_abbrs(as.character(data$team_abbr), keep_non_matches = TRUE) + nflreadr::clean_team_abbrs( + as.character(data$team_abbr), + keep_non_matches = TRUE + ) ) - grobs <- lapply(seq_along(data$team_abbr), build_grobs, alpha = data$alpha, colour = data$colour, data = data, type = "wordmarks") + grobs <- lapply( + seq_along(data$team_abbr), + build_grobs, + alpha = data$alpha, + colour = data$colour, + data = data, + type = "wordmarks" + ) class(grobs) <- "gList" diff --git a/R/ggpreview.R b/R/ggpreview.R index 89e8b855..cecc7b5e 100644 --- a/R/ggpreview.R +++ b/R/ggpreview.R @@ -36,17 +36,19 @@ #' if (rstudioapi::isAvailable()){ #' ggpreview(p, width = 5, asp = 16/9) #' } -ggpreview <- function(plot = ggplot2::last_plot(), - width = NA, - height = NA, - asp = NULL, - dpi = 300, - device = "png", - units = c("in", "cm", "mm", "px"), - scale = 1, - limitsize = TRUE, - bg = NULL, - ...){ +ggpreview <- function( + plot = ggplot2::last_plot(), + width = NA, + height = NA, + asp = NULL, + dpi = 300, + device = "png", + units = c("in", "cm", "mm", "px"), + scale = 1, + limitsize = TRUE, + bg = NULL, + ... +) { rlang::check_installed("rstudioapi", reason = "to preview a ggplot file") file <- tempfile() if (is.numeric(asp)) height <- width / asp diff --git a/R/gt_nfl.R b/R/gt_nfl.R index 50e343fc..5fb1cebd 100644 --- a/R/gt_nfl.R +++ b/R/gt_nfl.R @@ -43,10 +43,7 @@ #' gt_nfl_logos(columns = gt::starts_with("logo")) |> #' gt_nfl_wordmarks(columns = gt::starts_with("wordmark")) #' } -gt_nfl_logos <- function(gt_object, - columns, - height = 30, - locations = NULL){ +gt_nfl_logos <- function(gt_object, columns, height = 30, locations = NULL) { gt_nflplotR_image( gt_object = gt_object, columns = {{ columns }}, @@ -58,10 +55,12 @@ gt_nfl_logos <- function(gt_object, #' @rdname gt_nfl_logos #' @export -gt_nfl_wordmarks <- function(gt_object, - columns, - height = 30, - locations = NULL){ +gt_nfl_wordmarks <- function( + gt_object, + columns, + height = 30, + locations = NULL +) { gt_nflplotR_image( gt_object = gt_object, columns = {{ columns }}, @@ -112,12 +111,13 @@ gt_nfl_wordmarks <- function(gt_object, #' nflplotR::gt_nfl_cols_label("LAC", type = "wordmark") |> #' nflplotR::gt_nfl_cols_label("KC", type = "logo") #' } -gt_nfl_cols_label <- function(gt_object, - columns = gt::everything(), - ..., - height = 30, - type = c("logo", "wordmark", "headshot")){ - +gt_nfl_cols_label <- function( + gt_object, + columns = gt::everything(), + ..., + height = 30, + type = c("logo", "wordmark", "headshot") +) { type <- rlang::arg_match(type) if (is.numeric(height)) { @@ -127,8 +127,8 @@ gt_nfl_cols_label <- function(gt_object, gt::cols_label_with( data = gt_object, columns = {{ columns }}, - fn = function(x){ - if (type == "headshot"){ + fn = function(x) { + if (type == "headshot") { headshots <- load_headshots() lookup <- headshots$headshot_nfl names(lookup) <- headshots$gsis_id @@ -136,7 +136,10 @@ gt_nfl_cols_label <- function(gt_object, out <- gt::web_image(image_url, height = height) out[is.na(image_url)] <- x[is.na(image_url)] } else { - team_abbr <- nflreadr::clean_team_abbrs(as.character(x), keep_non_matches = FALSE) + team_abbr <- nflreadr::clean_team_abbrs( + as.character(x), + keep_non_matches = FALSE + ) # Create the image URI uri <- get_image_uri(team_abbr = team_abbr, type = type) # Generate the Base64-encoded image and place it within tags @@ -158,17 +161,18 @@ gt_nfl_cols_label <- function(gt_object, ) } -gt_nflplotR_image <- function(gt_object, - columns, - height = 30, - locations = NULL, - type = c("logo", "wordmark")){ - +gt_nflplotR_image <- function( + gt_object, + columns, + height = 30, + locations = NULL, + type = c("logo", "wordmark") +) { rlang::check_installed("gt (>= 0.8.0)", "to render images in gt tables.") type <- match.arg(type) - if(is.null(locations)){ + if (is.null(locations)) { locations <- gt::cells_body({{ columns }}) } @@ -179,8 +183,11 @@ gt_nflplotR_image <- function(gt_object, gt::text_transform( data = gt_object, locations = locations, - fn = function(x){ - team_abbr <- nflreadr::clean_team_abbrs(as.character(x), keep_non_matches = FALSE) + fn = function(x) { + team_abbr <- nflreadr::clean_team_abbrs( + as.character(x), + keep_non_matches = FALSE + ) # Create the image URI uri <- get_image_uri(team_abbr = team_abbr, type = type) # Generate the Base64-encoded image and place it within tags @@ -200,17 +207,12 @@ gt_nflplotR_image <- function(gt_object, out } ) - } # Taken from gt package and modified for nflplotR purposes # Get image URIs from image lists as a vector Base64-encoded image strings get_image_uri <- function(team_abbr, type = c("logo", "wordmark")) { - - lookup_list <- switch (type, - "logo" = logo_list, - "wordmark" = wordmark_list - ) + lookup_list <- switch(type, "logo" = logo_list, "wordmark" = wordmark_list) vapply( team_abbr, @@ -220,8 +222,10 @@ get_image_uri <- function(team_abbr, type = c("logo", "wordmark")) { # every non match will return NULL which is when we want NA if (is.null(lookup_list[[team]])) return(NA_character_) paste0( - "data:", "image/png", - ";base64,", base64enc::base64encode(lookup_list[[team]]) + "data:", + "image/png", + ";base64,", + base64enc::base64encode(lookup_list[[team]]) ) } ) @@ -275,29 +279,31 @@ get_image_uri <- function(team_abbr, type = c("logo", "wordmark")) { #' # Restore old options #' options(old) #' } -gt_nfl_headshots <- function(gt_object, - columns, - height = 30, - locations = NULL){ +gt_nfl_headshots <- function( + gt_object, + columns, + height = 30, + locations = NULL +) { rlang::check_installed("gt (>= 0.8.0)", "to render images in gt tables.") - if(is.null(locations)){ + if (is.null(locations)) { locations <- gt::cells_body({{ columns }}) } gt::text_transform( data = gt_object, locations = locations, - fn = function(gsis){ + fn = function(gsis) { headshot_map <- load_headshots() image_urls <- vapply( gsis, FUN.VALUE = character(1), USE.NAMES = FALSE, FUN = function(id) { - if(is.na(id) | !is_gsis(id)) return(NA_character_) + if (is.na(id) | !is_gsis(id)) return(NA_character_) ret <- headshot_map$headshot_nfl[headshot_map$gsis_id == id] - if(length(ret) == 0) ret <- na_headshot() + if (length(ret) == 0) ret <- na_headshot() ret } ) @@ -333,9 +339,11 @@ gt_nfl_headshots <- function(gt_object, #' @examplesIf identical(Sys.getenv("_R_CHECK_CONNECTIONS_LEFT_OPEN_"), "false") && identical(Sys.getenv("IN_PKGDOWN"), "true") #' tbl <- gt::gt_preview(mtcars) #' gt_render_image(tbl) -gt_render_image <- function(gt_tbl, ...){ - if(!inherits(gt_tbl, "gt_tbl")){ - cli::cli_abort("The argument {.arg gt_tbl} is not an object of class {.cls gt_tbl}") +gt_render_image <- function(gt_tbl, ...) { + if (!inherits(gt_tbl, "gt_tbl")) { + cli::cli_abort( + "The argument {.arg gt_tbl} is not an object of class {.cls gt_tbl}" + ) } rlang::check_installed("gt", "to render images in gt tables.") temp_file <- tempfile(fileext = ".png") @@ -345,7 +353,7 @@ gt_render_image <- function(gt_tbl, ...){ # get rid of the file when function exits on.exit(unlink(temp_file)) # remove margin from plots so we render the table only - old <- graphics::par(ask = FALSE, mai = c(0,0,0,0), ...) + old <- graphics::par(ask = FALSE, mai = c(0, 0, 0, 0), ...) plot(magick::image_read(temp_file)) # restore old margins graphics::par(old) @@ -555,7 +563,7 @@ gt_pct_bar <- function( # Use one of 3 internal color palettes for special literals if ( length(fill_palette) == 1 && - fill_palette %in% c("hulk", "hulk_teal", "blue_orange") + fill_palette %in% c("hulk", "hulk_teal", "blue_orange") ) { fill_palette <- color_palettes[[fill_palette]] } @@ -625,7 +633,7 @@ gt_pct_bar <- function( data = gt_tbl, locations = gt::cells_body(columns = {{ col_value }}, rows = {{ rows }}), fn = function(x) { - if (value_position == "inline"){ + if (value_position == "inline") { paste0( span_tag(background_style), # attr adds a title attribute which triggers a tooltip @@ -655,14 +663,21 @@ gt_pct_bar <- function( # Calculate color contrast ratios and return the color that yields the best # contrast -best_contrast <- function(background_colors, text_colors){ +best_contrast <- function(background_colors, text_colors) { rlang::check_installed( - "colorspace (>= 2.0)", "to calculate color contrast ratios." + "colorspace (>= 2.0)", + "to calculate color contrast ratios." + ) + vapply( + background_colors, + function(x, text_cols) { + cr <- colorspace::contrast_ratio(x, text_cols) + text_cols[which.max(cr)] + }, + FUN.VALUE = character(1L), + text_cols = text_colors, + USE.NAMES = FALSE ) - vapply(background_colors, function(x, text_cols){ - cr <- colorspace::contrast_ratio(x, text_cols) - text_cols[which.max(cr)] - }, FUN.VALUE = character(1L), text_cols = text_colors, USE.NAMES = FALSE) } style_build <- function(style_props) { @@ -673,7 +688,7 @@ style_build <- function(style_props) { # instead of doing so, we transpose the table summaries columns and extract # the resulting row as vector. Feels like a hack but should be performant out <- data.table::transpose(recycled) - out[,lapply(.SD, function(x){ + out[, lapply(.SD, function(x) { paste(names(recycled), x, sep = ":", collapse = ";") })] |> as.matrix() |> @@ -681,7 +696,7 @@ style_build <- function(style_props) { } html_tag <- function(name, style_props = list(), value = NULL, attr = NULL) { - style <- if(rlang::is_empty(style_props)) "" else style_build(style_props) + style <- if (rlang::is_empty(style_props)) "" else style_build(style_props) if (is.null(value)) { paste0("<", name, attr, " style=\"", style, "\">") } else { @@ -689,14 +704,14 @@ html_tag <- function(name, style_props = list(), value = NULL, attr = NULL) { } } -span_tag <- function(style_props = list(), value = NULL, attr = NULL){ +span_tag <- function(style_props = list(), value = NULL, attr = NULL) { html_tag(name = "span", style_props = style_props, value = value, attr = attr) } -div_tag <- function(style_props = list(), value = NULL, attr = NULL){ +div_tag <- function(style_props = list(), value = NULL, attr = NULL) { html_tag(name = "div", style_props = style_props, value = value, attr = attr) } -p_tag <- function(style_props = list(), value = NULL, attr = NULL){ +p_tag <- function(style_props = list(), value = NULL, attr = NULL) { html_tag(name = "p", style_props = style_props, value = value, attr = attr) } diff --git a/R/nfl_team_factors.R b/R/nfl_team_factors.R index f97512f8..63f5d9db 100644 --- a/R/nfl_team_factors.R +++ b/R/nfl_team_factors.R @@ -60,7 +60,7 @@ #' theme(strip.text = element_nfl_wordmark()) #' #' } -nfl_team_factor <- function(teams, ...){ +nfl_team_factor <- function(teams, ...) { # clean the names a bit to make them match the nflreadr team names teams <- nflreadr::clean_team_abbrs(teams) n_args <- rlang::dots_n(...) @@ -72,9 +72,11 @@ nfl_team_factor <- function(teams, ...){ # character vector of team names in teams in desired order levels <- - if (n_args == 0L){# default to ascending order of division and nick name + if (n_args == 0L) { + # default to ascending order of division and nick name nfl_teams[team_abbr %in% teams][order(team_division, team_nick)]$team_abbr - } else {# use supplied order in dots + } else { + # use supplied order in dots nfl_teams[team_abbr %in% teams][order(...)]$team_abbr } diff --git a/R/nfl_team_tiers.R b/R/nfl_team_tiers.R index f63d5a95..8b2fcdef 100644 --- a/R/nfl_team_tiers.R +++ b/R/nfl_team_tiers.R @@ -79,27 +79,32 @@ #' devel = TRUE) #' } #' @export -nfl_team_tiers <- function(data, - title = "NFL Team Tiers, 2021 as of Week 4", - subtitle = "created with the #nflplotR Tiermaker", - caption = NULL, - tier_desc = c("1" = "Super Bowl", - "2" = "Very Good", - "3" = "Medium", - "4" = "Bad", - "5" = "What are they doing?", - "6" = "", - "7" = ""), - presort = FALSE, - alpha = 0.8, - width = 0.075, - no_line_below_tier = NULL, - devel = FALSE){ - +nfl_team_tiers <- function( + data, + title = "NFL Team Tiers, 2021 as of Week 4", + subtitle = "created with the #nflplotR Tiermaker", + caption = NULL, + tier_desc = c( + "1" = "Super Bowl", + "2" = "Very Good", + "3" = "Medium", + "4" = "Bad", + "5" = "What are they doing?", + "6" = "", + "7" = "" + ), + presort = FALSE, + alpha = 0.8, + width = 0.075, + no_line_below_tier = NULL, + devel = FALSE +) { required_vars <- c("tier_no", "team_abbr") - if (!all(required_vars %in% names(data))){ - cli::cli_abort("The data frame {.var data} has to include the variables {.var {required_vars}}!") + if (!all(required_vars %in% names(data))) { + cli::cli_abort( + "The data frame {.var data} has to include the variables {.var {required_vars}}!" + ) } bg <- "#1e1e1e" @@ -109,23 +114,37 @@ nfl_team_tiers <- function(data, tierlines <- tiers[!tiers %in% no_line_below_tier] + 0.5 tierlines <- c(min(tiers) - 0.5, tierlines) - if (isTRUE(presort)){ + if (isTRUE(presort)) { data <- data.table::as.data.table(data)[order(tier_no, team_abbr)] data[, tier_rank := 1:.N, by = "tier_no"] } - if (!"tier_rank" %in% names(data)){ + if (!"tier_rank" %in% names(data)) { data <- data.table::as.data.table(data) data[, tier_rank := 1:.N, by = "tier_no"] } - data$team_abbr <- nflreadr::clean_team_abbrs(as.character(data$team_abbr), keep_non_matches = FALSE) + data$team_abbr <- nflreadr::clean_team_abbrs( + as.character(data$team_abbr), + keep_non_matches = FALSE + ) - p <- ggplot2::ggplot(data, ggplot2::aes(y = .data$tier_no, x = .data$tier_rank)) + + p <- ggplot2::ggplot( + data, + ggplot2::aes(y = .data$tier_no, x = .data$tier_rank) + ) + ggplot2::geom_hline(yintercept = tierlines, color = lines) - if(isFALSE(devel)) p <- p + nflplotR::geom_nfl_logos(ggplot2::aes(team_abbr = .data$team_abbr), width = width, alpha = alpha) - if(isTRUE(devel))p <- p + ggplot2::geom_text(ggplot2::aes(label = .data$team_abbr), color = "white") + if (isFALSE(devel)) + p <- p + + nflplotR::geom_nfl_logos( + ggplot2::aes(team_abbr = .data$team_abbr), + width = width, + alpha = alpha + ) + if (isTRUE(devel)) + p <- p + + ggplot2::geom_text(ggplot2::aes(label = .data$team_abbr), color = "white") p <- p + ggplot2::scale_y_continuous( @@ -143,7 +162,11 @@ nfl_team_tiers <- function(data, plot.caption = ggplot2::element_text(color = "#8e8e93", hjust = 1), plot.title.position = "plot", axis.text.x = ggplot2::element_blank(), - axis.text.y = ggplot2::element_text(color = "white", face = "bold", size = ggplot2::rel(1.1)), + axis.text.y = ggplot2::element_text( + color = "white", + face = "bold", + size = ggplot2::rel(1.1) + ), axis.title = ggplot2::element_blank(), panel.grid = ggplot2::element_blank(), plot.background = ggplot2::element_rect(fill = bg, color = bg), @@ -153,4 +176,3 @@ nfl_team_tiers <- function(data, p } - diff --git a/R/scale_nfl.R b/R/scale_nfl.R index 4c1bb068..a79d7a1a 100644 --- a/R/scale_nfl.R +++ b/R/scale_nfl.R @@ -43,25 +43,27 @@ NULL #' @rdname scale_nfl #' @export -scale_color_nfl <- function(type = c("primary", "secondary"), - values = NULL, - ..., - aesthetics = "colour", - breaks = ggplot2::waiver(), - na.value = "grey50", - guide = NULL, - alpha = NA) { - +scale_color_nfl <- function( + type = c("primary", "secondary"), + values = NULL, + ..., + aesthetics = "colour", + breaks = ggplot2::waiver(), + na.value = "grey50", + guide = NULL, + alpha = NA +) { type <- rlang::arg_match(type) - if(is.null(values)){ - values <- switch(type, + if (is.null(values)) { + values <- switch( + type, "primary" = primary_colors, "secondary" = secondary_colors ) } - if(!is.na(alpha)) values <- scales::alpha(values, alpha = alpha) + if (!is.na(alpha)) values <- scales::alpha(values, alpha = alpha) ggplot2::scale_color_manual( ..., @@ -80,25 +82,27 @@ scale_colour_nfl <- scale_color_nfl #' @rdname scale_nfl #' @export -scale_fill_nfl <- function(type = c("primary", "secondary"), - values = NULL, - ..., - aesthetics = "fill", - breaks = ggplot2::waiver(), - na.value = "grey50", - guide = NULL, - alpha = NA) { - +scale_fill_nfl <- function( + type = c("primary", "secondary"), + values = NULL, + ..., + aesthetics = "fill", + breaks = ggplot2::waiver(), + na.value = "grey50", + guide = NULL, + alpha = NA +) { type <- rlang::arg_match(type) - if(is.null(values)){ - values <- switch(type, + if (is.null(values)) { + values <- switch( + type, "primary" = primary_colors, "secondary" = secondary_colors ) } - if(!is.na(alpha)) values <- scales::alpha(values, alpha = alpha) + if (!is.na(alpha)) values <- scales::alpha(values, alpha = alpha) ggplot2::scale_fill_manual( ..., diff --git a/R/utils.R b/R/utils.R index 334a1cf1..d6c20c4d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,22 +11,26 @@ #' #' # List valid team abbreviations excluding duplicates #' valid_team_names(exclude_duplicates = FALSE) -valid_team_names <- function(exclude_duplicates = TRUE){ - n <- sort(names(logo_list)) - if(isTRUE(exclude_duplicates)) n <- n[!n %in% c("LAR", "OAK", "SD", "STL")] - n +valid_team_names <- function(exclude_duplicates = TRUE) { + n <- sort(names(logo_list)) + if (isTRUE(exclude_duplicates)) n <- n[!n %in% c("LAR", "OAK", "SD", "STL")] + n } -logo_html <- function(team_abbr, type = c("height", "width"), size = 15){ +logo_html <- function(team_abbr, type = c("height", "width"), size = 15) { type <- rlang::arg_match(type) url <- logo_urls[team_abbr] sprintf("", url, type, size) } -headshot_html <- function(player_gsis, type = c("height", "width"), size = 25){ +headshot_html <- function(player_gsis, type = c("height", "width"), size = 25) { type <- rlang::arg_match(type) headshot_map <- load_headshots() - player_gsis <- ifelse(player_gsis %in% headshot_map$gsis_id, player_gsis, "NA_ID") + player_gsis <- ifelse( + player_gsis %in% headshot_map$gsis_id, + player_gsis, + "NA_ID" + ) headshot_map <- rbind( headshot_map, list(gsis_id = "NA_ID", headshot_nfl = na_headshot()) @@ -47,9 +51,13 @@ is_installed <- function(pkg) requireNamespace(pkg, quietly = TRUE) is_gsis <- function(id) grepl("00-00[0-9]{5}", id, perl = TRUE) -load_headshots <- function() nflreadr::rds_from_url("https://github.com/nflverse/nflplotR/releases/download/nflplotr_infrastructure/headshot_gsis_map.rds") +load_headshots <- function() + nflreadr::rds_from_url( + "https://github.com/nflverse/nflplotR/releases/download/nflplotr_infrastructure/headshot_gsis_map.rds" + ) -na_headshot <- function() "https://static.www.nfl.com/image/private/t_player_profile_landscape_2x/f_auto/league/rfuw3dh4aah4l4eeuubp.png" +na_headshot <- function() + "https://static.www.nfl.com/image/private/t_player_profile_landscape_2x/f_auto/league/rfuw3dh4aah4l4eeuubp.png" #' Clear nflplotR Cache #' @@ -59,8 +67,7 @@ na_headshot <- function() "https://static.www.nfl.com/image/private/t_player_pro #' @return Invisibly `NULL` #' @examples #' .nflplotR_clear_cache() -.nflplotR_clear_cache <- function(){ - +.nflplotR_clear_cache <- function() { functions <- list( reader_function ) diff --git a/R/zzz.R b/R/zzz.R index 64ac623b..1ba5e168 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,24 +1,31 @@ # nocov start -.onLoad <- function(libname,pkgname){ - +.onLoad <- function(libname, pkgname) { S7::methods_register() memoise_option <- getOption("nflplotR.cache", default = "memory") - if(!memoise_option %in% c("memory", "filesystem", "off")) memoise_option <- "memory" + if (!memoise_option %in% c("memory", "filesystem", "off")) + memoise_option <- "memory" - if(memoise_option == "filesystem"){ + if (memoise_option == "filesystem") { cache_dir <- R_user_dir("nflplotR", "cache") - if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE) + if (!dir.exists(cache_dir)) + dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE) cache <- cachem::cache_disk(dir = cache_dir) } - if(memoise_option == "memory") cache <- cachem::cache_mem() + if (memoise_option == "memory") cache <- cachem::cache_mem() - if(memoise_option != "off"){ - assign(x = "reader_function", - value = memoise::memoise(reader_function, ~ memoise::timeout(86400), cache = cache), - envir = parent.env(environment())) + if (memoise_option != "off") { + assign( + x = "reader_function", + value = memoise::memoise( + reader_function, + ~ memoise::timeout(86400), + cache = cache + ), + envir = parent.env(environment()) + ) } # CRAN incoming checks can fail if examples or tests use more than 2 cores. @@ -33,14 +40,18 @@ # nflplotR depends on magick which also uses OMP but doesn't respect # OMP_THREAD_LIMIT. I have to skip the related tests unfortunately. cpu_check <- suppressWarnings(stats::na.omit(as.numeric(c( - Sys.getenv("_R_CHECK_EXAMPLE_TIMING_CPU_TO_ELAPSED_THRESHOLD_", unset = 0), - Sys.getenv("_R_CHECK_TEST_TIMING_CPU_TO_ELAPSED_THRESHOLD_", unset = 0) - )))) + Sys.getenv("_R_CHECK_EXAMPLE_TIMING_CPU_TO_ELAPSED_THRESHOLD_", unset = 0), + Sys.getenv("_R_CHECK_TEST_TIMING_CPU_TO_ELAPSED_THRESHOLD_", unset = 0) + )))) if (any(cpu_check != 0)) { cores <- suppressWarnings(min( - floor(as.integer(Sys.getenv("_R_CHECK_EXAMPLE_TIMING_CPU_TO_ELAPSED_THRESHOLD_"))), - floor(as.integer(Sys.getenv("_R_CHECK_TEST_TIMING_CPU_TO_ELAPSED_THRESHOLD_"))), + floor(as.integer(Sys.getenv( + "_R_CHECK_EXAMPLE_TIMING_CPU_TO_ELAPSED_THRESHOLD_" + ))), + floor(as.integer(Sys.getenv( + "_R_CHECK_TEST_TIMING_CPU_TO_ELAPSED_THRESHOLD_" + ))), 2L, na.rm = TRUE )) @@ -51,19 +62,21 @@ } } -.onAttach <- function(libname, pkgname){ - +.onAttach <- function(libname, pkgname) { # validate nflplotR.cache - memoise_option <- getOption("nflplotR.cache",default = "memory") + memoise_option <- getOption("nflplotR.cache", default = "memory") if (!memoise_option %in% c("memory", "filesystem", "off")) { - packageStartupMessage('Note: nflplotR.cache is set to "', - memoise_option, - '" and should be one of c("memory","filesystem", "off"). \n', - 'Defaulting to "memory".') + packageStartupMessage( + 'Note: nflplotR.cache is set to "', + memoise_option, + '" and should be one of c("memory","filesystem", "off"). \n', + 'Defaulting to "memory".' + ) memoise_option <- "memory" } - if(memoise_option == "off") packageStartupMessage('Note: nflplotR.cache is set to "off"') + if (memoise_option == "off") + packageStartupMessage('Note: nflplotR.cache is set to "off"') } # nocov end diff --git a/data-raw/build_logo.R b/data-raw/build_logo.R index 499ed183..ad80ce42 100644 --- a/data-raw/build_logo.R +++ b/data-raw/build_logo.R @@ -21,7 +21,7 @@ df <- data.frame( p <- ggplot(df, aes(x = a, y = b)) + geom_nfl_logos(aes(team_abbr = teams), width = 0.09, alpha = 0.2) + - coord_cartesian(xlim = c(0.5,8.5), ylim = c(0.5,4.5)) + + coord_cartesian(xlim = c(0.5, 8.5), ylim = c(0.5, 4.5)) + theme_void() + theme_transparent() diff --git a/data-raw/social_preview.R b/data-raw/social_preview.R index 49deeb01..ec7aaed1 100644 --- a/data-raw/social_preview.R +++ b/data-raw/social_preview.R @@ -13,18 +13,47 @@ df <- data.frame( p <- ggplot(df, aes(x = a, y = b)) + geom_nfl_logos(aes(team_abbr = teams), width = 0.09, alpha = 0.2) + - annotate("text", x = 4.5, y = 2.5, label = "nflplotR", family = "Kanit", size = 7, color = "#ffffff") + - annotate("text", x = 8.7, y = 0.5, label = "Part of the #nflverse", hjust = 1, size = 1.2, color = "#ffffff") + - annotate("text", x = 6.5, y = 2, label = "by @mrcaseb ", hjust = 1, size = 1.2, color = "#ffffff") + + annotate( + "text", + x = 4.5, + y = 2.5, + label = "nflplotR", + family = "Kanit", + size = 7, + color = "#ffffff" + ) + + annotate( + "text", + x = 8.7, + y = 0.5, + label = "Part of the #nflverse", + hjust = 1, + size = 1.2, + color = "#ffffff" + ) + + annotate( + "text", + x = 6.5, + y = 2, + label = "by @mrcaseb ", + hjust = 1, + size = 1.2, + color = "#ffffff" + ) + theme_void() + - coord_cartesian(xlim = c(0.5,8.5), ylim = c(0.5,4.5)) + coord_cartesian(xlim = c(0.5, 8.5), ylim = c(0.5, 4.5)) # ggpreview(p, width = 1280, height = 640, units = "px", dpi = 600, bg = "#222222") -ggsave("man/figures/social_preview.png", - p, width = 1280, height = 640, units = "px", dpi = 600, - bg = "#222222") - +ggsave( + "man/figures/social_preview.png", + p, + width = 1280, + height = 640, + units = "px", + dpi = 600, + bg = "#222222" +) # GT ---------------------------------------------------------------------- diff --git a/data-raw/update_headshot_gsis_map.R b/data-raw/update_headshot_gsis_map.R index 4268b876..1c4cc790 100644 --- a/data-raw/update_headshot_gsis_map.R +++ b/data-raw/update_headshot_gsis_map.R @@ -23,7 +23,7 @@ if (FALSE) { # LOAD ROSTER AND RELEASE RELEVANT DATA BY SEASON purrr::walk( seasons_to_update, - function (s) { + function(s) { r <- nflapi::nflapi_roster(s) |> nflapi::nflapi_roster_parse() |> dplyr::select( @@ -32,13 +32,17 @@ purrr::walk( ) |> dplyr::filter(!is.na(gsis_id), !is.na(headshot_nfl)) |> dplyr::mutate( - headshot_nfl = stringr::str_replace(headshot_nfl, "\\{formatInstructions\\}", "f_auto,q_auto") + headshot_nfl = stringr::str_replace( + headshot_nfl, + "\\{formatInstructions\\}", + "f_auto,q_auto" + ) ) # Going into the 2024 season, the headshot of Jayden Daniels is missing # We use his combine headshot instead - if (s == 2024){ - if (!"00-0039910" %in% r$gsis_id){ + if (s == 2024) { + if (!"00-0039910" %in% r$gsis_id) { r <- r |> dplyr::bind_rows( tibble::tibble( @@ -65,8 +69,10 @@ purrr::walk( combined_map <- purrr::map( 1999:nflreadr::most_recent_season(roster = TRUE), - function(s){ - load_from <- glue::glue("https://github.com/nflverse/nflplotR/releases/download/nflplotr_infrastructure/headshot_gsis_map_{s}.rds") + function(s) { + load_from <- glue::glue( + "https://github.com/nflverse/nflplotR/releases/download/nflplotr_infrastructure/headshot_gsis_map_{s}.rds" + ) nflreadr::rds_from_url(load_from) |> dplyr::mutate(season = s) }, diff --git a/tests/testthat/test-geom_nfl_logos.R b/tests/testthat/test-geom_nfl_logos.R index d6e417ec..e06c859d 100644 --- a/tests/testthat/test-geom_nfl_logos.R +++ b/tests/testthat/test-geom_nfl_logos.R @@ -3,9 +3,48 @@ test_that("logo geom works", { skip_on_cran() library(ggplot2) - teams_a <- c("DEN", "KC", "LA", "CAR", "LAC", "IND", "DAL", NA_character_, "ARI", "WAS", "MIN", "TB") - teams_b <- c("CHI", "JAX", "PIT", "CIN", "DET", "NYJ", "CLE", "NE", "AFC", "SEA", "GB", "PHI") - teams_c <- c("ATL", "BAL", "BUF", "HOU", "LV", "MIA", "NFC", "NO", "NYG", "SF", "TEN", NA_character_) + teams_a <- c( + "DEN", + "KC", + "LA", + "CAR", + "LAC", + "IND", + "DAL", + NA_character_, + "ARI", + "WAS", + "MIN", + "TB" + ) + teams_b <- c( + "CHI", + "JAX", + "PIT", + "CIN", + "DET", + "NYJ", + "CLE", + "NE", + "AFC", + "SEA", + "GB", + "PHI" + ) + teams_c <- c( + "ATL", + "BAL", + "BUF", + "HOU", + "LV", + "MIA", + "NFC", + "NO", + "NYG", + "SF", + "TEN", + NA_character_ + ) df_a <- na.omit(data.frame( a = rep(1:4, 3), @@ -36,20 +75,35 @@ test_that("logo geom works", { # apply alpha via an aesthetic from inside the dataset `df_a` p1 <- ggplot(df_a, aes(x = a, y = b)) + geom_nfl_logos(aes(team_abbr = teams, alpha = alpha), width = 0.04) + - geom_label(aes(label = teams), nudge_y = -0.35, alpha = 0.5, fill = "transparent") + + geom_label( + aes(label = teams), + nudge_y = -0.35, + alpha = 0.5, + fill = "transparent" + ) + scale_alpha_identity() + theme_void() # apply alpha and colour via an aesthetic from inside the dataset `df_b` p2 <- ggplot(df_b, aes(x = a, y = b)) + geom_nfl_logos(aes(team_abbr = teams, colour = colour), width = 0.04) + - geom_label(aes(label = teams), nudge_y = -0.35, alpha = 0.5, fill = "transparent") + + geom_label( + aes(label = teams), + nudge_y = -0.35, + alpha = 0.5, + fill = "transparent" + ) + scale_color_identity() + theme_void() p3 <- ggplot(df_c, aes(x = a, y = b)) + geom_nfl_logos(aes(team_abbr = teams), width = 0.04) + - geom_label(aes(label = teams), nudge_y = -0.4, alpha = 0.5, fill = "transparent") + + geom_label( + aes(label = teams), + nudge_y = -0.4, + alpha = 0.5, + fill = "transparent" + ) + theme_void() vdiffr::expect_doppelganger("p1", p1) diff --git a/tests/testthat/test-geom_nfl_wordmarks.R b/tests/testthat/test-geom_nfl_wordmarks.R index 60a41299..e0eb804b 100644 --- a/tests/testthat/test-geom_nfl_wordmarks.R +++ b/tests/testthat/test-geom_nfl_wordmarks.R @@ -3,11 +3,43 @@ test_that("wordmark geom works", { skip_on_cran() library(ggplot2) - teams_a <- c("KC", "MIA", "TB", "ARI", "LAC", "IND", "TEN", "PIT", - "NO", "CLE", "CIN", "MIN", "DAL", "JAX", "ATL", "BAL") + teams_a <- c( + "KC", + "MIA", + "TB", + "ARI", + "LAC", + "IND", + "TEN", + "PIT", + "NO", + "CLE", + "CIN", + "MIN", + "DAL", + "JAX", + "ATL", + "BAL" + ) - teams_b <- c("BUF", "CAR", "CHI", "DEN", "DET", "GB", "HOU", "LA", - "LV", "NE", "NYG", "NYJ", "PHI", "SEA", "SF", "WAS") + teams_b <- c( + "BUF", + "CAR", + "CHI", + "DEN", + "DET", + "GB", + "HOU", + "LA", + "LV", + "NE", + "NYG", + "NYJ", + "PHI", + "SEA", + "SF", + "WAS" + ) df_a <- data.frame( a = rep(1:4, 2), @@ -32,7 +64,12 @@ test_that("wordmark geom works", { # apply alpha via an aesthetic from inside the dataset `df_a` p1 <- ggplot(df_a, aes(x = a, y = b)) + geom_nfl_wordmarks(aes(team_abbr = teams, alpha = alpha), width = 0.12) + - geom_label(aes(label = teams), nudge_y = -0.20, alpha = 0.5, fill = "transparent") + + geom_label( + aes(label = teams), + nudge_y = -0.20, + alpha = 0.5, + fill = "transparent" + ) + scale_x_continuous(expand = expansion(add = 0.5)) + scale_alpha_identity() + theme_void() @@ -40,7 +77,12 @@ test_that("wordmark geom works", { # apply colour via an aesthetic from inside the dataset `df_b` p2 <- ggplot(df_b, aes(x = a, y = b)) + geom_nfl_wordmarks(aes(team_abbr = teams, colour = colour), width = 0.12) + - geom_label(aes(label = teams), nudge_y = -0.20, alpha = 0.5, fill = "transparent") + + geom_label( + aes(label = teams), + nudge_y = -0.20, + alpha = 0.5, + fill = "transparent" + ) + scale_x_continuous(expand = expansion(add = 0.5)) + scale_alpha_identity() + scale_color_identity() + diff --git a/tests/testthat/test-gt_nfl.R b/tests/testthat/test-gt_nfl.R index 23ee34dd..f6a26bb3 100644 --- a/tests/testthat/test-gt_nfl.R +++ b/tests/testthat/test-gt_nfl.R @@ -8,7 +8,8 @@ test_that("gt_pct_bar works", { tbl <- gt::gt(df, id = "test1") |> nflplotR::gt_pct_bar( - "value", "pctl", + "value", + "pctl", hide_col_pct = FALSE, value_padding_left = ifelse(df$pctl < 25, "110%", "10px"), fill_border.radius = "3px", @@ -21,7 +22,8 @@ test_that("gt_pct_bar works", { tbl <- gt::gt(df, id = "test2") |> nflplotR::gt_pct_bar( - "value", "pctl", + "value", + "pctl", hide_col_pct = FALSE, value_position = "above", # with value_position = "above", we need an absolute value of bar heights! diff --git a/tests/testthat/test-nfl_team_tiers.R b/tests/testthat/test-nfl_team_tiers.R index f56e59c3..9efce8a8 100644 --- a/tests/testthat/test-nfl_team_tiers.R +++ b/tests/testthat/test-nfl_team_tiers.R @@ -14,17 +14,21 @@ test_that("team tiers work", { dt <- data.table::data.table( tier_no = sample(1:5, length(teams), replace = TRUE), team_abbr = teams - )[,tier_rank := sample(1:.N, .N), by = "tier_no"] + )[, tier_rank := sample(1:.N, .N), by = "tier_no"] # Check dev mode only because logos are tested elsewhere - p1 <- nfl_team_tiers(dt, - tier_desc = c("1" = "Super Bowl", - "2" = "Very Good", - "3" = "", - "4" = "A Combined Tier", - "5" = ""), - no_line_below_tier = c(2, 4), - devel = TRUE) + p1 <- nfl_team_tiers( + dt, + tier_desc = c( + "1" = "Super Bowl", + "2" = "Very Good", + "3" = "", + "4" = "A Combined Tier", + "5" = "" + ), + no_line_below_tier = c(2, 4), + devel = TRUE + ) vdiffr::expect_doppelganger("p1", p1) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 6f57ea12..861fa97e 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,9 +1,45 @@ test_that("valid_team_names works", { - valid_all <- c("AFC", "ARI", "ATL", "BAL", "BUF", "CAR", "CHI", "CIN", "CLE", - "DAL", "DEN", "DET", "GB", "HOU", "IND", "JAX", "KC", - "LA", "LAC", "LAR", "LV", "MIA", "MIN", "NE", "NFC", "NFL", "NO", - "NYG", "NYJ", "OAK", "PHI", "PIT", "SD", "SEA", "SF", - "STL", "TB", "TEN", "WAS") + valid_all <- c( + "AFC", + "ARI", + "ATL", + "BAL", + "BUF", + "CAR", + "CHI", + "CIN", + "CLE", + "DAL", + "DEN", + "DET", + "GB", + "HOU", + "IND", + "JAX", + "KC", + "LA", + "LAC", + "LAR", + "LV", + "MIA", + "MIN", + "NE", + "NFC", + "NFL", + "NO", + "NYG", + "NYJ", + "OAK", + "PHI", + "PIT", + "SD", + "SEA", + "SF", + "STL", + "TB", + "TEN", + "WAS" + ) valid_filtered <- valid_all[!valid_all %in% c("LAR", "OAK", "SD", "STL")]