-
Notifications
You must be signed in to change notification settings - Fork 0
/
theme-elements.R
167 lines (151 loc) · 5.35 KB
/
theme-elements.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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
#' Theme Elements for Image Grobs
#'
#' @description
#' In conjunction with the [ggplot2::theme] system, the following `element_`
#' functions enable images in non-data components of the plot, e.g. axis text.
#'
#' - `element_nba_logo()`: draws NBA team logos instead of their abbreviations.
#' - `element_wnba_logo()`: draws WNBA team logos instead of their abbreviations.
#'
#' @details The elements translate NBA/WNBA team abbreviations into logo images.
#' @inheritParams ggpath::element_path
#'
#' @seealso [geom_nba_logos()], [geom_wnba_logos()], and [ggpath::element_path()]
#' for more information on valid team abbreviations, and other parameters.
#' @return An S3 object of class `element`.
#' @examples
#' \donttest{
#' library(nbaplotR)
#' library(ggplot2)
#'
#' ######## NBA Examples ########
#'
#' team_abbr <- valid_team_names("NBA")
#'
#' df <- data.frame(
#' random_value = runif(length(team_abbr), 0, 1),
#' team = team_abbr
#' )
#'
#' # use logos for x-axis
#' ggplot(df, aes(x = team, y = random_value)) +
#' geom_col(aes(color = team, fill = team), width = 0.5) +
#' scale_color_nba(type = "secondary") +
#' scale_fill_nba(alpha = 0.4) +
#' theme_minimal() +
#' theme(axis.text.x = element_nba_logo())
#'
#' # use logos for y-axis
#' ggplot(df, aes(y = team, x = random_value)) +
#' geom_col(aes(color = team, fill = team), width = 0.5) +
#' scale_color_nba(type = "secondary") +
#' scale_fill_nba(alpha = 0.4) +
#' theme_minimal() +
#' theme(axis.text.y = element_nba_logo())
#'
#' ######## WNBA Examples ########
#'
#' team_abbr <- valid_team_names("WNBA")
#'
#' df <- data.frame(
#' random_value = runif(length(team_abbr), 0, 1),
#' team = team_abbr
#' )
#'
#' # use logos for x-axis
#' ggplot(df, aes(x = team, y = random_value)) +
#' geom_col(aes(color = team, fill = team), width = 0.5) +
#' scale_color_wnba(type = "secondary") +
#' scale_fill_wnba(alpha = 0.4) +
#' theme_minimal() +
#' theme(axis.text.x = element_wnba_logo())
#'
#' # use logos for y-axis
#' ggplot(df, aes(y = team, x = random_value)) +
#' geom_col(aes(color = team, fill = team), width = 0.5) +
#' scale_color_wnba(type = "secondary") +
#' scale_fill_wnba(alpha = 0.4) +
#' theme_minimal() +
#' theme(axis.text.y = element_wnba_logo())
#' }
#' @name element
#' @aliases NULL
NULL
# Elements ----------------------------------------------------------------
#' @export
#' @rdname element
element_nba_logo <- function(alpha = NULL, colour = NA, hjust = NULL, vjust = NULL,
color = NULL, size = 0.5) {
if (!is.null(color)) colour <- color
structure(
list(alpha = alpha, colour = colour, hjust = hjust, vjust = vjust, size = size),
class = c("element_nba_logo", "element_text", "element")
)
}
#' @export
#' @rdname element
element_wnba_logo <- function(alpha = NULL, colour = NA, hjust = NULL, vjust = NULL,
color = NULL, size = 0.5) {
if (!is.null(color)) colour <- color
structure(
list(alpha = alpha, colour = colour, hjust = hjust, vjust = vjust, size = size),
class = c("element_wnba_logo", "element_text", "element")
)
}
# Methods -----------------------------------------------------------------
# This S3 method is just a wrapper of the ggpath theme element method.
# It translates the labels (which are team abbreviations) to local paths
# and passes those paths to ggpath
#' @export
element_grob.element_nba_logo <- function(element, label = "", x = NULL, y = NULL,
alpha = NULL, colour = NULL,
hjust = 0.5, vjust = 0.5,
size = NULL, ...) {
if (is.null(label)) return(ggplot2::zeroGrob())
# Standardize team abbreviations and translate them to local paths
team_abbr <- clean_team_abbrs(label, league = "NBA", keep_non_matches = FALSE)
label <- logo_from_abbr(team_abbr, league = "NBA")
# We want ggpath to do the actual work, so we change the class here to make
# ggplot2 call the S3 method of ggpath
class(element) <- c("element_path", "element_text", "element")
ggplot2::element_grob(
element = element,
label = label,
x = x,
y = y,
alpha = alpha,
colour = colour,
hjust = hjust,
vjust = vjust,
size = size,
...
)
}
# This S3 method is just a wrapper of the ggpath theme element method.
# It translates the labels (which are team abbreviations) to local paths
# and passes those paths to ggpath
#' @export
element_grob.element_wnba_logo <- function(element, label = "", x = NULL, y = NULL,
alpha = NULL, colour = NULL,
hjust = 0.5, vjust = 0.5,
size = NULL, ...) {
if (is.null(label)) return(ggplot2::zeroGrob())
# Standardize team abbreviations and translate them to local paths
team_abbr <- clean_team_abbrs(label, league = "WNBA", keep_non_matches = FALSE)
label <- logo_from_abbr(team_abbr, league = "WNBA")
# We want ggpath to do the actual work, so we change the class here to make
# ggplot2 call the S3 method of ggpath
class(element) <- c("element_path", "element_text", "element")
ggplot2::element_grob(
element = element,
label = label,
x = x,
y = y,
alpha = alpha,
colour = colour,
hjust = hjust,
vjust = vjust,
size = size,
...
)
}