-
Notifications
You must be signed in to change notification settings - Fork 1
/
result.R
68 lines (56 loc) · 1.86 KB
/
result.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#' Structure for printing results
#'
#' For `teams_matches` tibbles, it can be convenient to see the result as a
#' structure, rather than using only `goals_for` and `goals_against`.
#'
#' This function is vectorized over `goals_for` and `goals_against`; they must
#' have the same length.
#'
#' @param goals_for `integer`-ish number of goals for a team in a match.
#' @param goals_against `integer`-ish number of goals against a team in a match.
#'
#' @return An S3 object with class `ussie_result`.
#' @examples
#' uss_result(3, 2)
#' uss_get_matches("italy") |>
#' uss_make_teams_matches() |>
#' dplyr::mutate(
#' result = uss_result(goals_for, goals_against),
#' .after = opponent
#' )
#' @export
#'
uss_result <- function(goals_for = integer(), goals_against = integer()) {
# high-level constructor
# coerce to integer
goals_for <- vec_cast(goals_for, to = integer())
goals_against <- vec_cast(goals_against, to = integer())
new_result(goals_for, goals_against)
}
new_result <- function(goals_for = integer(), goals_against = integer()) {
# low-level constructor
# validate
vec_assert(goals_for, integer())
vec_assert(goals_against, integer(), size = length(goals_for))
# construct
new_rcrd(
list(goals_for = goals_for, goals_against = goals_against),
class = "ussie_result"
)
}
#' @export
format.ussie_result <- function(x, ...) {
goals_for <- field(x, "goals_for")
goals_against <- field(x, "goals_against")
result <- dplyr::case_when(
goals_for > goals_against ~ "W",
goals_for == goals_against ~ "D",
goals_for < goals_against ~ "L",
TRUE ~ NA_character_
)
out <- glue::glue("{result} {goals_for}-{goals_against}")
out[is.na(goals_for) | is.na(goals_against)] <- NA_character_
as.character(out)
}
vec_ptype_abbr.ussie_result <- function(x, ...) "rslt"
vec_ptype_full.ussie_result <- function(x, ...) "result"