Movatterモバイル変換


[0]ホーム

URL:


Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

Sign up
Appearance settings

Commitb3bbae2

Browse files
Add fetch_awards functions, tests, and NEWS entry
1 parent0cd00e8 commitb3bbae2

File tree

3 files changed

+273
-0
lines changed

3 files changed

+273
-0
lines changed

‎NEWS.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,11 @@
22

33
##Improvements
44

5+
* Added`fetch_awards()` function with support for three AFL awards:
6+
-`brownlow` (player and team vote tallies from Footywire)
7+
-`allaustralian` (final team and full squad)
8+
-`risingstar` (nominations and round-level stats)
9+
510
* Added a new wrapper function`fetch_team_stats()` for retrieving team-level statistics from multiple sources.
611
* Improved code clarity and consistency with better error handling (`cli`), safer scoping (`.data$`), and modern`dplyr` syntax.
712
* Enhanced compatibility with other functions by ensuring consistent team naming and structure in outputs.

‎R/fetch_awards.R‎

Lines changed: 214 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,214 @@
1+
#' Fetch AFL Awards Data
2+
#'
3+
#' General wrapper to fetch Brownlow, All-Australian, or Rising Star awards from Footywire.
4+
#'
5+
#' @param award Character. One of `"brownlow"`, `"allaustralian"`, or `"risingstar"`.
6+
#' @param ... Additional arguments passed to the specific award fetcher.
7+
#'
8+
#' @return A data frame containing the requested award data.
9+
#' @export
10+
#'
11+
#' @examples
12+
#' fetch_awards(2024, award = "brownlow", type = "player")
13+
#' fetch_awards(2023, award = "allaustralian", type = "team")
14+
#' fetch_awards(2024, award = "risingstar", type = "nominations")
15+
fetch_awards<-function(...,award= c("brownlow","allaustralian","risingstar")) {
16+
award<- match.arg(award)
17+
18+
switch(
19+
award,
20+
"brownlow"= fetch_awards_brownlow(...),
21+
"allaustralian"= fetch_awards_allaustralian(...),
22+
"risingstar"= fetch_rising_star(...)
23+
)
24+
}
25+
26+
#' Fetch Brownlow Medal Votes from Footywire
27+
#'
28+
#' @param season Integer. The AFL season (e.g. 2024).
29+
#' @param type Character. Either "player" (default) or "team".
30+
#'
31+
#' @return A tibble with Brownlow Medal vote data.
32+
#' @export
33+
fetch_awards_brownlow<-function(season,type= c("player","team")) {
34+
type<- match.arg(type)
35+
stopifnot(is.numeric(season), length(season)==1)
36+
37+
url<-if (type=="player") {
38+
glue::glue("https://www.footywire.com/afl/footy/brownlow_medal?year={season}")
39+
}else {
40+
glue::glue("https://www.footywire.com/afl/footy/team_brownlow_medal_summaries?year={season}")
41+
}
42+
43+
page<-rvest::read_html(url)
44+
all_tables<-rvest::html_elements(page,"table")
45+
parsed_tables<-rvest::html_table(all_tables,fill=TRUE)
46+
47+
matched_table<-purrr::detect(parsed_tables,function(tbl) {
48+
ncol(tbl)== ifelse(type=="player",9,7)
49+
})
50+
51+
if (is.null(matched_table)) {
52+
cli::cli_abort("Could not find a valid Brownlow table for {season} ({type}).")
53+
}
54+
55+
df<-dplyr::as_tibble(matched_table)
56+
57+
if (type=="player") {
58+
if (tolower(df$Player[1])=="player"|| all(is.na(df[1,-1])))df<-df[-1, ]
59+
60+
df<-df|>
61+
dplyr::rename(
62+
Player=1,Team=2,Votes=3,Votes_3=4,Votes_2=5,Votes_1=6,
63+
Games_Played=7,Games_Polled=8,Votes_Per_Game=9
64+
)|>
65+
dplyr::mutate(
66+
dplyr::across(dplyr::all_of(c("Votes","Votes_3","Votes_2","Votes_1","Games_Played","Games_Polled")),as.integer),
67+
.data$Votes_Per_Game:= as.numeric(.data$Votes_Per_Game),
68+
Season=season,
69+
.before=1
70+
)
71+
}else {
72+
if (tolower(df$Team[1])=="team"|| all(is.na(df[1,-1])))df<-df[-1, ]
73+
74+
df<-df|>
75+
dplyr::rename(
76+
Team=1,Votes=2,Votes_3=3,Votes_2=4,Votes_1=5,
77+
Players_With_Votes=6,Games_Polled=7
78+
)|>
79+
dplyr::mutate(
80+
dplyr::across(dplyr::all_of(c("Votes","Votes_3","Votes_2","Votes_1","Players_With_Votes","Games_Polled")),as.integer),
81+
Season=season,
82+
.before=1
83+
)
84+
}
85+
86+
return(df)
87+
}
88+
89+
#' Fetch AFL All-Australian Team or Squad
90+
#'
91+
#' @param season Integer. The AFL season (e.g. 2023).
92+
#' @param type Character. Either "team" (final 22) or "squad" (initial 44).
93+
#'
94+
#' @return A tibble with player and team details.
95+
#' @export
96+
fetch_awards_allaustralian<-function(season,type= c("team","squad")) {
97+
type<- match.arg(type)
98+
stopifnot(is.numeric(season), length(season)==1)
99+
100+
url<-glue::glue("https://www.footywire.com/afl/footy/all_australian_selection?year={season}")
101+
page<-rvest::read_html(url)
102+
rows<-rvest::html_elements(page,"tr")
103+
104+
if (type=="team") {
105+
# Rows 46–53 contain All-Australian final 22 team rows
106+
team_rows<-rows[46:53]
107+
108+
purrr::map_dfr(team_rows,function(row) {
109+
tds<-rvest::html_elements(row,"td")
110+
position<-tds[1]|>rvest::html_text2()|>stringr::str_squish()
111+
player_cells<-tds[-1]
112+
113+
purrr::map_dfr(player_cells,function(cell) {
114+
player<-cell|>rvest::html_element("a")|>rvest::html_text2()
115+
team<-cell|>rvest::html_element("span.playerflag")|>rvest::html_text2()
116+
117+
if (!is.na(player)&&player!="") {
118+
tibble::tibble(Season=season,Position=position,Player=player,Team=team)
119+
}else {
120+
NULL
121+
}
122+
})
123+
})
124+
}else {
125+
# Rows 60–72 contain All-Australian initial squad rows
126+
squad_rows<-rows[60:72]
127+
128+
purrr::map_dfr(squad_rows,function(row) {
129+
tds<-rvest::html_elements(row,"td")
130+
if (length(tds)<2)return(NULL)
131+
132+
team<-tds[1]|>rvest::html_element("a")|>rvest::html_text2()|>stringr::str_squish()
133+
players<-tds[2]|>rvest::html_elements("a")|>rvest::html_text2()
134+
135+
if (length(players)==0)return(NULL)
136+
137+
tibble::tibble(Season=season,Team=team,Player=players)
138+
})
139+
}
140+
}
141+
142+
#' Fetch AFL Rising Star Nominations or Stats
143+
#'
144+
#' @param season Integer. The year of interest (e.g. 2024).
145+
#' @param round_number Integer. Optional. If NULL and type = "stats", scrapes all rounds.
146+
#' @param type Character. Either "nominations" (default) or "stats".
147+
#'
148+
#' @return A tibble with Rising Star data.
149+
#' @export
150+
fetch_rising_star<-function(season,round_number=NULL,type= c("nominations","stats")) {
151+
type<- match.arg(type)
152+
153+
get_stats_table<-function(season,round_number) {
154+
url<-glue::glue("https://www.footywire.com/afl/footy/ft_rising_stars_round_performances?year={season}&round={round_number}&sby=2")
155+
page<-rvest::read_html(url)
156+
tables<-rvest::html_elements(page,"table")
157+
parsed<-purrr::map(tables,rvest::html_table,fill=TRUE)
158+
159+
if (length(parsed)<11) {
160+
cli::cli_inform("No stats table found for round {round_number}")
161+
return(tibble::tibble())
162+
}
163+
164+
tbl<-parsed[[11]]
165+
colnames(tbl)<- c("Player","Nomination","Team","Opponent","Result",
166+
"Kicks","Handballs","Disposals","Marks","Goals","Behinds","Tackles",
167+
"Hitouts","Goal_Assists","Inside_50s","Clearances","Clangers",
168+
"Rebound_50s","Frees_For","Frees_Against","Fantasy","Supercoach")
169+
170+
numeric_cols<- setdiff(names(tbl), c("Player","Nomination","Team","Opponent","Result"))
171+
172+
tbl|>
173+
dplyr::filter(.data$Player!="Name")|>
174+
dplyr::mutate(
175+
dplyr::across(dplyr::all_of(numeric_cols),~ suppressWarnings(as.numeric(.))),
176+
Season=season,
177+
Round=round_number
178+
)|>
179+
dplyr::relocate(Season,Round)
180+
}
181+
182+
if (type=="nominations") {
183+
url<-glue::glue("https://www.footywire.com/afl/footy/rising_star_nominations?year={season}")
184+
page<-rvest::read_html(url)
185+
tables<-rvest::html_elements(page,"table")
186+
parsed<-purrr::map(tables,rvest::html_table,fill=TRUE)
187+
188+
if (length(parsed)<11) {
189+
cli::cli_abort("Could not find nomination table for {season}")
190+
}
191+
192+
tbl<-parsed[[11]]
193+
colnames(tbl)<- c("Round","Player","Team","Opponent","Kicks","Handballs","Disposals","Marks",
194+
"Goals","Behinds","Tackles","Hitouts","Goal_Assists","Inside_50s",
195+
"Clearances","Clangers","Rebound_50s","Frees_For","Frees_Against",
196+
"Supercoach","Fantasy")
197+
198+
numeric_cols<- setdiff(names(tbl), c("Round","Player","Team","Opponent"))
199+
200+
tbl|>
201+
dplyr::filter(.data$Round!="Rd")|>
202+
dplyr::mutate(
203+
dplyr::across(dplyr::all_of(numeric_cols),~ suppressWarnings(as.numeric(.))),
204+
Season=season
205+
)|>
206+
dplyr::relocate(Season,Round)
207+
}else {
208+
if (is.null(round_number)) {
209+
purrr::map_dfr(0:30,~ tryCatch(get_stats_table(season,.x),error=function(e)tibble::tibble()))
210+
}else {
211+
get_stats_table(season,round_number)
212+
}
213+
}
214+
}

‎tests/testthat/test-fetch-awards.R‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
test_that("fetch_awards - Brownlow player-level works", {
2+
result<- fetch_awards(season=2023,award="brownlow",type="player")
3+
4+
expect_s3_class(result,"tbl_df")
5+
expect_true("Player"%in% names(result))
6+
expect_true("Votes"%in% names(result))
7+
expect_true("Season"%in% names(result))
8+
expect_true(all(result$Season==2023))
9+
})
10+
11+
test_that("fetch_awards - Brownlow team-level works", {
12+
result<- fetch_awards(season=2023,award="brownlow",type="team")
13+
14+
expect_s3_class(result,"tbl_df")
15+
expect_true("Team"%in% names(result))
16+
expect_true("Votes_3"%in% names(result))
17+
expect_true("Season"%in% names(result))
18+
expect_true(all(result$Season==2023))
19+
})
20+
21+
test_that("fetch_awards - All-Australian team works", {
22+
result<- fetch_awards(season=2023,award="allaustralian",type="team")
23+
24+
expect_s3_class(result,"tbl_df")
25+
expect_true("Player"%in% names(result))
26+
expect_true("Team"%in% names(result))
27+
expect_true("Position"%in% names(result))
28+
})
29+
30+
test_that("fetch_awards - All-Australian squad works", {
31+
result<- fetch_awards(season=2023,award="allaustralian",type="squad")
32+
33+
expect_s3_class(result,"tbl_df")
34+
expect_true("Player"%in% names(result))
35+
expect_true("Team"%in% names(result))
36+
})
37+
38+
test_that("fetch_awards - Rising Star nominations works", {
39+
result<- fetch_awards(season=2023,award="risingstar",type="nominations")
40+
41+
expect_s3_class(result,"tbl_df")
42+
expect_true("Player"%in% names(result))
43+
expect_true("Team"%in% names(result))
44+
expect_true("Season"%in% names(result))
45+
})
46+
47+
test_that("fetch_awards - Rising Star round stats works for one round", {
48+
result<- fetch_awards(season=2023,award="risingstar",type="stats",round_number=15)
49+
50+
expect_s3_class(result,"tbl_df")
51+
expect_true("Player"%in% names(result))
52+
expect_true("Round"%in% names(result))
53+
expect_true("Season"%in% names(result))
54+
})

0 commit comments

Comments
 (0)

[8]ページ先頭

©2009-2025 Movatter.jp