Merge pull request vuejs#6 from American-Soccer-Analysis/r-tests

ASA-159: Write tests and fix bugs

Author: tyler-richardett

R-package/.Rbuildignore

@@ -4,3 +4,6 @@
 ^\.Rproj\.user$
 ^\.github$
 ^LICENSE\.md$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$

R-package/.gitignore

@@ -0,0 +1 @@
+docs

R-package/DESCRIPTION

@@ -1,5 +1,5 @@
 Package: itscalledsoccer
-Title: What the Package Does (Title Case)
+Title: American Soccer Analysis API Client
 Version: 0.0.0.9000
 Author: Tyler Richardett <[email protected]>
 Maintainer: Tyler Richardett <[email protected]>
@@ -21,7 +21,8 @@ Imports:
     R6 (>= 2.5.0),
     tidyr (>= 1.1.1),
     stringi (>= 1.5.3),
-    rlang (>= 0.4.10)
+    rlang (>= 0.4.10),
+    data.table (>= 1.13.0)
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

R-package/NAMESPACE

@@ -2,4 +2,6 @@
 
 export("%>%")
 export(AmericanSoccerAnalysis)
+importFrom(R6,R6Class)
 importFrom(magrittr,"%>%")
+importFrom(rlang,.data)

R-package/R/client.R

@@ -13,8 +13,8 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @field LEAGUES List of stylized league names.
         LEAGUES = c("nwsl", "mls", "uslc", "usl1", "nasl"),
 
-        #' @field BASE_URL API base URL.
-        BASE_URL = NULL,
+        #' @field base_url API base URL.
+        base_url = NULL,
 
         #' @field players Data frame containing players from all leagues.
         players = NULL,
@@ -31,23 +31,39 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @field referees Data frame containing referees from all leagues.
         referees = NULL,
 
+        #' @field httr_configs Configs to pass on to all \code{httr} functions. See \href{https://www.rdocumentation.org/packages/httr/versions/1.4.2/topics/config}{documentation}.
+        httr_configs = list(),
+
         #' @description Creates a new \code{AmericanSoccerAnalysis} object.
+        #' @param ... Configs to pass on to all \code{httr} functions. See \href{https://www.rdocumentation.org/packages/httr/versions/1.4.2/topics/config}{documentation}.
         #' @return A new \code{AmericanSoccerAnalysis} object.
-        initialize = function() {
-            self$BASE_URL <- glue::glue("https://app.americansocceranalysis.com/api/{self$API_VERSION}")
+        initialize = function(...) {
+            self$base_url <- glue::glue("https://app.americansocceranalysis.com/api/{self$API_VERSION}")
+            self$httr_configs <- list(...)
             self$players <- get_entity(self, "player")
             self$teams <- get_entity(self, "team")
             self$stadia <- get_entity(self, "stadium")
             self$managers <- get_entity(self, "manager")
             self$referees <- get_entity(self, "referee")
         },
 
+        #' @description Appends new \code{httr} configs to the existing class.
+        #' @param ... Configs to pass on to all \code{httr} functions. See \href{https://www.rdocumentation.org/packages/httr/versions/1.4.2/topics/config}{documentation}.
+        add_httr_configs = function(...) {
+            self$httr_configs <- c(self$httr_configs, list(...))
+        },
+
+        #' @description Removes all \code{httr} configs from the existing class.
+        reset_httr_configs = function() {
+            self$httr_configs <- list()
+        },
+
         #' @description Retrieves a data frame containing player names, IDs, and other metadata.
         #' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
         #' @param ids Player IDs on which to filter. Cannot be combined with \code{names}. Accepts a character vector of length >= 1.
         #' @param names Player names on which to filter. Partial matches are accepted. Cannot be combined with \code{ids}. Accepts a character vector of length >= 1.
         get_players = function(leagues, ids, names) {
-            players <- filter_entity(self$players, self$LEAGUES, leagues, ids, names)
+            players <- filter_entity(self, "players", leagues, ids, names)
             return(players)
         },
 
@@ -56,7 +72,7 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @param ids Team IDs on which to filter. Cannot be combined with \code{names}. Accepts a character vector of length >= 1.
         #' @param names Team names on which to filter. Partial matches and abbreviations are accepted. Cannot be combined with \code{ids}. Accepts a character vector of length >= 1.
         get_teams = function(leagues, ids, names) {
-            teams <- filter_entity(self$teams, self$LEAGUES, leagues, ids, names)
+            teams <- filter_entity(self, "teams", leagues, ids, names)
             return(teams)
         },
 
@@ -65,7 +81,7 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @param ids Stadium IDs on which to filter. Cannot be combined with \code{names}. Accepts a character vector of length >= 1.
         #' @param names Stadium names on which to filter. Partial matches are accepted. Cannot be combined with \code{ids}. Accepts a character vector of length >= 1.
         get_stadia = function(leagues, ids, names) {
-            stadia <- filter_entity(self$stadia, self$LEAGUES, leagues, ids, names)
+            stadia <- filter_entity(self, "stadia", leagues, ids, names)
             return(stadia)
         },
 
@@ -74,7 +90,7 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @param ids Manager IDs on which to filter. Cannot be combined with \code{names}. Accepts a character vector of length >= 1.
         #' @param names Manager names on which to filter. Partial matches are accepted. Cannot be combined with \code{ids}. Accepts a character vector of length >= 1.
         get_managers = function(leagues, ids, names) {
-            managers <- filter_entity(self$managers, self$LEAGUES, leagues, ids, names)
+            managers <- filter_entity(self, "managers", leagues, ids, names)
             return(managers)
         },
 
@@ -83,7 +99,7 @@ AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
         #' @param ids Referee IDs on which to filter. Cannot be combined with \code{names}. Accepts a character vector of length >= 1.
         #' @param names Referee names on which to filter. Partial matches are accepted. Cannot be combined with \code{ids}. Accepts a character vector of length >= 1.
         get_referees = function(leagues, ids, names) {
-            referees <- filter_entity(self$referees, self$LEAGUES, leagues, ids, names)
+            referees <- filter_entity(self, "referees", leagues, ids, names)
             return(referees)
         },
 

R-package/R/entities.R

@@ -1,38 +1,42 @@
+#' @importFrom rlang .data
 get_entity <- function(self, type) {
-    entity_all <- data.frame()
+    entity_all <- list()
+    i <- 1
 
     for (league in self$LEAGUES) {
         if (type == "stadium") {
-            url <- glue::glue("{self$BASE_URL}/{league}/stadia")
+            url <- glue::glue("{self$base_url}/{league}/stadia")
         } else {
-            url <- glue::glue("{self$BASE_URL}/{league}/{type}s")
+            url <- glue::glue("{self$base_url}/{league}/{type}s")
         }
 
         response <- .execute_query(self, url)
         response <- response %>% dplyr::mutate(competition = league)
 
-        entity_all <- entity_all %>% dplyr::bind_rows(response)
+        entity_all[[i]] <- response
+        i <- i + 1
     }
 
-    entity_all <- entity_all %>%
+    entity_all <- data.table::rbindlist(entity_all, fill = TRUE) %>%
         dplyr::group_by(dplyr::across(c(-dplyr::matches("competition"), -dplyr::starts_with("season"), -dplyr::ends_with("position")))) %>%
-        dplyr::summarize(competitions = list(rlang::.data$competition)) %>%
+        dplyr::summarize(competitions = list(.data$competition)) %>%
         dplyr::ungroup() %>%
         dplyr::arrange(!!as.symbol(glue::glue("{type}_name")))
 
     return(entity_all)
 }
 
-filter_entity <- function(entity_all, league_options, leagues, ids, names) {
-    .check_leagues(leagues, league_options)
+#' @importFrom rlang .data
+filter_entity <- function(self, entity, leagues, ids, names) {
+    .check_leagues(self, leagues)
     .check_ids_names(ids, names)
 
-    entity_filtered <- entity_all %>%
-        tidyr::unnest(rlang::.data$competitions)
+    entity_filtered <- self[[entity]] %>%
+        tidyr::unnest(.data$competitions)
 
     if (!missing(leagues)) {
         entity_filtered <- entity_filtered %>%
-            dplyr::filter(rlang::.data$competitions %in% leagues)
+            dplyr::filter(.data$competitions %in% leagues)
     }
 
     if (!missing(names)) {
@@ -45,14 +49,15 @@ filter_entity <- function(entity_all, league_options, leagues, ids, names) {
     }
 
     entity_filtered <- entity_filtered %>%
-        dplyr::select(-rlang::.data$competitions) %>%
+        dplyr::select(-.data$competitions) %>%
         dplyr::distinct()
 
     return(entity_filtered)
 }
 
+#' @importFrom rlang .data
 get_games <- function(self, leagues, game_ids, team_ids, team_names, seasons, stages) {
-    .check_leagues(leagues, self$LEAGUES)
+    .check_leagues(self, leagues)
     .check_ids_names(team_ids, team_names)
 
     if (missing(leagues)) leagues <- self$LEAGUES
@@ -64,17 +69,18 @@ get_games <- function(self, leagues, game_ids, team_ids, team_names, seasons, st
     if (!missing(seasons)) query$season_name <- seasons
     if (!missing(stages)) query$stage_name <- stages
 
-    games <- data.frame()
+    games <- list()
+    i <- 1
 
     for (league in leagues) {
-        url <- glue::glue("{self$BASE_URL}/{league}/games")
+        url <- glue::glue("{self$base_url}/{league}/games")
 
         response <- .execute_query(self, url, query)
 
-        games <- games %>%
-            dplyr::bind_rows(response) %>%
-            dplyr::arrange(rlang::.data$date_time_utc)
+        games[[i]] <- response
+        i <- i + 1
     }
 
+    games <- data.table::rbindlist(games, fill = TRUE) %>% dplyr::arrange(.data$date_time_utc)
     return(games)
 }

R-package/R/imports.R

@@ -12,3 +12,7 @@
 #' @param rhs A function call using the magrittr semantics.
 #' @return The result of calling `rhs(lhs)`.
 NULL
+
+# Suppress R CMD check note
+#' @importFrom R6 R6Class
+NULL

R-package/R/stats.R

@@ -1,3 +1,4 @@
+#' @importFrom rlang .data
 get_stats <- function(self, type, entity, leagues, ...) {
     query <- list(...)
     if (!all(rlang::have_name(query))) {
@@ -6,7 +7,7 @@ get_stats <- function(self, type, entity, leagues, ...) {
         stop(msg)
     }
 
-    .check_leagues(leagues, self$LEAGUES)
+    .check_leagues(self, leagues)
     if (missing(leagues)) leagues <- self$LEAGUES
 
     if (sum(grepl("player_", names(query))) > 0) {
@@ -42,24 +43,29 @@ get_stats <- function(self, type, entity, leagues, ...) {
     }
 
 
-    stats <- data.frame()
+    stats <- list()
+    i <- 1
 
     for (league in leagues) {
-        url <- glue::glue("{self$BASE_URL}/{league}/{entity}/{type}")
+        url <- glue::glue("{self$base_url}/{league}/{entity}/{type}")
 
-        response <- .execute_query(self, url, query)
+        response <- .execute_query(self, url, query) %>%
+            as.data.frame() %>%
+            dplyr::mutate(competition = league)
 
-        stats <- stats %>%
-            dplyr::bind_rows(response)
+        stats[[i]] <- response
+        i <- i + 1
     }
 
+    stats <- data.table::rbindlist(stats, fill = TRUE)
+
 
     if (entity %in% c("players", "goalkeepers") & (exists("player_ids_to_filter") && !is.null(player_ids_to_filter))) {
-        stats <- stats %>% dplyr::filter(rlang::.data$player_id %in% player_ids_to_filter)
+        stats <- stats %>% dplyr::filter(.data$player_id %in% player_ids_to_filter)
     } else if (entity == "teams" & (exists("team_ids_to_filter") && !is.null(team_ids_to_filter))) {
-        stats <- stats %>% dplyr::filter(rlang::.data$team_id %in% team_ids_to_filter)
+        stats <- stats %>% dplyr::filter(.data$team_id %in% team_ids_to_filter)
     } else if (entity == "games" & (exists("game_ids_to_filter") && !is.null(game_ids_to_filter))) {
-        stats <- stats %>% dplyr::filter(rlang::.data$game_id %in% game_ids_to_filter)
+        stats <- stats %>% dplyr::filter(.data$game_id %in% game_ids_to_filter)
     }
 
     return(stats)

R-package/R/utils.R

@@ -3,16 +3,16 @@
     return(value)
 }
 
-.check_leagues <- function(leagues, league_options) {
+.check_leagues <- function(self, leagues) {
     if (!missing(leagues)) {
-        if (any(!leagues %in% league_options)) {
-            stop(glue::glue("Leagues are limited only to the following options: {paste0(league_options, collapse = ', ')}."))
+        if (any(!leagues %in% self$LEAGUES)) {
+            stop(glue::glue("Leagues are limited only to the following options: {paste0(self$LEAGUES, collapse = ', ')}."))
         }
     }
 }
 
 .check_ids_names <- function(ids, names) {
-    if ((!missing(ids) & !missing(names)) && !is.null(ids) & !is.null(names)) {
+    if ((!missing(ids) & !missing(names)) && (!is.null(ids) & !is.null(names))) {
         stop("Please specify only IDs or names, not both.")
     }
 
@@ -49,14 +49,14 @@
     return(names)
 }
 
-.single_request <- function(url, query) {
+.single_request <- function(self, url, query) {
     for (arg_name in names(query)) {
         if (length(query[[arg_name]]) > 1) {
             query[[arg_name]] <- .collapse_query_string(query[[arg_name]])
         }
     }
 
-    r <- httpcache::GET(url = url, query = query)
+    r <- httpcache::GET(url = url, query = query, self$httr_configs)
     httr::stop_for_status(r)
     response <- r %>%
         httr::content(as = "text", encoding = "UTF-8") %>%
@@ -66,15 +66,15 @@
 }
 
 .execute_query <- function(self, url, query = list()) {
-    tmp_response <- .single_request(url, query)
+    tmp_response <- .single_request(self, url, query)
     response <- tmp_response
 
     if (is.data.frame(tmp_response)) {
         offset <- self$MAX_API_LIMIT
 
         while (nrow(tmp_response) == self$MAX_API_LIMIT) {
             query$offset <- offset
-            tmp_response <- .single_request(url, query)
+            tmp_response <- .single_request(self, url, query)
 
             response <- response %>% dplyr::bind_rows(tmp_response)
             offset <- offset + self$MAX_API_LIMIT

R-package/README.md

@@ -1 +1,58 @@
-# R package
+# itscalledsoccer
+
+Description TK.
+
+## Installation
+
+```r
+# Install release version from CRAN
+install.packages("itscalledsoccer")
+
+# Install development version from GitHub
+devtools::install_github("American-Soccer-Analysis/itscalledsoccer")
+```
+
+## Getting Started
+
+Initialize the main class with the `new` method.
+
+```r
+asa_client <- AmericanSoccerAnalysis$new()
+```
+
+If you're in an environment where a proxy server is required, or if you need to need to alter any other `CURL` options, you can pass any number of `httr` configs when initializing the class. Use these at your own discretion.
+
+```r
+asa_client <- AmericanSoccerAnalysis$new(
+    httr::config(ssl_verifypeer = 0L),
+    httr::use_proxy("64.251.21.73", 8080)
+)
+```
+
+## Usage
+
+Any of the `get_*` methods can be used to retrieve the same data made available in the [American Soccer Analysis app](https://app.americansocceranalysis.com/). Partial matches or abbreviations are accepted for any player or team names. For most methods, arguments _must be named_. A few examples are below.
+
+```r
+# Get all players named "Dax"
+asa_players <- asa_client$get_players(names = "Dax")
+
+# Get season-by-season xG data for all players named "Dax"
+asa_xgoals <- asa_client$get_player_xgoals(
+    leagues = "mls",
+    player_names = "Dax",
+    split_by_seasons = TRUE
+)
+
+# Get cumulative xPass data for all USL League One teams
+asa_xpass <- asa_client$get_team_xpass(
+    leagues = "usl1"
+)
+
+# Get game-by-game goals added (g+) data for all goalkeepers named "Matt Turner"
+asa_goals_added <- asa_client$get_goalkeeper_goals_added(
+    leagues = c("mls", "uslc"),
+    player_names = "Matt Turner",
+    split_by_game = TRUE
+)
+```