/
swirl.R
521 lines (490 loc) · 18.3 KB
/
swirl.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
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
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
#' An interactive learning environment for R and statistics.
#'
#' This function presents a choice of course lessons and interactively
#' tutors a user through them. A user may be asked to watch a video, to
#' answer a multiple-choice or fill-in-the-blanks question, or to
#' enter a command in the R console precisely as if he or she were
#' using R in practice. Emphasis is on the last, interacting with the
#' R console. User responses are tested for correctness and hints are
#' given if appropriate. Progress is automatically saved so that a user
#' may quit at any time and later resume without losing work.
#'
#' There are several ways to exit swirl: by typing \code{bye()} while in the R
#' console, by hitting the Esc key while not in the R console, or by
#' entering 0 from the swirl course menu. swirl will print a goodbye
#' message whenever it exits.
#'
#' While swirl is in operation, it may be controlled by entering special
#' commands in the R console. One of the special commands is \code{bye()}
#' as discussed above. Others are \code{play()}, \code{nxt()}, \code{skip()},
#' and \code{info()}. The parentheses are important.
#'
#' Sometimes a user will want to play around in the R console without
#' interference or commentary from swirl. This can be accomplished by
#' using the special command \code{play()}. swirl will remain in operation,
#' silently, until the special command \code{nxt()} is entered.
#'
#' The special command \code{skip()} can be used to skip a question if
#' necessary. swirl will enter the correct answer and notify the
#' user of the names of any new variables which it may have created
#' in doing so. These may be needed for subsequent questions.
#'
#' Finally, \code{info()} may be used to display a list of the special commands
#' themselves with brief explanations of what they do.
#' @param resume.class for development only; please accept the default.
#' @param ... arguments for special purposes only, such as lesson testing
#' @export
#' @importFrom stringr str_c str_trim str_split str_length
#' @importFrom stringr str_detect str_locate fixed str_split_fixed
#' @importFrom testthat expectation equals is_equivalent_to
#' @importFrom testthat is_identical_to is_a matches
#' @examples
#' \dontrun{
#'
#' swirl()
#' }
swirl <- function(resume.class="default", ...){
# Creates an environment, e, defines a function, cb, and registers
# cb as a callback with data argument, e. The callback retains a
# reference to the environment in which it was created, environment(cb),
# hence that environment, which also contains e, persists as long
# as cb remains registered. Thus e can be used to store infomation
# between invocations of cb.
removeTaskCallback("mini")
# e lives here, in the environment created when swirl() is run
e <- new.env(globalenv())
# This dummy object of class resume.class "tricks" the S3 system
# into calling the proper resume method. We retain the "environment"
# class so that as.list(e) works.
class(e) <- c("environment", resume.class)
# The callback also lives in the environment created when swirl()
# is run and retains a reference to it. Because of this reference,
# the environment which contains both e and cb() persists as
# long as cb() remains registered.
cb <- function(expr, val, ok, vis, data=e){
# The following will modify the persistent e
e$expr <- expr
e$val <- val
e$ok <- ok
e$vis <- vis
# The result of resume() will determine whether the callback
# remains active
return(resume(e, ...))
}
addTaskCallback(cb, name="mini")
invisible()
}
## SPECIAL COMMANDS
#' Exit swirl.
#'
#' swirl operates by installing a callback function which responds
#' to commands entered in the R console. This is how it captures
#' and tests answers given by the user in the R console. swirl will
#' remain in operation until this callback is removed, which is
#' what \code{bye()} does.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a new variable called `x` that contains the number 3.
#'
#' > bye()
#'
#' | Leaving swirl now. Type swirl() to resume.
#' }
bye <- function(){
removeTaskCallback("mini")
swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)
invisible()
}
#' Begin the upcoming question or unit of instruction.
#'
#' This is the way to regain swirl's attention after viewing
#' a video or \code{play()}'ing around in the console.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a new variable called `y` that contains the number 8.
#'
#' > play()
#'
#' | Entering play mode. Experiment as you please, then type nxt()
#' | when you ready to resume the lesson.
#'
#' > 10/14
#' > [1] 0.7142857
#' > zz <- 99
#' > zz
#' > [1] 99
#' > nxt()
#'
#' | Resuming lesson...
#' }
nxt <- function(){invisible()}
#' Skip the current unit of instruction.
#'
#' swirl will enter the correct answer and notify the
#' user of the names of any new variables which it may have created
#' in doing so. These may be needed for subsequent questions.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a new variable called `y` that contains the number 8.
#'
#' > skip()
#'
#' | I've entered the correct answer for you.
#'
#' | In doing so, I've created the variable(s) y, which you may need later.
#' }
skip <- function(){invisible()}
#' Start over on the current script question.
#'
#' During a script question, this will reset the script
#' back to its original state, which can be helpful if you
#' get stuck.
#' @export
reset <- function(){invisible()}
#' Submit the active R script in response to a question.
#'
#' When a swirl question requires the user to edit an R script, the
#' \code{submit()} function allows the user to submit their response.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a function called f that takes one argument, x, and
#' | returns the value of x squared.
#'
#' > submit()
#'
#' | You are quite good my friend!
#' }
submit <- function(){invisible()}
#' Tell swirl to ignore console input for a while.
#'
#' It is sometimes useful to play around in the R console out of
#' curiosity or to solidify a concept. This command will cause
#' swirl to remain idle, allowing the user to experiment at will,
#' until the command \code{nxt()} is entered.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a new variable called `y` that contains the number 8.
#'
#' > play()
#'
#' | Entering play mode. Experiment as you please, then type nxt()
#' | when you ready to resume the lesson.
#'
#' > 10/14
#' > [1] 0.7142857
#' > zz <- 99
#' > zz
#' > [1] 99
#' > nxt()
#'
#' | Resuming lesson...
#' }
play <- function(){invisible()}
#' Return to swirl's main menu.
#'
#' Return to swirl's main menu from a lesson in progress.
#' @export
#' @examples
#' \dontrun{
#'
#' | The simplest way to create a sequence of numbers in R is by using
#' | the `:` operator. Type 1:20 to see how it works.
#'
#' > main()
#'
#' | Returning to the main menu...
#' }
main <- function(){invisible()}
#' Display a list of special commands.
#'
#' Display a list of the special commands, \code{bye()}, \code{play()},
#' \code{nxt()}, \code{skip()}, and \code{info()}.
#' @export
#' @examples
#' \dontrun{
#'
#' | Create a new variable called `z` that contains the number 11.
#'
#' > info()
#'
#' | When you are at the R prompt (>):
#' | -- Typing skip() allows you to skip the current question.
#' | -- Typing play() lets you experiment with R on your own; swirl will ignore what
#' | you do...
#' | -- UNTIL you type nxt() which will regain swirl's attention.
#' | -- Typing bye() causes swirl to exit. Your progress will be saved.
#' | -- Typing info() displays these options again.
#'
#' > bye()
#'
#' | Leaving swirl now. Type swirl() to resume.
#' }
info <- function(){
swirl_out("When you are at the R prompt (>):")
swirl_out("-- Typing skip() allows you to skip the current question.", skip_before=FALSE)
swirl_out("-- Typing play() lets you experiment with R on your own; swirl will ignore what you do...", skip_before=FALSE)
swirl_out("-- UNTIL you type nxt() which will regain swirl's attention.", skip_before=FALSE)
swirl_out("-- Typing bye() causes swirl to exit. Your progress will be saved.", skip_before=FALSE)
swirl_out("-- Typing main() returns you to swirl's main menu.", skip_before=FALSE)
swirl_out("-- Typing info() displays these options again.", skip_before=FALSE, skip_after=TRUE)
invisible()
}
## RESUME METHOD
resume <- function(...)UseMethod("resume")
# Default method resume implements a finite state (or virtual) machine.
# It runs a fixed "program" consisting of three "instructions" which in
# turn present information, capture a user's response, and test and retry
# if necessary. The three instructions are themselves S3 methods which
# depend on the class of the active row of the course lesson. The
# instruction set is thus extensible. It can be found in R/instructionSet.R.
resume.default <- function(e, ...){
# Check that if running in test mode, all necessary args are specified
if(is(e, "test")) {
# Capture ... args
targs <- list(...)
# Check if appropriately named args exist
if(is.null(targs$test_course) || is.null(targs$test_lesson)) {
stop("Must specify 'test_course' and 'test_lesson' to run in 'test' mode!")
} else {
# Make available for use in menu functions
e$test_lesson <- targs$test_lesson
e$test_course <- targs$test_course
}
# Check that 'from' is less than 'to' if they are both provided
if(!is.null(targs$from) && !is.null(targs$to)) {
if(targs$from >= targs$to) {
stop("Argument 'to' must be strictly greater than argument 'from'!")
}
}
if(is.null(targs$from)) {
e$test_from <- 1
} else {
e$test_from <- targs$from
}
if(is.null(targs$to)) {
e$test_to <- 999 # Lesson will end naturally before this
} else {
e$test_to <- targs$to
}
}
esc_flag <- TRUE
on.exit(if(esc_flag)swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE))
# Trap special functions
if(uses_func("info")(e$expr)[[1]]){
esc_flag <- FALSE
return(TRUE)
}
if(uses_func("nxt")(e$expr)[[1]]){
## Using the stored list of "official" swirl variables and values,
# assign variables of the same names in the global environment
# their "official" values, in case the user has changed them
# while playing.
if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv())
swirl_out("Resuming lesson...")
e$playing <- FALSE
e$iptr <- 1
}
# The user wants to reset their script to the original
if(uses_func("reset")(e$expr)[[1]]) {
e$playing <- FALSE
e$reset <- TRUE
e$iptr <- 2
swirl_out("I just reset the script to its original state. If it doesn't refresh immediately, you may need to click on it.",
skip_after = TRUE)
}
# The user wants to submit their R script
if(uses_func("submit")(e$expr)[[1]]){
e$playing <- FALSE
# Get contents from user's submitted script
e$script_contents <- readLines(e$script_temp_path, warn = FALSE)
# Save expr to e
e$expr <- try(parse(text = e$script_contents), silent = TRUE)
swirl_out("Sourcing your script...", skip_after = TRUE)
try(source(e$script_temp_path))
}
if(uses_func("play")(e$expr)[[1]]){
swirl_out("Entering play mode. Experiment as you please, then type nxt() when you are ready to resume the lesson.", skip_after=TRUE)
e$playing <- TRUE
}
# If the user wants to skip the current question, do the bookkeeping.
if(uses_func("skip")(e$expr)[[1]]){
# Increment a skip count kept in e.
if(!exists("skips", e)) e$skips <- 0
e$skips <- 1 + e$skips
# Enter the correct answer for the user
# by simulating what the user should have done
correctAns <- e$current.row[,"CorrectAnswer"]
# If we are on a script question, the correct answer should
# simply source the correct script
if(is(e$current.row, "script") && is.na(correctAns)) {
correct_script_path <- e$correct_script_temp_path
if(file.exists(correct_script_path)) {
# Get contents of the correct script
e$script_contents <- readLines(correct_script_path, warn = FALSE)
# Save expr to e
e$expr <- try(parse(text = e$script_contents), silent = TRUE)
# Source the correct script
try(source(correct_script_path))
# Inform the user and open the correct script
swirl_out("I just sourced the following script, which demonstrates one possible solution.",
skip_after=TRUE)
file.edit(correct_script_path)
readline("Press Enter when you are ready to continue...")
}
# If this is not a script question...
} else {
# In case correctAns refers to newVar, add it
# to the official list AND the global environment
if(exists("newVarName",e)) {
correctAns <- gsub("newVar", e$newVarName, correctAns)
}
e$expr <- parse(text=correctAns)[[1]]
ce <- cleanEnv(e$snapshot)
e$val <- suppressMessages(suppressWarnings(eval(e$expr, ce)))
xfer(ce, globalenv())
ce <- as.list(ce)
# Inform the user and expose the correct answer
swirl_out("Entering the following correct answer for you...",
skip_after=TRUE)
message("> ", e$current.row[, "CorrectAnswer"])
}
# Make sure playing flag is off since user skipped
e$playing <- FALSE
# If the user is not trying to skip and is playing,
# ignore console input, but remain in operation.
} else if(exists("playing", envir=e, inherits=FALSE) && e$playing) {
esc_flag <- FALSE
return(TRUE)
}
# If the user want to return to the main menu, do the bookkeeping
if(uses_func("main")(e$expr)[[1]]){
swirl_out("Returning to the main menu...")
# Remove the current lesson. Progress has been saved already.
if(exists("les", e, inherits=FALSE)){
rm("les", envir=e, inherits=FALSE)
}
}
# If user is looking up a help file, ignore their input
# unless the correct answer involves do so
if(uses_func("help")(e$expr)[[1]] ||
uses_func("`?`")(e$expr)[[1]]){
# Get current correct answer
corrans <- e$current.row[, "CorrectAnswer"]
# Parse the correct answer
corrans_parsed <- parse(text = corrans)
# See if it contains ? or help
uses_help <- uses_func("help")(corrans_parsed)[[1]] ||
uses_func("`?`")(corrans_parsed)[[1]]
if(!uses_help) {
esc_flag <- FALSE
return(TRUE)
}
}
# Method menu initializes or reinitializes e if necessary.
temp <- mainMenu(e)
# If menu returns FALSE, the user wants to exit.
if(is.logical(temp) && !isTRUE(temp)){
swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)
esc_flag <- FALSE # To supress double notification
return(FALSE)
}
# if e$expr is NOT swirl() or nxt(), the user has just responded to
# a question at the command line. Simulate evaluation of the
# user's expression and save any variables changed or created
# in e$delta.
# TODO: Eventually make auto-detection of new variables an option.
# Currently it can be set in customTests.R
if(!uses_func("swirl")(e$expr)[[1]] &&
!uses_func("swirlify")(e$expr)[[1]] &&
!uses_func("testit")(e$expr)[[1]] &&
!uses_func("nxt")(e$expr)[[1]] &&
isTRUE(customTests$AUTO_DETECT_NEWVAR)) {
e$delta <- mergeLists(safeEval(e$expr, e), e$delta)
}
# Execute instructions until a return to the prompt is necessary
while(!e$prompt){
# If the lesson is complete, save progress, remove the current
# lesson from e, and invoke the top level menu method.
# Below, min() ignores e$test_to if it is NULL (i.e. not in 'test' mode)
if(e$row > min(nrow(e$les), e$test_to)) {
# If in test mode, we don't want to run another lesson
if(is(e, "test")) {
swirl_out("Lesson complete! Exiting swirl now...",
skip_after=TRUE)
esc_flag <- FALSE # to supress double notification
return(FALSE)
}
saveProgress(e)
# form a new path for the progress file
# which indicates completion and doesn't
# fit the regex pattern "[.]rda$" i.e.
# doesn't end in .rda, hence won't be
# recognized as an active progress file.
new_path <- paste(e$progress,".done", sep="")
# rename the progress file to indicate completion
if(file.exists(new_path))file.remove(new_path)
file.rename(e$progress, new_path)
# Coursera check
courseraCheck(e)
# remove the current lesson and any custom tests
if(exists("les", e, inherits=FALSE)){
rm("les", envir=e, inherits=FALSE)
}
# Reset skip count if it exists
if(exists("skips", e)) e$skips <- 0
clearCustomTests()
# Let user know lesson is complete
swirl_out("You've reached the end of this lesson! Returning to the main menu...")
# let the user select another course lesson
temp <- mainMenu(e)
# if menu returns FALSE, user wants to quit.
if(is.logical(temp) && !isTRUE(temp)){
swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)
esc_flag <- FALSE # to supress double notification
return(FALSE)
}
}
# If we are ready for a new row, prepare it
if(e$iptr == 1){
# Increment progress bar
cat("\n")
setTxtProgressBar(e$pbar, e$pbar_seq[e$row])
# Any variables changed or created during the previous
# question must have been correct or we would not be about
# to advance to a new row. Incorporate these in the list
# of swirl's "official" names and values.
if (!is.null(e$delta)){
e$snapshot <- mergeLists(e$delta,e$snapshot)
}
e$delta <- list()
saveProgress(e)
e$current.row <- e$les[e$row,]
# Prepend the row's swirl class to its class attribute
class(e$current.row) <- c(e$current.row[,"Class"],
class(e$current.row))
}
# Execute the current instruction
e$instr[[e$iptr]](e$current.row, e)
# Check if a side effect, such as a sourced file, has changed the
# values of any variables in the official list. If so, add them
# to the list of changed variables.
for(nm in names(e$snapshot)){
if(!identical(e$snapshot[[nm]], get(nm, globalenv()))){
e$delta[[nm]] <- get(nm, globalenv())
}
}
}
e$prompt <- FALSE
esc_flag <- FALSE
return(TRUE)
}