-
Notifications
You must be signed in to change notification settings - Fork 0
/
Function-operators.Rmd
265 lines (179 loc) · 7.7 KB
/
Function-operators.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
# Function operators
```{r Function-operators-1, include = FALSE}
source("common.R")
```
Attaching the needed libraries:
```{r Function-operators-2, warning=FALSE, message=FALSE}
library(purrr, warn.conflicts = FALSE)
```
## Existing function operators (Exercises 11.2.3)
---
**Q1.** Base R provides a function operator in the form of `Vectorize()`. What does it do? When might you use it?
**A1.** `Vectorize()` function creates a function that vectorizes the action of the provided function over specified arguments (i.e., it acts on each element of the vector). We will see its utility by solving a problem that otherwise would be difficult to solve.
The problem is to find indices of matching numeric values for the given threshold by creating a hybrid of the following functions:
- `%in%` (which doesn't provide any way to provide tolerance when comparing numeric values),
- `dplyr::near()` (which is vectorized element-wise and thus expects two vectors of equal length)
```{r Function-operators-3}
which_near <- function(x, y, tolerance) {
# Vectorize `dplyr::near()` function only over the `y` argument.
# `Vectorize()` is a function operator and will return a function.
customNear <- Vectorize(dplyr::near, vectorize.args = c("y"), SIMPLIFY = FALSE)
# Apply the vectorized function to vector arguments and then check where the
# comparisons are equal (i.e. `TRUE`) using `which()`.
#
# Use `compact()` to remove empty elements from the resulting list.
index_list <- purrr::compact(purrr::map(customNear(x, y, tol = tolerance), which))
# If there are any matches, return the indices as an atomic vector of integers.
if (length(index_list) > 0L) {
index_vector <- purrr::simplify(index_list, "integer")
return(index_vector)
}
# If there are no matches
return(integer(0L))
}
```
Let's use it:
```{r Function-operators-4}
x1 <- c(2.1, 3.3, 8.45, 8, 6)
x2 <- c(6, 8.40, 3)
which_near(x1, x2, tolerance = 0.1)
```
Note that we needed to create a new function for this because neither of the existing functions do what we want.
```{r}
which(x1 %in% x2)
which(dplyr::near(x1, x2, tol = 0.1))
```
We solved a complex task here using the `Vectorize()` function!
---
**Q2.** Read the source code for `possibly()`. How does it work?
**A2.** Let's have a look at the source code for this function:
```{r Function-operators-5}
possibly
```
Looking at this code, we can see that `possibly()`:
- uses `tryCatch()` for error handling
- has a parameter `otherwise` to specify default value in case an error occurs
- has a parameter `quiet` to suppress error message (if needed)
---
**Q3.** Read the source code for `safely()`. How does it work?
**A3.** Let's have a look at the source code for this function:
```{r Function-operators-6}
safely
purrr:::capture_error
```
Looking at this code, we can see that `safely()`:
- uses a list to save both the results (if the function executes successfully) and the error (if it fails)
- uses `tryCatch()` for error handling
- has a parameter `otherwise` to specify default value in case an error occurs
- has a parameter `quiet` to suppress error message (if needed)
---
## Case study: Creating your own function operators (Exercises 11.3.1)
---
**Q1.** Weigh the pros and cons of `download.file %>% dot_every(10) %>% delay_by(0.1)` versus `download.file %>% delay_by(0.1) %>% dot_every(10)`.
**A1.** Although both of these chains of piped operations produce the same number of dots and would need the same amount of time, there is a subtle difference in how they do this.
- `download.file %>% dot_every(10) %>% delay_by(0.1)`
Here, the printing of the dot is also delayed, and the first dot is printed when the 10th URL download starts.
- `download.file %>% delay_by(0.1) %>% dot_every(10)`
Here, the first dot is printed after the 9th download is finished, and the 10th download starts after a short delay.
---
**Q2.** Should you memoise `download.file()`? Why or why not?
**A2.** Since `download.file()` is meant to download files from the Internet, memoising it is not recommended for the following reasons:
- Memoization is helpful when giving the same input the function returns the same output. This is not necessarily the case for webpages since they constantly change, and you may continue to "download" an outdated version of the webpage.
- Memoization works by caching results, which can take up a significant amount of memory.
---
**Q3.** Create a function operator that reports whenever a file is created or deleted in the working directory, using `dir()` and `setdiff()`. What other global function effects might you want to track?
**A3.** First, let's create helper functions to compare and print added or removed filenames:
```{r Function-operators-7}
print_multiple_entries <- function(header, entries) {
message(paste0(header, ":\n"), paste0(entries, collapse = "\n"))
}
file_comparator <- function(old, new) {
if (setequal(old, new)) {
return()
}
removed <- setdiff(old, new)
added <- setdiff(new, old)
if (length(removed) > 0L) print_multiple_entries("- File removed", removed)
if (length(added) > 0L) print_multiple_entries("- File added", added)
}
```
We can then write a function operator and use it to create functions that will do the necessary tracking:
```{r Function-operators-8}
dir_tracker <- function(f) {
force(f)
function(...) {
old_files <- dir()
on.exit(file_comparator(old_files, dir()), add = TRUE)
f(...)
}
}
file_creation_tracker <- dir_tracker(file.create)
file_deletion_tracker <- dir_tracker(file.remove)
```
Let's try it out:
```{r Function-operators-9}
file_creation_tracker(c("a.txt", "b.txt"))
file_deletion_tracker(c("a.txt", "b.txt"))
```
Other global function effects we might want to track:
- working directory
- environment variables
- connections
- library paths
- graphics devices
- [etc.](https://withr.r-lib.org/reference/index.html)
---
**Q4.** Write a function operator that logs a timestamp and message to a file every time a function is run.
**A4.** The following function operator logs a timestamp and message to a file every time a function is run:
```{r Function-operators-10}
# helper function to write to a file connection
write_line <- function(filepath, ...) {
cat(..., "\n", sep = "", file = filepath, append = TRUE)
}
# function operator
logger <- function(f, filepath) {
force(f)
force(filepath)
write_line(filepath, "Function created at: ", as.character(Sys.time()))
function(...) {
write_line(filepath, "Function called at: ", as.character(Sys.time()))
f(...)
}
}
# check that the function works as expected with a tempfile
withr::with_tempfile("logfile", code = {
logged_runif <- logger(runif, logfile)
Sys.sleep(sample.int(10, 1))
logged_runif(1)
Sys.sleep(sample.int(10, 1))
logged_runif(2)
Sys.sleep(sample.int(10, 1))
logged_runif(3)
cat(readLines(logfile), sep = "\n")
})
```
---
**Q5.** Modify `delay_by()` so that instead of delaying by a fixed amount of time, it ensures that a certain amount of time has elapsed since the function was last called. That is, if you called `g <- delay_by(1, f); g(); Sys.sleep(2); g()` there shouldn't be an extra delay.
**A5.** Modified version of the function meeting the specified requirements:
```{r Function-operators-11}
delay_by_atleast <- function(f, amount) {
force(f)
force(amount)
# the last time the function was run
last_time <- NULL
function(...) {
if (!is.null(last_time)) {
wait <- (last_time - Sys.time()) + amount
if (wait > 0) Sys.sleep(wait)
}
# update the time in the parent frame for the next run when the function finishes
on.exit(last_time <<- Sys.time())
f(...)
}
}
```
---
## Session information
```{r Function-operators-12}
sessioninfo::session_info(include_base = TRUE)
```