generated from r4ds/bookclub-template
-
Notifications
You must be signed in to change notification settings - Fork 25
/
13_S3.Rmd
417 lines (289 loc) · 9.46 KB
/
13_S3.Rmd
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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
# S3
## Introcudion
## Basics
- Has class
- Uses a generic function to decide on method
- method = implementation for a specific class
- dispatch = process of searching for right method
## Classes
**Theory:**
What is class?
- No formal definition in S3
- Simply set class attribute
How to set class?
- At time of object creation
- After object creation
```{r}
# at time of object creation
x <- structure(list(), class = "my_class")
# after object creation
x <- list()
class(x) <- "my_class"
```
Some advice on style:
- Rules: Can be any string
- Advice: Consider using/including package name to avoid collision with name of another class (e.g., `blob`, which defines a single class; haven has `labelled` and `haven_labelled`)
- Convention: letters and `_`; avoid `.` since it might be confused as separator between generic and class name
**Practice:**
How to compose a class in practice?
- **Constructor**, which helps the developer create new object of target class. Provide always.
- **Validator**, which checks that values in constructor are valid. May not be necessary for simple classes.
- **Helper**, which helps users create new objects of target class. May be relevant only for user-facing classes.
### Constructors
Help developers construct an object of the target class:
```{r}
new_difftime <- function(x = double(), units = "secs") {
# check inputs
# issue generic system error if unexpected type or value
stopifnot(is.double(x))
units <- match.arg(units, c("secs", "mins", "hours", "days", "weeks"))
# construct instance of target class
structure(x,
class = "difftime",
units = units
)
}
```
### Validators
Contrast a constructor, aimed at quickly creating instances of a class, which only checks type of inputs ...
```{r}
new_factor <- function(x = integer(), levels = character()) {
stopifnot(is.integer(x))
stopifnot(is.character(levels))
structure(
x,
levels = levels,
class = "factor"
)
}
# error messages are for system default and developer-facing
new_factor(1:5, "a")
```
... with a validator, aimed at emitting errors if inputs pose problems, which makes more expensive checks
```{r}
validate_factor <- function(x) {
values <- unclass(x)
levels <- attr(x, "levels")
if (!all(!is.na(values) & values > 0)) {
stop(
"All `x` values must be non-missing and greater than zero",
call. = FALSE
)
}
if (length(levels) < max(values)) {
stop(
"There must be at least as many `levels` as possible values in `x`",
call. = FALSE
)
}
x
}
# error messages are informative and user-facing
validate_factor(new_factor(1:5, "a"))
```
Maybe there is a typo in the `validate_factor()` function? Do the integers need to start at 1 and be consecutive?
* If not, then `length(levels) < max(values)` should be `length(levels) < length(values)`, right?
* If so, why do the integers need to start at 1 and be consecutive? And if they need to be as such, we should tell the user, right?
```{r}
validate_factor(new_factor(1:3, levels = c("a", "b", "c")))
validate_factor(new_factor(10:12, levels = c("a", "b", "c")))
```
### Helpers
Some desired virtues:
- Have the same name as the class
- Call the constructor and validator, if the latter exists.
- Issue error informative, user-facing error messages
- Adopt thoughtful/useful defaults or type conversion
Exercise 5 in 13.3.4
Q: Read the documentation for `utils::as.roman()`. How would you write a constructor for this class? Does it need a validator? What might a helper do?
A: This function transforms numeric input into Roman numbers. It is built on the integer type, which results in the following constructor.
```{r}
new_roman <- function(x = integer()) {
stopifnot(is.integer(x))
structure(x, class = "roman")
}
```
The documentation tells us, that only values between 1 and 3899 are uniquely represented, which we then include in our validation function.
```{r}
validate_roman <- function(x) {
values <- unclass(x)
if (any(values < 1 | values > 3899)) {
stop(
"Roman numbers must fall between 1 and 3899.",
call. = FALSE
)
}
x
}
```
For convenience, we allow the user to also pass real values to a helper function.
```{r}
roman <- function(x = integer()) {
x <- as.integer(x)
validate_roman(new_roman(x))
}
# Test
roman(c(1, 753, 2024))
roman(0)
```
## Generics and methods
**Generic functions:**
- Consist of a call to `UseMethod()`
- Pass arguments from the generic to the dispatched method "auto-magically"
```{r}
my_new_generic <- function(x) {
UseMethod("my_new_generic")
}
```
### Method dispatch
- `UseMethod()` creates a vector of method names
- Dispatch
- Examines all methods in the vector
- Selects a method
```{r}
x <- Sys.Date()
sloop::s3_dispatch(print(x))
```
### Finding methods
While `sloop::s3_dispatch()` gives the specific method selected for a specific call, on can see the methods defined:
- For a generic
```{r}
sloop::s3_methods_generic("mean")
```
- For a class
```{r}
sloop::s3_methods_class("ordered")
```
### Creating methods
Two rules:
- Only write a method if you own the generic. Otherwise, bad manners.
- Method must have same arguments as its generic--with one important exception: `...`
**Example from text:**
I thought it would be good for us to work through this problem.
> Carefully read the documentation for `UseMethod()` and explain why the following code returns the results that it does. What two usual rules of function evaluation does `UseMethod()` violate?
```{r}
g <- function(x) {
x <- 10
y <- 10
UseMethod("g")
}
g.default <- function(x) c(x = x, y = y)
x <- 1
y <- 1
g(x)
g.default(x)
```
**Examples caught in the wild:**
- [`haven::zap_label`](https://github.com/tidyverse/haven/blob/main/R/zap_label.R), which removes column labels
- [`dplyr::mutate`](https://github.com/tidyverse/dplyr/blob/main/R/mutate.R)
- [`tidyr::pivot_longer`](https://github.com/tidyverse/tidyr/blob/main/R/pivot-long.R)
## Object styles
## Inheritance
Three ideas:
1. Class is a vector of classes
```{r}
class(ordered("x"))
class(Sys.time())
```
2. Dispatch moves through class vector until it finds a defined method
```{r}
sloop::s3_dispatch(print(ordered("x")))
```
3. Method can delegate to another method via `NextMethod()`, which is indicated by `->` as below:
```{r}
sloop::s3_dispatch(ordered("x")[1])
```
### `NextMethod()`
Consider `secret` class that masks each character of the input with `x` in output
```{r}
new_secret <- function(x = double()) {
stopifnot(is.double(x))
structure(x, class = "secret")
}
print.secret <- function(x, ...) {
print(strrep("x", nchar(x)))
invisible(x)
}
y <- new_secret(c(15, 1, 456))
y
```
Notice that the `[` method is problematic in that it does not preserve the `secret` class. Additionally, it returns `15` as the first element instead of `xx`.
```{r}
sloop::s3_dispatch(y[1])
y[1]
```
Fix this with a `[.secret` method:
The first fix (not run) is inefficient because it creates a copy of `y`.
```{r eval = FALSE}
# not run
`[.secret` <- function(x, i) {
x <- unclass(x)
new_secret(x[i])
}
```
`NextMethod()` is more efficient.
```{r}
`[.secret` <- function(x, i) {
# first, dispatch to `[`
# then, coerce subset value to `secret` class
new_secret(NextMethod())
}
```
Notice that `[.secret` is selected for dispatch, but that the method delegates to the internal `[`.
```{r}
sloop::s3_dispatch(y[1])
y[1]
```
### Allowing subclassing
Continue the example above to have a `supersecret` subclass that hides even the number of characters in the input (e.g., `123` -> `xxxxx`, 12345678 -> `xxxxx`, 1 -> `xxxxx`).
To allow for this subclass, the constructor function needs to include two additional arguments:
- `...` for passing an arbitrary set of arguments to different subclasses
- `class` for defining the subclass
```{r}
new_secret <- function(x, ..., class = character()) {
stopifnot(is.double(x))
structure(
x,
...,
class = c(class, "secret")
)
}
```
To create the subclass, simply invoke the parent class constructor inside of the subclass constructor:
```{r}
new_supersecret <- function(x) {
new_secret(x, class = "supersecret")
}
print.supersecret <- function(x, ...) {
print(rep("xxxxx", length(x)))
invisible(x)
}
```
But this means the subclass inherits all parent methods and needs to overwrite all parent methods with subclass methods that return the sublclass rather than the parent class.
There's no easy solution to this problem in base R.
There is a solution in the vectors package: `vctrs::vec_restore()`
<!-- TODO: read docs/vignettes to be able to summarize how this works -->
## Meeting Videos
### Cohort 1
`r knitr::include_url("https://www.youtube.com/embed/Fy3JF5Em6qY")`
### Cohort 2
`r knitr::include_url("https://www.youtube.com/embed/9GkgNC15EAw")`
### Cohort 3
`r knitr::include_url("https://www.youtube.com/embed/q7lFXSLdC1g")`
`r knitr::include_url("https://www.youtube.com/embed/2rHS_urTGFg")`
### Cohort 4
`r knitr::include_url("https://www.youtube.com/embed/4la5adcWwKE")`
`r knitr::include_url("https://www.youtube.com/embed/eTCT2O58GYM")`
### Cohort 5
`r knitr::include_url("https://www.youtube.com/embed/NeHtEGab1Og")`
### Cohort 6
`r knitr::include_url("https://www.youtube.com/embed/vzbl2o-MEeQ")`
<details>
<summary> Meeting chat log </summary>
```
00:05:30 Oluwafemi Oyedele: Hi everyone, Good Evening !!!
00:09:44 Trevin: I agree Arthur, need to look at that package some more
```
</details>
### Cohort 7
`r knitr::include_url("https://www.youtube.com/embed/zNLx4q8TCKQ")`