Add 2 new FBref load functions

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: worldfootballR
 Title: Extract and Clean World Football (Soccer) Data
-Version: 0.6.4.0006
+Version: 0.6.4.0007
 Authors@R: c(
     person("Jason", "Zivkovic", , "[email protected]", role = c("aut", "cre", "cph")),
     person("Tony", "ElHabr", , "[email protected]", role = "ctb"),

NAMESPACE

@@ -36,6 +36,7 @@ export(get_season_team_stats)
 export(get_team_match_results)
 export(load_fb_big5_advanced_season_stats)
 export(load_fb_match_shooting)
+export(load_fb_match_summary)
 export(load_match_comp_results)
 export(load_match_results)
 export(load_understat_league_shots)

NEWS.md

@@ -11,6 +11,8 @@
 * `fb_league_stats()` now correctly scrapes non domestic competitions [https://github.com/JaseZiv/worldfootballR/pull/325] (0.6.4.0003)
 * `fb_team_match_stats()` and `understat_available_teams()` (0.6.4.0004)
 * `fb_match_shooting()`, `fb_advanced_match_stats()`, `fb_league_stats(team_or_player = "player")` gain `Player_Href` column (0.6.4.0005)
+* `load_fb_advanced_stats()` and `load_fb_match_summary()` added (0.6.4.0007)
+
 
 ***
 

R/load_fb.R

@@ -28,7 +28,6 @@
 #' )
 #' })
 #' }
-
 load_match_results <- function(country, gender, season_end_year, tier) {
 
   dat_urls <- paste0("https://github.com/JaseZiv/worldfootballR_data/releases/download/match_results/", country, "_match_results.rds")
@@ -174,7 +173,7 @@ load_fb_big5_advanced_season_stats <- function(season_end_year = NA, stat_type,
 #' Loading version of \code{fb_match_shooting}. Only some leagues available.
 #'
 #' @inheritParams load_match_results
-#' @importFrom purrr possibly map_dfr
+#' @importFrom purrr map_dfr
 #' @importFrom cli cli_alert
 #' @importFrom dplyr filter
 #' @importFrom rlang .data
@@ -225,3 +224,118 @@ load_fb_match_shooting <- function(country, gender, tier, season_end_year = NA)
 
 }
 
+#' Load pre-saved FBref match summary data
+#'
+#' Loading version of \code{fb_match_summary}. Only some leagues available.
+#'
+#' @inheritParams load_match_results
+#' @importFrom purrr map_dfr
+#' @importFrom cli cli_alert
+#' @importFrom dplyr filter
+#' @importFrom rlang .data
+#' @return returns a dataframe
+#' @examples
+#' \donttest{
+#' try({
+#' load_fb_match_summary(
+#'   country = "ENG",
+#'   gender = "M",
+#'   tier = "1st"
+#' )
+#'
+#' load_fb_match_summary(
+#'   country = c("ITA", "ESP"),
+#'   gender = "M",
+#'   tier = "1st",
+#'   season_end_year = 2019
+#' )
+#' })
+#' }
+#' @export
+load_fb_match_summary <- function(country, gender, tier, season_end_year = NA) {
+
+  urls <- sprintf(
+    "https://github.com/JaseZiv/worldfootballR_data/releases/download/fb_match_summary/%s_%s_%s_match_summary.rds",
+    country,
+    gender,
+    tier
+  )
+
+  res <- purrr::map_dfr(urls, worldfootballR:::.file_reader)
+
+  if(nrow(res) == 0) {
+    cli::cli_alert("Data not loaded. Please check parameters.")
+    return(res)
+  } else {
+    cli::cli_alert("Data last updated {attr(res, 'scrape_timestamp')} UTC")
+  }
+
+  if (!all(is.na(season_end_year))) {
+    res <- res %>%
+      dplyr::filter(.data[["Season_End_Year"]] %in% season_end_year)
+  }
+
+  res
+
+}
+
+#' Load pre-saved FBref match advanced stats
+#'
+#' Loading version of \code{fb_advanced_match_stats}. Only some leagues available.
+#'
+#' @inheritParams load_match_results
+#' @inheritParams fb_advanced_match_stats
+#' @importFrom purrr map_dfr
+#' @importFrom cli cli_alert
+#' @importFrom dplyr filter
+#' @importFrom rlang .data
+#' @return returns a dataframe
+#' @examples
+#' \donttest{
+#' try({
+#' load_fb_advanced_match_stats(
+#'   country = "ENG",
+#'   gender = "M",
+#'   tier = "1st",
+#'   stat_type = "summary",
+#'   team_or_player = "player"
+#' )
+#'
+#' load_fb_advanced_match_stats(
+#'   country = c("ITA", "ESP"),
+#'   gender = "M",
+#'   tier = "1st",
+#'   season_end_year = 2023,
+#'   stat_type = "defense",
+#'   team_or_player = "player"
+#' )
+#' })
+#' }
+load_fb_advanced_match_stats <- function(country, gender, tier, stat_type, team_or_player, season_end_year = NA) {
+
+  urls <- sprintf(
+    "https://github.com/JaseZiv/worldfootballR_data/releases/download/fb_advanced_match_stats/%s_%s_%s_%s_%s_advanced_match_stats.rds",
+    country,
+    gender,
+    tier,
+    stat_type,
+    team_or_player
+  )
+
+  res <- purrr::map_dfr(urls, .file_reader)
+
+  if(nrow(res) == 0) {
+    cli::cli_alert("Data not loaded. Please check parameters.")
+    return(res)
+  } else {
+    cli::cli_alert("Data last updated {attr(res, 'scrape_timestamp')} UTC")
+  }
+
+  if (!all(is.na(season_end_year))) {
+    res <- res %>%
+      dplyr::filter(.data[["Season_End_Year"]] %in% season_end_year)
+  }
+
+  res
+
+}

tests/testthat/test-load.R

@@ -82,6 +82,105 @@ test_that("load_fb_match_shooting() works", {
   expect_equal(length(unique(test_df$Country)), 1)
 })
 
+test_that("load_fb_match_summary() works", {
+  testthat::skip_on_cran()
+  testthat::skip_if_offline()
+  test_df <- load_fb_match_summary(
+    country = "ENG",
+    gender = "M",
+    tier = "1st"
+  )
+  # test the functions returns the data
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+
+  # test that multiple countries can be passed to the function
+  test_df <- load_fb_match_summary(
+    country = c("ESP", "USA"),
+    gender = "M",
+    season_end_year = 2021,
+    tier = "1st"
+  )
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+  expect_equal(length(unique(test_df$Country)), 2)
+
+  expect_message(
+    bad_df <- load_fb_match_summary(
+      country = "foo",
+      gender = "M",
+      season_end_year = 2022,
+      tier = "1st"
+    ),
+    regexp = "Data not loaded[.] Please check parameters[.]"
+  )
+  expect_true(nrow(bad_df) == 0)
+
+  ## won't error here. instead, will silently not load anything for "foo"
+  test_df <- load_fb_match_summary(
+    country = c("ITA", "foo"),
+    gender = "M",
+    season_end_year = 2021,
+    tier = "1st"
+  )
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+  expect_equal(length(unique(test_df$Country)), 1)
+})
+
+test_that("load_fb_advanced_match_stats() works", {
+  testthat::skip_on_cran()
+  testthat::skip_if_offline()
+  test_df <- load_fb_advanced_match_stats(
+    country = "ENG",
+    gender = "M",
+    tier = "1st",
+    stat_type = "keeper",
+    team_or_player = "player"
+  )
+  # test the functions returns the data
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+
+  # test that multiple countries can be passed to the function
+  test_df <- load_fb_advanced_match_stats(
+    country = c("ESP", "USA"),
+    gender = "M",
+    season_end_year = 2021,
+    tier = "1st",
+    stat_type = "passing",
+    team_or_player = "player"
+  )
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+  expect_equal(length(unique(test_df$Country)), 2)
+
+  expect_message(
+    bad_df <- load_fb_advanced_match_stats(
+      country = "foo",
+      gender = "M",
+      season_end_year = 2022,
+      tier = "1st",
+      stat_type = "summary",
+      team_or_player = "player"
+    ),
+    regexp = "Data not loaded[.] Please check parameters[.]"
+  )
+  expect_true(nrow(bad_df) == 0)
+
+  ## won't error here. instead, will silently not load anything for "foo"
+  test_df <- load_fb_advanced_match_stats(
+    country = c("ITA", "foo"),
+    gender = "M",
+    season_end_year = 2021,
+    tier = "1st",
+    stat_type = "misc",
+    team_or_player = "player"
+  )
+  expect_type(test_df, "list")
+  expect_gt(nrow(test_df), 0)
+  expect_equal(length(unique(test_df$Country)), 1)
+})
 
 test_that("load_match_comp_results() works", {
   testthat::skip_on_cran()