Skip to content

Commit be02cd8

Browse files
tyler-richardetttyler-richardett
authored
Merge pull request vuejs#3 from American-Soccer-Analysis/r-backbone
Create core functionality of R package
2 parents a06be18 + 0434baa commit be02cd8

28 files changed

+900
-154
lines changed

‎.github/workflows/R-check-release.yml

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag.
2+
# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
3+
name: R-CMD-check
4+
on: [push]
5+
6+
jobs:
7+
R-CMD-check:
8+
runs-on: macOS-latest
9+
steps:
10+
- name: Check out repository code
11+
uses: actions/checkout@v2
12+
13+
- name: Install R
14+
uses: r-lib/actions/setup-r@v1
15+
16+
- name: Install dependencies
17+
run: |
18+
install.packages(c("remotes", "rcmdcheck"))
19+
remotes::install_deps(pkgdir = "./R-package", dependencies = TRUE)
20+
shell: Rscript {0}
21+
22+
- name: Check
23+
run: |
24+
options(crayon.enabled = TRUE)
25+
rcmdcheck::rcmdcheck(path = "./R-package", args = "--no-manual", error_on = "error")
26+
shell: Rscript {0}

‎.github/workflows/r-tests.yml

Lines changed: 0 additions & 11 deletions
This file was deleted.

‎r-package/.Rbuildignore renamed to ‎R-package/.Rbuildignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,4 @@
22
^renv\.lock$
33
^.*\.Rproj$
44
^\.Rproj\.user$
5+
^\.github$

‎r-package/.Rprofile renamed to ‎R-package/.Rprofile

File renamed without changes.

‎R-package/DESCRIPTION

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
Package: itscalledsoccer
2+
Title: What the Package Does (Title Case)
3+
Version: 0.0.0.9000
4+
Author: The package author <[email protected]>
5+
Maintainer: The package maintainer <[email protected]>
6+
Description: More about what it does (maybe more than one line)
7+
Use four spaces when indenting paragraphs within the Description.
8+
License: What license is it under?
9+
Encoding: UTF-8
10+
LazyData: true
11+
Roxygen: list(markdown = TRUE)
12+
RoxygenNote: 7.1.1
13+
Depends:
14+
R (>= 3.2.0)
15+
Imports:
16+
dplyr (>= 1.0.0),
17+
httpcache (>= 1.2.0),
18+
glue (>= 1.4.1),
19+
httr (>= 1.4.2),
20+
jsonlite (>= 1.7.0),
21+
magrittr (>= 2.0.0),
22+
R6 (>= 2.5.0),
23+
tidyr (>= 1.1.1),
24+
stringi (>= 1.5.3)
25+
Suggests:
26+
testthat (>= 3.0.0)
27+
Config/testthat/edition: 3

‎R-package/NAMESPACE

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Generated by roxygen2: do not edit by hand
2+
3+
export("%>%")
4+
export(AmericanSoccerAnalysis)
5+
importFrom(magrittr,"%>%")

‎R-package/R/client.R

Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
#' Class representing an active session connected to the American Soccer Analysis public API.
2+
#'
3+
#' Does not take any arguments to initialize.
4+
#' @export
5+
AmericanSoccerAnalysis <- R6::R6Class("AmericanSoccerAnalysis",
6+
public = list(
7+
#' @field API_VERSION Latest API version.
8+
API_VERSION = "v1",
9+
10+
#' @field LEAGUES List of stylized league names.
11+
LEAGUES = c("nwsl", "mls", "uslc", "usl1", "nasl"),
12+
13+
#' @field BASE_URL API base URL.
14+
BASE_URL = NULL,
15+
16+
#' @field players Data frame containing players from all leagues.
17+
players = NULL,
18+
19+
#' @field teams Data frame containing teams from all leagues.
20+
teams = NULL,
21+
22+
#' @field stadia Data frame containing stadia from all leagues.
23+
stadia = NULL,
24+
25+
#' @field managers Data frame containing managers from all leagues.
26+
managers = NULL,
27+
28+
#' @field referees Data frame containing referees from all leagues.
29+
referees = NULL,
30+
31+
#' @description
32+
#' Creates a new `AmericanSoccerAnalysis` object.
33+
#' @return A new `AmericanSoccerAnalysis` object.
34+
initialize = function() {
35+
self$BASE_URL <- glue::glue("https://app.americansocceranalysis.com/api/{self$API_VERSION}/")
36+
self$players <- get_entity("player", self)
37+
self$teams <- get_entity("team", self)
38+
self$stadia <- get_entity("stadium", self)
39+
self$managers <- get_entity("manager", self)
40+
self$referees <- get_entity("referee", self)
41+
},
42+
43+
#' @description
44+
#' Retrieves a data frame containing player names, IDs, and other metadata.
45+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
46+
#' @param ids Player IDs on which to filter. Accepts a character vector of length >= 1.
47+
#' @param names Player names on which to filter. Partial matches are accepted. Accepts a character vector of length >= 1.
48+
get_players = function(leagues, ids, names) {
49+
players <- filter_entity(self$players, self$LEAGUES, leagues, ids, names)
50+
return(players)
51+
},
52+
53+
#' @description
54+
#' Retrieves a data frame containing team names, abbreviations, and IDs.
55+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
56+
#' @param ids Team IDs on which to filter. Accepts a character vector of length >= 1.
57+
#' @param names Team names on which to filter. Partial matches and abbreviations are accepted. Accepts a character vector of length >= 1.
58+
get_teams = function(leagues, ids, names) {
59+
teams <- filter_entity(self$teams, self$LEAGUES, leagues, ids, names)
60+
return(teams)
61+
},
62+
63+
#' @description
64+
#' Retrieves a data frame containing stadium names, IDs, and other metadata.
65+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
66+
#' @param ids Stadium IDs on which to filter. Accepts a character vector of length >= 1.
67+
#' @param names Stadium names on which to filter. Partial matches are accepted. Accepts a character vector of length >= 1.
68+
get_stadia = function(leagues, ids, names) {
69+
stadia <- filter_entity(self$stadia, self$LEAGUES, leagues, ids, names)
70+
return(stadia)
71+
},
72+
73+
#' @description
74+
#' Retrieves a data frame containing manager names and IDs.
75+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
76+
#' @param ids Manager IDs on which to filter. Accepts a character vector of length >= 1.
77+
#' @param names Manager names on which to filter. Partial matches are accepted. Accepts a character vector of length >= 1.
78+
get_managers = function(leagues, ids, names) {
79+
managers <- filter_entity(self$managers, self$LEAGUES, leagues, ids, names)
80+
return(managers)
81+
},
82+
83+
#' @description
84+
#' Retrieves a data frame containing referee names and IDs.
85+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
86+
#' @param ids Referee IDs on which to filter. Accepts a character vector of length >= 1.
87+
#' @param names Referee names on which to filter. Partial matches are accepted. Accepts a character vector of length >= 1.
88+
get_referees = function(leagues, ids, names) {
89+
referees <- filter_entity(self$referees, self$LEAGUES, leagues, ids, names)
90+
return(referees)
91+
},
92+
93+
#' @description
94+
#' Retrieves a data frame containing game IDs, dates, opponents, scores, and other metadata.
95+
#' @param leagues Leagues on which to filter. Accepts a character vector of length >= 1.
96+
#' @param game_ids Game IDs on which to filter. Accepts a character vector of length >= 1.
97+
#' @param team_ids Team IDs on which to filter. Accepts a character vector of length >= 1.
98+
#' @param team_names Team names on which to filter. Partial matches and abbreviations are accepted. Accepts a character vector of length >= 1.
99+
#' @param seasons Seasons on which to filter. Accepts a character or integer vector of length >= 1.
100+
#' @param stages Stages (e.g., regular season, playoffs, etc.) on which to filter. See the \url{https://app.americansocceranalysis.com/api/v1/__swagger__/}{API documentation} for possible values. Accepts a character vector of length >= 1.
101+
get_games = function(leagues, game_ids, team_ids, team_names, seasons, stages) {
102+
games <- get_games(self, leagues, game_ids, team_ids, team_names, seasons, stages)
103+
return(games)
104+
}
105+
)
106+
)

‎R-package/R/entities.R

Lines changed: 140 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,140 @@
1+
get_entity <- function(type, self) {
2+
entity_all <- data.frame()
3+
4+
for (league in self$LEAGUES) {
5+
if (type == "stadium") {
6+
url <- glue::glue("{self$BASE_URL}{league}/stadia")
7+
} else {
8+
url <- glue::glue("{self$BASE_URL}{league}/{type}s")
9+
}
10+
11+
response <- .execute_query(url)
12+
response <- response %>% dplyr::mutate(competition = league)
13+
14+
entity_all <- entity_all %>% dplyr::bind_rows(response)
15+
}
16+
17+
entity_all <- entity_all %>%
18+
dplyr::group_by(dplyr::across(c(-dplyr::matches("competition"), -dplyr::starts_with("season"), -dplyr::ends_with("position")))) %>%
19+
dplyr::summarize(competitions = list(competition)) %>%
20+
dplyr::ungroup() %>%
21+
dplyr::arrange(!!as.symbol(glue::glue("{type}_name")))
22+
23+
return(entity_all)
24+
}
25+
26+
filter_entity <- function(entity_all, league_options, leagues, ids, names) {
27+
.check_leagues(leagues, league_options)
28+
.check_ids_names(ids, names)
29+
30+
entity_filtered <- entity_all %>%
31+
tidyr::unnest(competitions)
32+
33+
if (!missing(leagues)) {
34+
entity_filtered <- entity_filtered %>%
35+
dplyr::filter(competitions %in% leagues)
36+
}
37+
38+
if (!missing(names)) {
39+
ids <- .convert_names_to_ids(entity_filtered, names)
40+
}
41+
42+
if (!missing(names) | !missing(ids)) {
43+
entity_filtered <- entity_filtered %>%
44+
dplyr::filter(dplyr::if_any(dplyr::ends_with("_id"), ~ . %in% ids))
45+
}
46+
47+
entity_filtered <- entity_filtered %>%
48+
dplyr::select(-competitions) %>%
49+
dplyr::distinct()
50+
51+
return(entity_filtered)
52+
}
53+
54+
get_games <- function(self, leagues, game_ids, team_ids, team_names, seasons, stages) {
55+
.check_leagues(leagues, self$LEAGUES)
56+
.check_ids_names(team_ids, team_names)
57+
58+
if (missing(leagues)) leagues <- self$LEAGUES
59+
60+
query <- list()
61+
if (!missing(game_ids)) query$game_id <- .collapse_query_string(game_ids)
62+
if (!missing(team_ids)) query$team_id <- .collapse_query_string(team_ids)
63+
if (!missing(team_names)) query$team_id <- .collapse_query_string(.convert_names_to_ids(self$teams, team_names))
64+
if (!missing(seasons)) query$season_name <- .collapse_query_string(seasons)
65+
if (!missing(stages)) query$stage_name <- .collapse_query_string(stages)
66+
67+
games <- data.frame()
68+
69+
for (league in leagues) {
70+
url <- glue::glue("{self$BASE_URL}{league}/games")
71+
72+
response <- .execute_query(url, query)
73+
74+
games <- games %>%
75+
dplyr::bind_rows(response) %>%
76+
dplyr::arrange(date_time_utc)
77+
}
78+
79+
return(games)
80+
}
81+
82+
.collapse_query_string <- function(value) {
83+
value <- paste0(value, collapse = ",")
84+
return(value)
85+
}
86+
87+
.check_leagues <- function(leagues, league_options) {
88+
if (!missing(leagues)) {
89+
if (any(!leagues %in% league_options)) {
90+
stop(glue::glue("Leagues are limited only to the following options: {paste0(league_options, collapse = ', ')}."))
91+
}
92+
}
93+
}
94+
95+
.check_ids_names <- function(ids, names) {
96+
if (!missing(ids) & !missing(names)) {
97+
stop("Please specify only IDs or names, not both.")
98+
}
99+
100+
if (!missing(ids)) {
101+
if (class(ids) != "character" | length(ids) < 1) {
102+
stop("IDs must be passed as a vector of characters with length >= 1.")
103+
}
104+
}
105+
106+
if (!missing(names)) {
107+
if (class(names) != "character" | length(names) < 1) {
108+
stop("Names must be passed as a vector of characters with length >= 1.")
109+
}
110+
}
111+
}
112+
113+
.convert_names_to_ids <- function(df, names) {
114+
names_clean <- .clean_names(names)
115+
names_string <- paste0(names_clean, collapse = "|")
116+
117+
ids <- df %>%
118+
dplyr::mutate(dplyr::across(dplyr::matches("(_name|_abbreviation)$"), .fns = list(clean = ~.clean_names(.)))) %>%
119+
dplyr::filter(dplyr::if_any(dplyr::ends_with("_clean"), ~grepl(names_string, .))) %>%
120+
dplyr::select(!dplyr::ends_with("_clean")) %>%
121+
dplyr::pull(names(.)[which(grepl("_id$", names(.)))])
122+
123+
return(ids)
124+
}
125+
126+
.clean_names <- function(names) {
127+
names <- stringi::stri_trans_general(str = names, id = "Latin-ASCII")
128+
names <- tolower(names)
129+
return(names)
130+
}
131+
132+
.execute_query <- function(url, query = list()) {
133+
r <- httpcache::GET(url, query = query)
134+
httr::stop_for_status(r)
135+
response <- r %>%
136+
httr::content(as = "text", encoding = "UTF-8") %>%
137+
jsonlite::fromJSON()
138+
139+
return(response)
140+
}

‎R-package/R/utils.R

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
#' Pipe operator
2+
#'
3+
#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
4+
#'
5+
#' @name %>%
6+
#' @rdname pipe
7+
#' @keywords internal
8+
#' @export
9+
#' @importFrom magrittr %>%
10+
#' @usage lhs \%>\% rhs
11+
#' @param lhs A value or the magrittr placeholder.
12+
#' @param rhs A function call using the magrittr semantics.
13+
#' @return The result of calling `rhs(lhs)`.
14+
NULL

‎r-package/README.md renamed to ‎R-package/README.md

File renamed without changes.

‎r-package/itscalledsoccer.Rproj renamed to ‎R-package/itscalledsoccer.Rproj

File renamed without changes.

0 commit comments

Comments
 (0)