├── .Rbuildignore ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── actions.R ├── answerTests.R ├── answerTests2.R ├── args_specification.R ├── courseraCheck.R ├── email_info.R ├── global.R ├── install_course.R ├── instructionSet.R ├── languages.R ├── lesson_constructor.R ├── log.R ├── menu.R ├── options.R ├── parse_content.R ├── phrases.R ├── post.R ├── progress.R ├── rmatch_calls.R ├── rmd2df.R ├── swirl.R ├── sysdata.rda ├── testthat_legacy.R ├── utilities.R └── zzz.R ├── README.md ├── cran-comments.md ├── inst ├── Courses │ └── suggested_courses.yaml └── test │ └── test-encoding.yaml ├── man ├── AnswerTests.Rd ├── InstallCourses.Rd ├── any_of_exprs.Rd ├── bye.Rd ├── calculates_same_value.Rd ├── delete_progress.Rd ├── email_admin.Rd ├── expr_creates_var.Rd ├── expr_identical_to.Rd ├── expr_is_a.Rd ├── expr_uses_func.Rd ├── func_of_newvar_equals.Rd ├── info.Rd ├── install_course.Rd ├── install_course_directory.Rd ├── install_course_dropbox.Rd ├── install_course_github.Rd ├── install_course_google_drive.Rd ├── install_course_url.Rd ├── install_course_zip.Rd ├── install_from_swirl.Rd ├── is_robust_match.Rd ├── main.Rd ├── nxt.Rd ├── omnitest.Rd ├── play.Rd ├── reset.Rd ├── restart.Rd ├── rmatch_calls.Rd ├── select_language.Rd ├── skip.Rd ├── submit.Rd ├── swirl.Rd ├── swirl_options.Rd ├── uninstall_all_courses.Rd ├── uninstall_course.Rd ├── val_has_length.Rd ├── val_matches.Rd ├── var_is_a.Rd └── zip_course.Rd ├── revdep ├── check.R └── checks.rds ├── swirl.Rproj └── tests ├── test-all.R └── testthat ├── test-encoding.R ├── test-rmatch_calls.R └── test-uses_func.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^.*.html$ 4 | user_data/ 5 | ^\.travis\.yml$ 6 | ^cran-comments\.md$ 7 | ^revdep$ 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rhistory 2 | .Rproj.user 3 | .RData 4 | swirl.Rproj 5 | *.html 6 | .DS_Store 7 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | 3 | matrix: 4 | include: 5 | - r: release 6 | - r: oldrel 7 | - r: devel 8 | 9 | cache: packages 10 | sudo: false 11 | 12 | notifications: 13 | email: 14 | on_success: always 15 | on_failure: always -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: swirl 2 | Title: Learn R, in R 3 | Description: Use the R console as an interactive learning 4 | environment. Users receive immediate feedback as they are guided through 5 | self-paced lessons in data science and R programming. 6 | URL: http://swirlstats.com 7 | Version: 2.4.5 8 | License: MIT + file LICENSE 9 | Authors@R: c( 10 | person("Sean", "Kross", email = "sean@seankross.com", role = c("aut", "cre")), 11 | person("Nick", "Carchedi", role = "aut"), 12 | person("Bill", "Bauer", role = "aut"), 13 | person("Gina", "Grdina", role = "aut"), 14 | person("Filip", "Schouwenaars", role = "ctb"), 15 | person("Wush", "Wu", role = "ctb") 16 | ) 17 | Depends: 18 | R (>= 3.1.0) 19 | Imports: 20 | stringr, 21 | testthat (>= 1.0.2), 22 | httr (>= 1.1.0), 23 | yaml, 24 | RCurl, 25 | digest, 26 | tools, 27 | methods 28 | Suggests: 29 | stringi 30 | Encoding: UTF-8 31 | LazyData: true 32 | RoxygenNote: 7.0.2 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017 2 | COPYRIGHT HOLDER: Team swirl -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(bye) 4 | export(delete_progress) 5 | export(email_admin) 6 | export(info) 7 | export(install_course) 8 | export(install_course_directory) 9 | export(install_course_dropbox) 10 | export(install_course_github) 11 | export(install_course_google_drive) 12 | export(install_course_url) 13 | export(install_course_zip) 14 | export(install_from_swirl) 15 | export(is_robust_match) 16 | export(main) 17 | export(nxt) 18 | export(play) 19 | export(reset) 20 | export(restart) 21 | export(rmatch_calls) 22 | export(select_language) 23 | export(skip) 24 | export(submit) 25 | export(swirl) 26 | export(swirl_options) 27 | export(uninstall_all_courses) 28 | export(uninstall_course) 29 | export(zip_course) 30 | importFrom(RCurl,base64) 31 | importFrom(RCurl,getForm) 32 | importFrom(RCurl,postForm) 33 | importFrom(digest,digest) 34 | importFrom(httr,GET) 35 | importFrom(httr,content) 36 | importFrom(httr,progress) 37 | importFrom(methods,is) 38 | importFrom(stringr,fixed) 39 | importFrom(stringr,str_c) 40 | importFrom(stringr,str_detect) 41 | importFrom(stringr,str_extract) 42 | importFrom(stringr,str_length) 43 | importFrom(stringr,str_locate) 44 | importFrom(stringr,str_match) 45 | importFrom(stringr,str_split) 46 | importFrom(stringr,str_split_fixed) 47 | importFrom(stringr,str_trim) 48 | importFrom(testthat,compare) 49 | importFrom(tools,file_ext) 50 | importFrom(tools,file_path_sans_ext) 51 | importFrom(yaml,yaml.load) 52 | importFrom(yaml,yaml.load_file) 53 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # swirl 2.4.5 2 | 3 | * Thank you @HenrikBengtsson for fixing a warning when 4 | `warnPartialMatchArgs=TRUE`. (#779) 5 | 6 | # swirl 2.4.4 7 | 8 | * Fixed encoding test which was failing on CRAN (debian-clang-devel). 9 | 10 | # swirl 2.4.3 11 | 12 | * Added "swirl_is_fun" option to `swirl_options()`. 13 | 14 | * Added Portuguese menu translations. 15 | 16 | # swirl 2.4.2 17 | 18 | * Script questions behave more appropriately in RStudio. (#434, thank you @jimhester) 19 | 20 | # swirl 2.4.1 21 | 22 | * Added new answer test: `calculates_same_value()`. 23 | 24 | * Now compatible with versions of testthat later than 0.11.0. 25 | 26 | # swirl 2.4.0 27 | 28 | * Added support for multiple languages, including Spanish, French, German, 29 | Turkish, Simplified Chinese, and Korean. The default language can be changed 30 | using the function `select_language()`. 31 | 32 | * Added `install_course()` in order to install swirl courses that are 33 | distributed in the .swc format. 34 | 35 | * The directories where swirl courses and where user data is stored can now be 36 | explicitly specified. These options can be set using the function 37 | `swirl_options()`. 38 | 39 | * It's now possible to log and collect a student's progression 40 | through a swirl course. Enable logging with `swirl_options()`. 41 | 42 | * Improved support for displaying non-ASCII character sets 43 | through UTF-8 encoding. 44 | 45 | * Now compatible with `swirlify::demo_lesson()`. 46 | 47 | # swirl 2.3.1 48 | 49 | * Add progress bar to track download progress of a course. 50 | 51 | # swirl 2.3.0 52 | 53 | * Add basic developer API to swirl, courtesy of @filipsch and @seankross. 54 | 55 | * Change license to MIT, which is slightly less restrictive than GPL-3 and will make it easy for developers to tap into the new API. 56 | 57 | # swirl 2.2.21 58 | 59 | * Add `mirror` argument to `install_from_swirl()` to accommodate installing courses from the Bitbucket mirror of our swirl-courses GitHub repository. (Prompted by India's blocking of GitHub.) 60 | 61 | * Check for existence of variable in swirl.R to address issue with using `rm()` command. 62 | 63 | # swirl 2.2.20 64 | 65 | * Fix troublesome bug in `omnitest` due to typo (thanks to @reginaastri). 66 | 67 | # swirl 2.2.19 68 | 69 | * Add `uninstall_all_courses` function. 70 | 71 | # swirl 2.2.18 72 | 73 | * Fix small bug in `omnitest` due to missing exclamation point (thanks to @wilcrofter). 74 | 75 | * Add `delete_progress` function (thanks to @seankross). 76 | 77 | # swirl 2.2.17 78 | 79 | * Use of `partner.coursera.org` websites for Coursera submission is enabled. 80 | 81 | * `Omnitest` uses `rmatch_calls` (recursive `match.call`) to deal with legitimate variations of function and S3 method calls. 82 | 83 | # swirl 2.2.16 84 | 85 | * Fix bug in `install_from_swirl()` that was causing `install_from_swirl("R Programming")` to install both `R Programming` and `R Programming Alt`. 86 | 87 | * Fix troublesome links to the swirl_courses repo. 88 | 89 | # swirl 2.2.15 90 | 91 | * Fix annoying typo in one of the "praise" messages. 92 | 93 | # swirl 2.2.14 94 | 95 | * Add `?InstallCourses`, which gives a brief overview of installing swirl courses and includes links to all relevant help files. 96 | 97 | * Add `email_admin()` feature, which allows the user to automatically generate an email to be sent to `info@swirlstats.com`. The email includes space for a description of the problem along with the output from `sessionInfo()`. 98 | 99 | * Clean up swirl's core function, `swirl()` in swirl.R, so that we can view the administrative environment `e` with `as.list(e)` without complaint from R. 100 | 101 | * Add empty cran-comments.md to appease new devtools `release()`. 102 | 103 | # swirl 2.2.13 104 | 105 | * Add a new `script` question type, which allows an instructor to present a preformatted R script to the user for editing and submission. swirl was originally designed for interactive programming at the prompt. It now accommodates multiline input, which allows for exploration of topics like writing functions and control structures, as well as more extended function calls. 106 | 107 | * Allow user to make swirl feedback less playful with `options(swirl_is_fun = FALSE)`. 108 | 109 | # swirl 2.2.12 110 | 111 | * In `welcome.default()`, make sure the user doesn't put any special characters (using the `[[:punct:]]` regex) in his or her name, as this might lead to an invalid file path for their user data. Thanks to @Sarpwus for bringing this to my attention. 112 | 113 | * Trim leading/trailing whitespace when reading lesson dependencies from dependson.txt. 114 | 115 | * Add `dev` argument to `install_from_swirl()` to allow installation of courses in development from the [swirl_misc](http://github.com/swirldev/swirl_misc/zipball/master) repository. 116 | 117 | * Update phrases.R to include new praise and 'try again' phrases. Thanks to @sagevann for the suggestions. 118 | 119 | * Use `capture.output()` to avoid double printing due to second evaluation by `safeEval()` when `AUTO_DETECT_NEWVAR` is `TRUE`. 120 | 121 | # swirl 2.2.11 122 | 123 | * Add `testit()` to functions for callback to ignore, so that swirl plays nicely with swirlify. 124 | 125 | * Add from/to feature for testing specific units of content during course authoring. 126 | 127 | # swirl 2.2.10 128 | 129 | * Corrected order of `mergeList` arguments in `swirl.R`. 130 | 131 | # swirl 2.2.9 132 | 133 | * Add Regression Models to recommended courses. 134 | 135 | # swirl 2.2.8 136 | 137 | * Alternate user progress tracking strategy without previous lag or freeze problems. Backwards compatible with existing course content. Tracks large or small lesson data sets by default, but these may be excluded by sourcing with local=FALSE from the initLesson.R file. 138 | 139 | * Make course installation success/failure messages more robust. 140 | 141 | * Add documentation for `?AnswerTests`. 142 | 143 | * Create a file for manual submission to Coursera immediately after the user enters his or her credentials. This way, no matter what happens during the submission process, manual submission is still an option. The file is deleted if automatic submission succeeds. 144 | 145 | * Add `any_of_exprs()` to library of answer tests. 146 | 147 | # swirl 2.2.7 148 | 149 | * Another check that Coursera challenge url is valid 150 | 151 | # swirl 2.2.6 152 | 153 | * Fix bug related to user entering their Coursera Course ID with quotes. 154 | 155 | * Fix bug causing swirl to fail when exiting from course menu. 156 | 157 | # swirl 2.2.5 158 | 159 | * Add `packageStartupMessage()` that detects a cluttered workspace and warns the user that this may cause swirl to run slowly. 160 | 161 | * Add `main()` function, which allows user to return to the main menu while a lesson is in progress. 162 | 163 | * Add `which_course` argument to `install_course_zip()` that will facilitate manual installation. In particular, if a student downloads a zip file from the swirl courses repo, it comes with all courses in it. This function will allow the user to install only those that she wants. 164 | 165 | # swirl 2.2.4 166 | 167 | * Bug fix related to `skip()` count not resetting upon lesson completion. 168 | 169 | # swirl 2.2.3 170 | 171 | * Add confirmation step to Coursera submission process. 172 | 173 | * Stash Course ID along with other Coursera creds. 174 | 175 | * Display correct answer when user `skip()`s a question. 176 | 177 | # swirl 2.2.2 178 | 179 | * Fix bug in old answer test caused by upgrade to R 3.1.0 and made evident in the Data Analysis course. 180 | 181 | # swirl 2.2.1 182 | 183 | * Check for missing entries in content YAML to prevent failure when loading a course. 184 | 185 | # swirl 2.2 186 | 187 | * Instructional content is no longer shipped with swirl. Instead, it is located in our [course repo](https://github.com/swirldev/swirl_courses). When the user starts swirl, he or she is given the option to install the R Programming course automatically or be taken to the course repo page. Courses can also be installed with the `install_from_swirl()` function. 188 | 189 | * Content authoring tools have also been removed from the swirl package. We've created a new package called [swirlify](https://github.com/swirldev/swirlify), which is a comprehensive toolbox for swirl instructors. Instructions for authoring content are on the [Instructors page](http://swirlstats.com/instructors.html) of the swirl website. 190 | 191 | * Package dependencies for a lesson are now managing by including a file called `dependson.txt` in the lesson directory, which lists required packages one line at a time. This strategy is mainly for backwards compatibility and will take a different form for new content in future releases. When the user begins a lesson with package dependencies, swirl attempts to load each package in turn and prompts the user to automatically install any packages not found. 192 | 193 | * Added help files for answer tests contained in `answerTests.R.` 194 | 195 | * Added progress bar feature using `utils::txtProgressBar()`. 196 | 197 | * Added `test` mode for compatibility with the [swirlify](https://github.com/swirldev/swirlify) package. 198 | 199 | * Integrated with Coursera API to allow enrolled students to receive credit for swirl lessons associated their Coursera course. 200 | 201 | * `rmd2df()` can finally handle `figure` and `video` units of instruction. 202 | 203 | # swirl 2.1.1 204 | 205 | * Fixed a bug in the third lesson of Intro to R. 206 | 207 | # swirl 2.1 208 | 209 | * `parse_content()` now parses content (at runtime) in its original form (R Markdown, YAML, etc.), making conversion to CSV files unnecessary. The appropriate parsing method is called based on the extension of the lesson file. Creating a new course authoring format is as simple as writing a new method for `parse_content()` that accepts the content as input and returns a properly structured `lesson` object. 210 | 211 | * `author_lesson()` function creates and opens a customized lesson template for authoring content. 212 | 213 | * Suite of functions for installing (and uninstalling) swirl courses: 214 | * `install_course_directory()`: Install a course from a course directory 215 | * `install_course_dropbox()`: Install a course from a zipped course directory shared on Dropbox 216 | * `install_course_github()`: Install a course from a GitHub repository 217 | * `install_course_google_drive()`: Install a course from a zipped course directory shared on Google Drive 218 | * `install_course_url()`: Install a course from a url that points to a zip file 219 | * `install_course_zip()`: Install a course from a zipped course folder 220 | * `uninstall_course()`: Uninstall a course 221 | * `zip_course()`: Zip a course directory 222 | 223 | * Course authors can add custom tests for student responses. 224 | * Custom tests may be defined in the lesson directory in file named customTests.R. 225 | * Custom tests run in the same environment as tests provided with the package. 226 | 227 | * Revised suite of answer tests (contained in answerTests2.R) using a more natural function call syntax. 228 | 229 | * Revised user progress tracking and restoration. 230 | * Improved tracking by taking environmental "snapshots." 231 | * Keep a list of variables created or modified by correct responses. 232 | * Restore list to global environment after a lesson is suspended and resumed. 233 | 234 | * Message notifying the user when she's completed a lesson, just prior to returning to the main menu. 235 | 236 | * Miscellaneous big fixes 237 | 238 | # swirl 2.0.1 239 | 240 | * Fixed bug related to package dependencies (via imports) 241 | 242 | # swirl 2.0 243 | 244 | * Uses `addTaskCallback()` as a mechanism to capture user input directly from the R prompt. 245 | 246 | * During instruction, `info()` brings up a menu of options including `bye()`, `skip()`, `play()`, and `nxt()`. 247 | 248 | * `skip()` allows the user to skip the current question. swirl automatically evaluates the correct answer in the user's workspace in case future questions depend on the result. 249 | 250 | * Includes a library of answer tests based on [testthat](https://github.com/hadley/testthat), an R package designed by Hadley Wickham for unit testing. 251 | 252 | * Tests user responses for correctness based various combinations of the aforementioned answer tests. A user is judged to have answered a question correctly when the answer tests specified for that question are satisfied. 253 | 254 | * The answer tests operate on the R expression entered by the user, as opposed to the string representation of it (see swirl 1.0). This avoids marking a user incorrect for stylistic discrepancies such as including single spaces between function arguments, etc. 255 | 256 | * Makes heavy use of R's S3 object oriented programming dialect to promote an easily extensible architecture. Incorporating new functionality simply requires writing new methods for existing "core" functions. 257 | 258 | * Instructors can now author content in an R Markdown (.Rmd) file, then use `rmd2csv()` to create the CSV file from which swirl reads content. This is an experimental feature based on syntax employed by [slidify](https://github.com/ramnathv/slidify), an R package designed by Ramnath Vaidyanathan for creating interactive web presentations. -------------------------------------------------------------------------------- /R/actions.R: -------------------------------------------------------------------------------- 1 | do_nxt <- function(e)UseMethod("do_nxt") 2 | do_reset <- function(e)UseMethod("do_rst") 3 | do_submit <- function(e)UseMethod("do_submit") 4 | do_play <- function(e)UseMethod("do_play") 5 | do_main <- function(e)UseMethod("do_main") 6 | do_restart <- function(e)UseMethod("do_restart") 7 | 8 | do_nxt.default <- function(e) { 9 | ## Using the stored list of "official" swirl variables and values, 10 | # assign variables of the same names in the global environment 11 | # their "official" values, in case the user has changed them 12 | # while playing. 13 | if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv()) 14 | swirl_out(s()%N%"Resuming lesson...") 15 | e$playing <- FALSE 16 | e$iptr <- 1 17 | } 18 | 19 | do_reset.default <- function(e) { 20 | e$playing <- FALSE 21 | e$reset <- TRUE 22 | e$iptr <- 2 23 | swirl_out(s()%N%"I just reset the script to its original state. If it doesn't refresh immediately, you may need to click on it.", 24 | skip_after = TRUE) 25 | } 26 | 27 | do_submit.default <- function(e) { 28 | e$playing <- FALSE 29 | # Get contents from user's submitted script 30 | e$script_contents <- readLines(e$script_temp_path, warn = FALSE) 31 | # Save expr to e 32 | e$expr <- try(parse(text = e$script_contents), silent = TRUE) 33 | swirl_out(s()%N%"Sourcing your script...", skip_after = TRUE) 34 | try(source(e$script_temp_path, encoding = "UTF-8")) 35 | } 36 | 37 | do_play.default <- function(e) { 38 | swirl_out(s()%N%"Entering play mode. Experiment as you please, then type nxt() when you are ready to resume the lesson.", skip_after=TRUE) 39 | e$playing <- TRUE 40 | } 41 | 42 | do_main.default <- function(e) { 43 | swirl_out(s()%N%"Returning to the main menu...") 44 | # Remove the current lesson. Progress has been saved already. 45 | if(exists("les", e, inherits=FALSE)){ 46 | rm("les", envir=e, inherits=FALSE) 47 | } 48 | } 49 | 50 | do_restart.default <- function(e) { 51 | swirl_out(s()%N%"This feature is not implemented yet for Swirl.") 52 | } -------------------------------------------------------------------------------- /R/answerTests.R: -------------------------------------------------------------------------------- 1 | # Extensible testing 2 | # 3 | # If tests are to be identified by keyphrases, then keyphrases must somehow be 4 | # converted (i.e., parsed) to function calls. It is reasonable to anticipate 5 | # that new tests will arise with broad deployment and new course material. 6 | # Thus it would be convenient if new tests and keyphrases could be added 7 | # without the need to change core swirl source code. 8 | # 9 | # Tests themselves would be new functions or methods, hence are additional code 10 | # by nature. The problem is to extensibly parse keyphrases to function calls. 11 | # One possibility, illustrated below, is to give new tests themselves 12 | # primary responsibility for parsing their own keyphrases. 13 | # 14 | # The tests themselves are identified by the substrings before the "=". 15 | # Substrings after "=" are essentially arguments. To illustrate a possiblity 16 | # we'll have core code base its function call on the string prior to "=", 17 | # and leave the rest to tests themselves. It is doubtful this scheme would 18 | # be flexible enough in general. 19 | # 20 | # There are various ways to do it, but we'll use S3 methods because we're 21 | # using them for other things as well. We'll give the keyphrase a class 22 | # attribute corresponding to the substring prior to "=", and use the keyphrase 23 | # as first argument to the method. 24 | 25 | 26 | runTest <- function(...)UseMethod("runTest") 27 | 28 | # Always returns FALSE. If the default test in invoked, something is wrong. 29 | runTest.default <- function(...)return(FALSE) 30 | 31 | # Always returns TRUE, for development purposes. 32 | runTest.true <- function(...)return(TRUE) 33 | 34 | # Returns TRUE if e$expr is an assignment 35 | # 36 | runTest.assign <- function(keyphrase, e) { 37 | identical(class(e$expr), "<-") 38 | } 39 | 40 | # Returns TRUE if the function to the right of = in the keyphrase has 41 | # been used in e$expr 42 | # 43 | runTest.useFunc <- function(keyphrase, e) { 44 | func <- rightside(keyphrase) 45 | (is.call(e$expr) || is.expression(e$expr)) && 46 | func %in% flatten(e$expr) 47 | } 48 | 49 | # Returns TRUE if as.character(e$val) matches the string to the right 50 | # of "=" in keyphase 51 | # This is for single word answers 52 | runTest.word <- function(keyphrase, e) { 53 | correctVal <- str_trim(rightside(keyphrase)) 54 | identical(str_trim(as.character(e$val)), 55 | str_trim(as.character(correctVal))) 56 | } 57 | # Returns TRUE if as.character(e$val) matches the string to the right 58 | # of "=" in keyphase 59 | # This is for multi-word answers for which order matters 60 | runTest.word_order <- function(keyphrase, e) { 61 | correctVal <- str_trim(rightside(keyphrase)) 62 | correct_list <- str_trim(unlist(strsplit(correctVal,","))) 63 | userAns <- str_trim(unlist(strsplit(as.character(e$val),","))) 64 | identical(userAns, correct_list) 65 | } 66 | # Returns TRUE if as.character(e$val) matches the string to the right 67 | # of "=" in keyphase 68 | # This is for multi-word answers for which order doesn't matter 69 | runTest.word_many <- function(keyphrase,e){ 70 | correct_ans <- rightside(keyphrase) 71 | correct_list <- str_trim(unlist(strsplit(correct_ans,","))) 72 | identical(sort(correct_list), sort(e$val)) 73 | } 74 | 75 | # Tests if the user has just created one new variable. If so, assigns 76 | # e$newVar its value and returns TRUE. 77 | runTest.newVar <- function(keyphrase, e){ 78 | # TODO: Eventually make auto-detection of new variables an option. 79 | # Currently it can be set in customTests.R 80 | delta <- if(!customTests$AUTO_DETECT_NEWVAR){ 81 | safeEval(e$expr, e) 82 | } else { 83 | e$delta 84 | } 85 | if (length(delta)==1){ 86 | e$newVar <- delta[[1]] 87 | e$newVarName <- names(delta)[1] 88 | e$delta <- mergeLists(delta, e$delta) 89 | return(TRUE) 90 | } 91 | else { 92 | return(FALSE) 93 | } 94 | } 95 | 96 | # Tests if the user has just created one new variable of correct name. If so, 97 | # returns TRUE. 98 | # keyphrase: correctName= 99 | runTest.correctName <- function(keyphrase, e){ 100 | # TODO: Eventually make auto-detection of new variables an option. 101 | # Currently it can be set in customTests.R 102 | delta <- if(!customTests$AUTO_DETECT_NEWVAR){ 103 | safeEval(e$expr, e) 104 | } else { 105 | e$delta 106 | } 107 | correctName <- rightside(keyphrase) 108 | if ((length(delta)==1) && (identical(names(delta)[1],correctName))) { 109 | e$newVar <- delta[[1]] 110 | e$newVarName <- names(delta)[1] 111 | e$delta <- mergeLists(delta, e$delta) 112 | return(TRUE) 113 | } 114 | else { 115 | return(FALSE) 116 | } 117 | } 118 | 119 | # Tests the result of a computation such as mean(newVar) applied 120 | # to a specific variable created in a previous question. 121 | runTest.result <- function(keyphrase, e){ 122 | correct.expr <- parse(text=rightside(keyphrase)) 123 | newVar <- e$newVar 124 | ans <- all.equal(e$val, eval(correct.expr)) 125 | # all.equal may return a diagnostic string 126 | return(ifelse(is.logical(ans), ans, FALSE)) 127 | } 128 | 129 | runTest.exact <- function(keyphrase,e){ 130 | is.correct <- FALSE 131 | if(is.numeric(e$val)){ 132 | correct.ans <- eval(parse(text=rightside(keyphrase))) 133 | epsilon <- 0.01*abs(correct.ans) 134 | is.correct <- abs(e$val-correct.ans) <= epsilon 135 | } 136 | return(is.correct) 137 | } 138 | 139 | runTest.range <- function(keyphrase,e){ 140 | is.correct <- FALSE 141 | correct.ans <-parse(text=rightside(keyphrase)) 142 | if (is.numeric(e$val)){ 143 | correct.ans <- as.character(correct.ans) 144 | temp <- str_split(correct.ans,"-") 145 | temp <- as.numeric(unlist(str_split(correct.ans,"-"))) 146 | # use is.logical in case the user types a non-digit which converts to NA's 147 | is.correct <- (e$val >= temp[1] && e$val <= temp[2]) 148 | } 149 | return(is.correct) 150 | } 151 | 152 | runTest.newcmd <- function(keyphrase,e){ 153 | correct.expr <- parse(text=rightside(keyphrase))[[1]] 154 | correct.ans <- eval(correct.expr) 155 | ansResults <- expectThat(e$val, 156 | equals_legacy(correct.ans,label=correct.ans), 157 | label=e$val) 158 | callResults <- expectThat(as.expression(e$expr)[[1]], 159 | is_identical_to_legacy(correct.expr,label=deparse(correct.expr)), 160 | label=deparse(e$expr)) 161 | 162 | # identical(as.expression(e$expr)[[1]], as.expression(correct.expr)[[1]]) 163 | if(ansResults$passed && callResults$passed){ 164 | return(TRUE) 165 | } else 166 | if (ansResults$passed && !callResults$passed){ 167 | swirl_out("That's not the expression I expected but it works.") 168 | swirl_out(callResults$message) 169 | #todo 170 | #following line is temporary fix to create correct vars for future ques if needed 171 | eval(correct.expr,globalenv()) 172 | return(TRUE) 173 | } 174 | else 175 | return(FALSE) 176 | } 177 | 178 | runTest.swirl1cmd <- function(keyphrase,e){ 179 | correct.expr <- parse(text=rightside(keyphrase)) 180 | correct.ans <- eval(correct.expr) 181 | ans.is.correct <- isTRUE(all.equal(correct.ans, e$val)) 182 | call.is.correct <- identical(as.expression(e$expr)[[1]], as.expression(correct.expr)[[1]]) 183 | if(ans.is.correct && call.is.correct){ 184 | return(TRUE) 185 | } else 186 | if (ans.is.correct && !call.is.correct){ 187 | swirl_out("That's not the expression I expected but it works.") 188 | #following line is temporary fix to create correct vars for future ques if needed 189 | eval(correct.expr,globalenv()) 190 | return(TRUE) 191 | } 192 | else 193 | return(FALSE) 194 | } 195 | 196 | runTest.trick <- function(keyphrase,e){ 197 | if (exists("trick",e,inherits=FALSE)){ 198 | rm("trick",envir=e,inherits=FALSE) 199 | return(TRUE) 200 | } 201 | else{ 202 | e$trick <- 1 203 | return(FALSE) 204 | } 205 | } 206 | 207 | ## TESTS AND KEYPHRASES BASED ON PACKAGE TESTTHAT 208 | # These tests will print diagnostics in "dev" mode 209 | # but not in user (default) mode. 210 | 211 | # Returns TRUE if e$var or (if it exists) the given 212 | # global variable is of the given class 213 | # keyphrase: is_a=class or is_a=class,variable 214 | runTest.is_a <- function(keyphrase, e) { 215 | temp <- strsplit(rightside(keyphrase),",")[[1]] 216 | class <- str_trim(temp[1]) 217 | variable <- str_trim(temp[2]) 218 | if(!is.na(variable) && exists(variable, globalenv())){ 219 | val <- get(variable, globalenv()) 220 | } else { 221 | val <- e$val 222 | } 223 | label <- val 224 | results <- expectThat(val, is_a_legacy(class), label=label) 225 | if(is(e,"dev") && !results$passed)swirl_out(results$message) 226 | return(results$passed) 227 | } 228 | 229 | # Returns TRUE if the function to the right of = in the keyphrase has 230 | # been used in e$expr 231 | # keyphrase: uses_func=functionName 232 | runTest.uses_func <- function(keyphrase, e) { 233 | func <- rightside(keyphrase) 234 | results <- expectThat(e$expr, 235 | uses_func(func, label=func), 236 | label=deparse(e$expr)) 237 | if(is(e,"dev") && !results$passed)swirl_out(results$message) 238 | return(results$passed) 239 | } 240 | 241 | # Returns TRUE if as.character(e$val) matches the string to the right 242 | # of "=" in keyphase 243 | # keyphrase: matches=regularExpresion 244 | runTest.matches <- function(keyphrase, e) { 245 | correctVal <- tolower(str_trim(rightside(keyphrase))) 246 | userVal <- str_trim(as.character(e$val)) 247 | results <- expectThat(tolower(userVal), 248 | matches_legacy(correctVal), 249 | label=userVal) 250 | if(is(e,"dev") && !results$passed)swirl_out(results$message) 251 | return(results$passed) 252 | } 253 | 254 | # Tests if the user has just created one new variable (of correct name 255 | # if given.) If so, returns TRUE. 256 | # keyphrase: creates_var or creates_var=correctName 257 | runTest.creates_var <- function(keyphrase, e){ 258 | # TODO: Eventually make auto-detection of new variables an option. 259 | # Currently it can be set in customTests.R 260 | delta <- if(!customTests$AUTO_DETECT_NEWVAR){ 261 | safeEval(e$expr, e) 262 | } else { 263 | e$delta 264 | } 265 | correctName <- rightside(keyphrase) 266 | if(is.na(correctName)){ 267 | results <- expectThat(length(delta), equals_legacy(1), 268 | label=paste(deparse(e$expr), 269 | "does not create a variable.")) 270 | } else { 271 | results <- expectThat(names(delta), 272 | is_equivalent_to_legacy(correctName, label=correctName), 273 | label=paste(deparse(e$expr), 274 | "does not create a variable named", 275 | correctName)) 276 | } 277 | if(results$passed){ 278 | e$newVar <- e$val 279 | e$newVarName <- names(delta)[1] 280 | e$delta <- mergeLists(delta, e$delta) 281 | } else if(is(e,"dev")){ 282 | swirl_out(results$message) 283 | } 284 | return(results$passed) 285 | } 286 | 287 | # Tests the result of a computation such as mean(newVar) applied 288 | # to a specific variable created in a previous question. 289 | # keyphrase: equals=correctExpression,variable 290 | runTest.equals <- function(keyphrase, e){ 291 | temp <- strsplit(rightside(keyphrase),",")[[1]] 292 | correctExprLabel <- temp[1] 293 | variable <- str_trim(temp[2]) 294 | correctExpr <- gsub(variable, paste0("e$",variable), correctExprLabel) 295 | correctAns <- safeEval(parse(text=correctExpr)) 296 | if(length(correctAns) != 1)return(FALSE) 297 | results <- expectThat(e$var, 298 | equals_legacy(correctAns[[1]], 299 | label=correctExprLabel), 300 | label=deparse(e$expr)) 301 | if(is(e, "dev") && !results$passed)swirl_out(results$message) 302 | return(results$passed) 303 | } 304 | 305 | # Returns TRUE if as.expression 306 | # (e$expr) matches the expression indicated to the right 307 | # of "=" in keyphrase 308 | # keyphrase:equivalent=expression 309 | runTest.equivalent <- function(keyphrase,e) { 310 | correctExpr <- as.list(parse(text=rightside(keyphrase))) 311 | userExpr <- as.list(as.expression(e$expr)) 312 | results <- expectThat(userExpr, 313 | is_equivalent_to_legacy(correctExpr,deparse(correctExpr)), 314 | label=deparse(userExpr)) 315 | 316 | if(is(e,"dev") && !results$passed)swirl_out(results$message) 317 | return(results$passed) 318 | } 319 | 320 | 321 | 322 | # Tests that a value just entered at the R prompt is within 323 | # the given range 324 | # keyphrase: in_range=a,b 325 | runTest.in_range <- function(keyphrase, e){ 326 | range <- try(eval(parse(text=paste0("c(", rightside(keyphrase), ")"))), 327 | silent=TRUE) 328 | if(!is.numeric(range)){ 329 | swirl_out(paste("The given range", rightside(keyphrase), "is not numeric.")) 330 | return(FALSE) 331 | } 332 | results <- expectThat(e$var, 333 | in_range(range, 334 | label=range), 335 | label=e$var) 336 | if(is(e, "dev") && !results$passed)swirl_out(results$message) 337 | return(results$passed) 338 | } 339 | 340 | # Test that the user has entered an expression identical to that 341 | # given in the keyphrase. 342 | # keyphrase: "expr_identical=" 343 | runTest.expr_identical <- function(keyphrase, e){ 344 | correct <- parse(text=rightside(keyphrase))[[1]] 345 | expr <- e$expr 346 | if(is.expression(expr))expr <- expr[[1]] 347 | results <- expectThat(expr, 348 | is_identical_to_legacy(correct, label=rightside(keyphrase)), 349 | label=deparse(expr)) 350 | if( is(e, "dev") && !results$passed)swirl_out(results$message) 351 | return(results$passed) 352 | } 353 | 354 | # Test the the length of e$val is that given in the keyphrase 355 | # keyphrase: "val_length=" 356 | runTest.val_length <- function(keyphrase, e){ 357 | try(n <- as.integer(rightside(keyphrase)), silent=TRUE) 358 | if(is.na(n)){ 359 | stop(message=paste("BUG: right side of", keyphrase, 360 | "is not an integer.")) 361 | } 362 | results <- expectThat(length(e$val), equals_legacy(n, label=n), 363 | label=paste0("length(c(", toString(e$val), "))")) 364 | if( is(e, "dev") && !results$passed)swirl_out(results$message) 365 | return(results$passed) 366 | } 367 | 368 | ### HELPER FUNCTIONS 369 | 370 | rightside <- function(keyphrase){ 371 | n <- str_locate(keyphrase,"=")[1] 372 | return(substr(keyphrase,n+1,nchar(keyphrase))) 373 | } 374 | 375 | 376 | flatten <- function(expr){ 377 | if(is.leaff(expr)){ 378 | return(expr) 379 | } else { 380 | return(unlist(lapply(expr, flatten))) 381 | } 382 | } 383 | 384 | is.leaff <- function(x)!(is.call(x) || is.expression(x)) 385 | 386 | 387 | ### TESTTHAT FUNCTIONS CUSTOMIZED FOR ANSWERTESTS 388 | 389 | findExpr <- function(name, env = parent.frame()){ 390 | subs <- do.call("substitute", list(as.name(name), env)) 391 | str_c(deparse(subs, width.cutoff = 500), collapse = "\n") 392 | } 393 | 394 | expectThat <- function(object, condition, info=NULL, label=NULL){ 395 | if (is.null(label)) { 396 | label <- findExpr("object") 397 | } 398 | results <- swirlExpectation(condition(object)) 399 | results$message <- str_c(label, " ", results$message) 400 | if (!is.null(info)) { 401 | results$message <- str_c(results$message, "\n", info) 402 | } 403 | return(results) 404 | } 405 | 406 | # Patch for slight incompatibility of testthat versions 407 | swirlExpectation <- function(testthat_expectation){ 408 | passed <- testthat_expectation$passed 409 | error <- testthat_expectation$error 410 | if(exists("failure_msg", testthat_expectation)){ 411 | message <- failure_msg <- testthat_expectation$failure_msg 412 | success_msg <- testthat_expectation$success_msg 413 | } else { 414 | failure_msg <- message <- testthat_expectation$message 415 | success_msg <- "unknown" 416 | } 417 | structure( 418 | list( 419 | passed = passed, error = error, message = message, 420 | failure_msg = failure_msg, success_msg = success_msg 421 | ), 422 | class = c("swirl_expectation", "expectation") 423 | ) 424 | } 425 | 426 | 427 | ## CUSTOM EXPECTATIONS FOR ANSWER TESTS 428 | 429 | uses_func <- function(expected, label = NULL, ...){ 430 | if(is.null(label)){ 431 | label <- findExpr("expected") 432 | }else if (!is.character(label) || length(label) != 1) { 433 | label <- deparse(label) 434 | } 435 | function(expr){ 436 | uses <- (is.call(expr) || is.expression(expr)) && 437 | expected %in% flatten(expr) 438 | expectation_legacy(identical(uses, TRUE), 439 | str_c("does not use ", label)) 440 | } 441 | } 442 | 443 | in_range <- function(range, label=NULL){ 444 | range <- sort(range) 445 | function(number){ 446 | isOK <- is.numeric(number) && 447 | isTRUE(number >= range[1]) && 448 | isTRUE(number <= range[2]) 449 | expectation_legacy(identical(isOK, TRUE), 450 | str_c("is not between ", range[1], " and ", range[2])) 451 | } 452 | } 453 | -------------------------------------------------------------------------------- /R/args_specification.R: -------------------------------------------------------------------------------- 1 | args_specification <- function(e, ...)UseMethod("args_specification") 2 | 3 | args_specification.default <- function(e, ...) { 4 | # in normal, interactive mode, do nothing 5 | } 6 | 7 | args_specification.test <- function(e, ...) { 8 | # Capture ... args 9 | targs <- list(...) 10 | # Check if appropriately named args exist 11 | if(is.null(targs$test_course) || is.null(targs$test_lesson)) { 12 | stop(s()%N%"Must specify 'test_course' and 'test_lesson' to run in 'test' mode!") 13 | } else { 14 | # Make available for use in menu functions 15 | e$test_lesson <- targs$test_lesson 16 | e$test_course <- targs$test_course 17 | } 18 | # Check that 'from' is less than 'to' if they are both provided 19 | if(!is.null(targs$from) && !is.null(targs$to)) { 20 | if(targs$from >= targs$to) { 21 | stop(s()%N%"Argument 'to' must be strictly greater than argument 'from'!") 22 | } 23 | } 24 | if(is.null(targs$from)) { 25 | e$test_from <- 1 26 | } else { 27 | e$test_from <- targs$from 28 | } 29 | if(is.null(targs$to)) { 30 | e$test_to <- 999 # Lesson will end naturally before this 31 | } else { 32 | e$test_to <- targs$to 33 | } 34 | } -------------------------------------------------------------------------------- /R/courseraCheck.R: -------------------------------------------------------------------------------- 1 | #' @importFrom stringr str_detect 2 | courseraCheck <- function(e){ 3 | modtype <- attr(e$les, "type") 4 | lesson_name <- gsub(" ", "_", attr(e$les, "lesson_name")) 5 | if(is.null(modtype) || modtype != "Coursera")return() 6 | 7 | # allow use of Coursera partner sites (school.coursera.org) 8 | partner <- attr(e$les, "partner") 9 | partner <- ifelse(is.null(partner), "class", partner) 10 | baseurl <- paste0("http://", partner, ".coursera.org/") 11 | 12 | tt <- c(rep(letters, 3), seq(100)) 13 | swirl_out(s()%N%"Are you currently enrolled in the Coursera course associated with this lesson?") 14 | yn <- select.list(c("Yes","No"), graphics=FALSE) 15 | if(yn=="No")return() 16 | ss <- lapply(1:2, function(i) { 17 | paste0(sample(tt, sample(seq(400), 1), replace=TRUE), collapse="") 18 | }) 19 | swirl_out(s()%N%"Would you like me to notify Coursera that you've completed this lesson?", 20 | "If so, I'll need to get some more info from you.") 21 | choice <- select.list(c("Yes","No","Maybe later"), graphics=FALSE) 22 | if(choice=="No") return() 23 | # Begin submission loop 24 | ok <- FALSE 25 | while(!ok) { 26 | # Get submission credentials 27 | r <- getCreds(e) 28 | email <- r["email"] 29 | passwd <- r["passwd"] 30 | course_name <- r["courseid"] 31 | output <- paste0(ss[[1]], substr(e$coursera, 1, 16), ss[[2]], 32 | collapse="") 33 | # Name output file 34 | output_filename <- paste0(course_name,"_",lesson_name,".txt") 35 | # Write output to text file 36 | writeLines(output, output_filename) 37 | # If going straight to manual submission, then exit loop. 38 | if(choice=="Maybe later") ok <- TRUE 39 | # If doing automatic submission, then give it a try. 40 | if(choice=="Yes"){ 41 | swirl_out(s()%N%"I'll try to tell Coursera you've completed this lesson now.") 42 | challenge.url <- paste(baseurl, course_name, 43 | "assignment/challenge", sep = "/") 44 | submit.url <- paste(baseurl, course_name, 45 | "assignment/submit", sep = "/") 46 | ch <- try(getChallenge(email, challenge.url), silent=TRUE) 47 | # Check if url is valid, i.e. challenge received 48 | ch_ok <- is.list(ch) && exists("ch.key", ch) && !is.na(ch$ch.key) 49 | if(!is(ch, "try-error") && ch_ok) { 50 | ch.resp <- challengeResponse(passwd, ch$ch.key) 51 | # If submit.url is invalid, submitSolution should return a try-error. 52 | # However, that is not the only way it can fail; see below. 53 | results <- submitSolution(email, submit.url, ch.resp, 54 | sid=lesson_name, 55 | output=output, 56 | signature=ch$state) 57 | # If incorrect, empty string will be returned 58 | if(!length(results)) { 59 | swirl_out(s()%N%"You skipped too many questions! You'll need to complete", 60 | s()%N%"this lesson again if you'd like to receive credit. Please", 61 | s()%N%"don't skip more than one question next time.") 62 | return() 63 | } 64 | if(!is(results, "try-error")){ 65 | # TODO: It would be best to detect success here, rather than 66 | # failure, but as of Feb 23 2014, submit.url may not throw 67 | # an error indicating failure but instead return an HTML 68 | # notification beginning with the word, "Exception". 69 | # Here we detect failure by the presence of this word. 70 | # Server-side behavior could easily change and could easily 71 | # be course dependent, so some standard handshake will have 72 | # to be set up eventually. 73 | swirl_out(results) 74 | if(!str_detect(results, "[Ee]xception")){ 75 | swirl_out(paste0(s()%N%"I've notified Coursera that you have completed ", 76 | course_name, ", ", lesson_name,".")) 77 | # Remove manual submission text file 78 | unlink(output_filename) 79 | # Exit loop since submission successful 80 | return() 81 | } 82 | swirl_out(s()%N%"I'm sorry, something went wrong with automatic submission.") 83 | # Exit loop if user doesn't want to retry auto submission 84 | ok <- !retry() 85 | } else { 86 | swirl_out(s()%N%"I'm sorry, something went wrong with automatic submission.") 87 | # Exit loop if user doesn't want to retry auto submission 88 | ok <- !retry() 89 | } 90 | } else { 91 | swirl_out(s()%N%"I'm sorry, something went wrong with establishing connection.") 92 | # Exit loop if user doesn't want to retry auto submission 93 | ok <- !retry() 94 | } 95 | } # end of yes branch 96 | } # end of while loop 97 | swirl_out(s()%N%"To notify Coursera that you have completed this lesson,", 98 | s()%N%"please upload", sQuote(output_filename), 99 | s()%N%"to Coursera manually. You may do so by visiting the Programming", 100 | s()%N%"Assignments page on your course website and selecting the Submit", 101 | s()%N%"button next to the appropriate swirl lesson.", 102 | s()%N%"I've placed the file in the following directory:", 103 | skip_after=TRUE) 104 | message(getwd(), "\n") 105 | readline("...") 106 | } 107 | 108 | # Returns TRUE if user would like to retry, FALSE if not 109 | retry <- function() { 110 | swirl_out(s()%N%"Would you like to retry automatic submission or just submit manually?") 111 | ans <- select.list(c("Retry automatic submission", "Submit manually"), graphics=FALSE) 112 | # Return TRUE if user would like to retry 113 | return(ans == "Retry automatic submission") 114 | } 115 | 116 | get_courseid <- function() { 117 | swirl_out(s()%N%"The first item I need is your Course ID. For example, if the", 118 | s()%N%"homepage for your Coursera course was", 119 | s()%N%"'https://class.coursera.org/rprog-001',", 120 | s()%N%"then your course ID would be 'rprog-001' (without the quotes).", 121 | skip_after=TRUE) 122 | repeat { 123 | courseid <- readline("Course ID: ") 124 | # Remove quotes if there are any 125 | courseid <- gsub("\'|\"", "", courseid) 126 | # Set up test cases 127 | is_url <- str_detect(courseid, "www[.]|http:|https:") 128 | is_numbers <- str_detect(courseid, "^[0-9]+$") 129 | is_example <- str_detect(courseid, fixed("rprog-001")) 130 | 131 | # Check if courseid is none of the bad things 132 | if(!any(is_url, is_numbers, is_example)){ 133 | break 134 | # courseid is one of the bad things 135 | } else { 136 | # Check if courseid is a url 137 | if(is_url) { 138 | swirl_out(s()%N%"It looks like you entered a web address, which is not what I'm", 139 | s()%N%"looking for.") 140 | } 141 | # Check if courseid is all numbers 142 | if(is_numbers) { 143 | swirl_out(s()%N%"It looks like you entered a numeric ID, which is not what I'm", 144 | s()%N%"looking for.") 145 | } 146 | # Check if the user stole the example courseid 147 | if(is_example) { 148 | swirl_out(s()%N%"It looks like you entered the Course ID that I used as an", 149 | s()%N%"example, which is not what I'm looking for.") 150 | } 151 | } 152 | swirl_out(s()%N%"Instead, I need your Course ID, which is the last", 153 | s()%N%"part of the web address for your Coursera course.", 154 | s()%N%"For example, if the homepage for your Coursera course was", 155 | s()%N%"'https://class.coursera.org/rprog-001',", 156 | s()%N%"then your course ID would be 'rprog-001' (without the quotes).", 157 | skip_after=TRUE) 158 | } 159 | courseid 160 | } 161 | 162 | getCreds <- function(e) { 163 | cn <- make_pathname(attr(e$les, "course_name")) 164 | credfile <- file.path(e$udat, paste0(cn, ".txt")) 165 | e$coursera <- digest(paste0("complete", paste0( 166 | rep("_", ifelse(is.null(e$skips), 0, e$skips)), collapse="")), 167 | algo="sha1", serialize = FALSE) 168 | 169 | confirmed <- FALSE 170 | need2fix <- FALSE 171 | while(!confirmed) { 172 | if(!file.exists(credfile) || need2fix) { 173 | courseid <- get_courseid() 174 | email <- readline("Submission login (email): ") 175 | passwd <- readline("Submission password: ") 176 | writeLines(c(courseid, email, passwd), credfile) 177 | r <- c(courseid = courseid, email = email, passwd = passwd) 178 | } else { 179 | r <- readLines(credfile, warn=FALSE) 180 | names(r) <- c("courseid", "email", "passwd") 181 | } 182 | swirl_out(s()%N%"Is the following information correct?", skip_after=TRUE) 183 | message("Course ID: ", r['courseid'], 184 | "\nSubmission login (email): ", r['email'], 185 | "\nSubmission password: ", r['passwd']) 186 | yn <- c("Yes, go ahead!", 187 | "No, I need to change something.") 188 | confirmed <- identical(select.list(yn, graphics=FALSE), yn[1]) 189 | if(!confirmed) need2fix <- TRUE 190 | } 191 | return(r) 192 | } 193 | 194 | #' @importFrom RCurl getForm 195 | getChallenge <- function(email, challenge.url) { 196 | params <- list(email_address = email, response_encoding = "delim") 197 | result <- getForm(challenge.url, .params = params) 198 | s <- strsplit(result, "|", fixed = TRUE)[[1]] 199 | list(ch.key = s[5], state = s[7]) 200 | } 201 | 202 | #' @importFrom digest digest 203 | challengeResponse <- function(password, ch.key) { 204 | x <- paste(ch.key, password, sep = "") 205 | digest(x, algo = "sha1", serialize = FALSE) 206 | } 207 | 208 | #' @importFrom RCurl postForm base64 209 | submitSolution <- function(email, submit.url, ch.resp, sid, output, 210 | signature, src = "",http.version = NULL) { 211 | output <- as.character(base64(output)) 212 | src <- as.character(base64(src)) 213 | params <- list(assignment_part_sid = sid, 214 | email_address = email, 215 | submission = output, 216 | submission_aux = src, 217 | challenge_response = ch.resp, 218 | state = signature) 219 | params <- lapply(params, URLencode) 220 | result <- try(postForm(submit.url, .params = params), silent=TRUE) 221 | if(is(result,"try-error")){ 222 | return(result) 223 | } else { 224 | s <- strsplit(result, "\\r\\n")[[1]] 225 | return(tail(s, 1)) 226 | } 227 | } -------------------------------------------------------------------------------- /R/email_info.R: -------------------------------------------------------------------------------- 1 | #' Send diagnostic email to swirl admin 2 | #' 3 | #' Typing \code{email_admin()} at the prompt will attempt to open 4 | #' a new email in your default browser or email client. The email 5 | #' will include space for you to describe the problem you are 6 | #' experiencing. It will also have the output from \code{sessionInfo}, 7 | #' which you should not alter. 8 | #' 9 | #' @export 10 | email_admin <- function() { 11 | # Get session info and swirl package version 12 | si <- capture.output(sessionInfo()) 13 | pv <- packageVersion('swirl') 14 | 15 | # Set up email elements address, subject, and body 16 | address <- 'info@swirlstats.com' 17 | subject <- paste('Need help: swirl', pv) 18 | body <- paste('Brief description of problem: \n\n', 19 | paste(rep('#', 15), collapse = ''), 20 | paste(si, collapse = '\n'), 21 | sep = '\n\n') 22 | 23 | # Send email 24 | email(address, subject, body) 25 | 26 | invisible() 27 | } 28 | 29 | # email() and email_browser() were copied directly from Hadley 30 | # Wickham's devtools package. 31 | 32 | # http://tools.ietf.org/html/rfc2368 33 | email <- function(address, subject, body) { 34 | url <- paste( 35 | "mailto:", 36 | URLencode(address), 37 | "?subject=", URLencode(subject), 38 | "&body=", URLencode(body), 39 | sep = "" 40 | ) 41 | 42 | tryCatch({ 43 | browseURL(url, browser = email_browser())}, 44 | error = function(e) { 45 | message("Sending failed with error: ", e$message) 46 | cat("To: ", address, "\n", sep = "") 47 | cat("Subject: ", subject, "\n", sep = "") 48 | cat("\n") 49 | cat(body, "\n", sep = "") 50 | } 51 | ) 52 | 53 | invisible(TRUE) 54 | } 55 | 56 | email_browser <- function() { 57 | if (!identical(.Platform$GUI, "RStudio")) 58 | return (getOption("browser")) 59 | 60 | # Use default browser, even if RStudio running 61 | if (.Platform$OS.type == "windows") 62 | return (NULL) 63 | 64 | browser <- Sys.which(c("xdg-open", "open")) 65 | browser[nchar(browser) > 0][[1]] 66 | } 67 | -------------------------------------------------------------------------------- /R/global.R: -------------------------------------------------------------------------------- 1 | utils::globalVariables(c("URLencode", "browseURL", "capture.output", 2 | "file.edit", "getS3method", "head", "install.packages", 3 | "packageVersion", "read.csv", "select.list", "sessionInfo", 4 | "setTxtProgressBar", "tail", "txtProgressBar", "unzip", 5 | "zip")) -------------------------------------------------------------------------------- /R/install_course.R: -------------------------------------------------------------------------------- 1 | #' Installing Courses 2 | #' 3 | #' swirl is designed so that anyone can create interactive content 4 | #' and share it with the world or with just a few people. Users can 5 | #' install courses from a variety of sources using the 6 | #' functions listed here. Each of these functions has its own help 7 | #' file, which you can consult for more details. 8 | #' 9 | #' If you're just getting started, we recommend using 10 | #' \code{\link{install_course}} to install courses 11 | #' from our official \href{https://github.com/swirldev/swirl_courses}{course repository}. Otherwise, check out the 12 | #' help file for the relevant install function below. 13 | #' 14 | #' You can uninstall a course from swirl at any time with 15 | #' \code{\link{uninstall_course}}. 16 | #' 17 | #' Uninstall all courses with 18 | #' \code{\link{uninstall_all_courses}}. 19 | #' 20 | #' @name InstallCourses 21 | #' @family InstallCourses 22 | NULL 23 | 24 | #' Install a course from The swirl Course Network or install a course from a 25 | #' local .swc file. 26 | #' 27 | #' @description 28 | #' Version 2.4 of swirl introduces a new, simple, and fast way of installing 29 | #' courses in the form of \code{.swc} files. This function allows a user to grab 30 | #' a \code{.swc} file from The swirl Course Network which is maintained by Team 31 | #' swirl, or the user can use this function to install a local \code{.swc} file. 32 | #' When using this function please only provide an argument for either 33 | #' \code{course_name} or \code{swc_path}, never both. 34 | #' 35 | #' @param course_name The name of the course you wish to install. 36 | #' @param swc_path The path to a local \code{.swc} file. By default this 37 | #' argument defaults to \code{file.choose()} so the user can select the file using 38 | #' their mouse. 39 | #' @param force Should course installation be forced? The 40 | #' default value is \code{FALSE}. 41 | #' @importFrom httr GET progress content 42 | #' @export 43 | #' @family InstallCourses 44 | #' @examples 45 | #' \dontrun{ 46 | #' 47 | #' # Install the latest version of Team swirl's R Programming course. 48 | #' install_course("R Programming") 49 | #' 50 | #' # Install a local .swc file by using your mouse and keyboard to select the 51 | #' # file. 52 | #' install_course() 53 | #' 54 | #' # Install a .swc file from a specific path. 55 | #' install_course(swc_path = file.path("~", "Downloads", "R_Programming.swc")) 56 | #' 57 | #' } 58 | install_course <- function(course_name = NULL, swc_path = NULL, force = FALSE){ 59 | if(is.null(course_name) && is.null(swc_path)){ 60 | swc_path <- file.choose() 61 | } 62 | 63 | if(!is.null(course_name) && !is.null(swc_path)){ 64 | stop(s()%N%"Please specify a value for either course_name or swc_path but not both.") 65 | } else if(!is.null(swc_path)){ 66 | unpack_course(swc_path, swirl_courses_dir()) 67 | } else { # install from swirl course network 68 | course_name <- make_pathname(course_name) 69 | url <- paste0("http://swirlstats.com/scn/", course_name, ".swc") 70 | 71 | # Send GET request 72 | response <- suppressWarnings(GET(url, progress())) 73 | 74 | if(response$status_code != 200){ 75 | swirl_out(s()%N%"It looks like your internet connection is not working.", 76 | s()%N%"Go to http://swirlstats.com/scn/ and download the .swc file that corresponds to the course you wish to install.", 77 | s()%N%"After downloading the .swc run install_course() and choose the file you downloaded.") 78 | stop(s()%N%"Could not connect to course file.") 79 | } 80 | 81 | temp_swc <- tempfile() 82 | writeBin(content(response, "raw"), temp_swc) 83 | unpack_course(temp_swc, swirl_courses_dir(), force = force) 84 | } 85 | } 86 | 87 | #' Install a course from the official course repository 88 | #' 89 | #' @description 90 | #' We are currently maintaining a central repository of contributed 91 | #' swirl courses at \url{https://github.com/swirldev/swirl_courses}. 92 | #' This function provides the easiest method of installing a course 93 | #' form the repository. 94 | #' 95 | #' We have another repository at 96 | #' \url{https://github.com/swirldev/swirl_misc}, where we keep 97 | #' experimental features and content. The \code{dev} argument allows 98 | #' you to access this repository. Content in the swirl_misc repository 99 | #' is not guaranteed to work. 100 | #' 101 | #' The central repository of swirl courses is mirrored at 102 | #' \url{https://bitbucket.org/swirldevmirror/swirl_courses}. If you cannot 103 | #' access GitHub you can download swirl courses from bitbucket by using the 104 | #' \code{mirror = "bitbucket"} option (see below). 105 | #' 106 | #' @param course_name The name of the course you wish to install. 107 | #' @param dev Set to \code{TRUE} to install a course in development from the swirl_misc repository. 108 | #' @param mirror Select swirl course repository mirror. Valid arguments are \code{"github"} and \code{"bitbucket"}. 109 | #' @export 110 | #' @importFrom httr GET content progress 111 | #' @examples 112 | #' \dontrun{ 113 | #' 114 | #' install_from_swirl("R_Programming") # Directory name 115 | #' 116 | #' ### OR ### 117 | #' 118 | #' install_from_swirl("R Programming") # Course name 119 | #' 120 | #' # To install a course in development from the swirl_misc repository 121 | #' install_from_swirl("Including Data", dev = TRUE) 122 | #' 123 | #' # To install a course from the Bitbucket mirror 124 | #' install_from_swirl("R Programming", mirror = "bitbucket") 125 | #' } 126 | #' @family InstallCourses 127 | install_from_swirl <- function(course_name, dev = FALSE, mirror = "github"){ 128 | # Validate arguments 129 | if(!is.character(course_name)) { 130 | stop(s()%N%"Argument 'course_name' must be surrounded by quotes (i.e. a character string)!") 131 | } 132 | if(!is.logical(dev)) { 133 | stop(s()%N%"Argument 'dev' must be either TRUE or FALSE!") 134 | } 135 | if(!(mirror == "github" || mirror == "bitbucket")){ 136 | stop(s()%N%"Please enter a valid name for a mirror. ('github' or 'bitbucket')") 137 | } 138 | 139 | # make pathname from course_name 140 | course_name <- make_pathname(course_name) 141 | 142 | # Construct url to the appropriate zip file 143 | if(dev) { 144 | if(mirror != "github"){ 145 | stop(s()%N%"To access swirl courses in development on Bitbucket go to https://bitbucket.org/swirldevmirror/swirl_misc") 146 | } 147 | url <- "http://github.com/swirldev/swirl_misc/zipball/master" 148 | } else { 149 | if(mirror == "bitbucket"){ 150 | url <- "https://bitbucket.org/swirldevmirror/swirl_courses/get/HEAD.zip" 151 | } else { 152 | url <- "http://github.com/swirldev/swirl_courses/zipball/master" 153 | } 154 | } 155 | 156 | # Send GET request 157 | response <- GET(url, progress()) 158 | 159 | # Construct path to Courses 160 | path <- file.path(swirl_courses_dir(), "temp.zip") 161 | 162 | # Write the response as a zip 163 | writeBin(content(response, "raw"), path) 164 | 165 | # Find list of files not in top level directory 166 | file_names <- unzip(path, list=TRUE)$Name 167 | 168 | # Filter list 169 | unzip_list <- Filter(function(x) 170 | {grepl(paste0("/", course_name, "/"), x)}, 171 | file_names 172 | ) 173 | 174 | # Check if course exists 175 | if(length(unzip_list) == 0) { 176 | stop(paste0(s()%N%"Course '", course_name, s()%N%"' not found in course repository! ", 177 | s()%N%"Make sure you've got the name exactly right, then try again.")) 178 | } 179 | 180 | # Extract 181 | unzip(path, exdir=swirl_courses_dir(), files=unzip_list) 182 | 183 | # Copy files from unzipped directory into Courses 184 | top_dir <- file.path(swirl_courses_dir(), sort(dirname(unzip_list))[1]) 185 | dirs_to_copy <- list.files(top_dir, full.names=TRUE) 186 | if(file.copy(dirs_to_copy, swirl_courses_dir(), recursive=TRUE)){ 187 | swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) 188 | } else { 189 | swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) 190 | } 191 | 192 | # Delete unzipped directory 193 | unlink(top_dir, recursive=TRUE, force=TRUE) 194 | 195 | # If __MACOSX exists, delete it. 196 | unlink(file.path(swirl_courses_dir(), "__MACOSX"), recursive=TRUE, force=TRUE) 197 | 198 | # Delete temp.zip 199 | unlink(path, force=TRUE) 200 | 201 | invisible() 202 | } 203 | 204 | 205 | #' Zip a course directory 206 | #' 207 | #' \strong{Warning:} This function will be deprecated after swirl version 2.4. 208 | #' 209 | #' @param path Path to the course directory to be zipped. 210 | #' @param dest Path to directory in which the \code{.zip} should be saved. The 211 | #' default value is \code{NULL}, which will cause the \code{.zip} to be 212 | #' created one level above the directory specified in \code{path}. 213 | #' @export 214 | #' @examples 215 | #' \dontrun{ 216 | #' 217 | #' zip_course("~/Desktop/LOESS_Modeling") 218 | #' zip_course("~/Desktop/SNA_Tutorial", "~/tutorials") 219 | #' } 220 | #' @family InstallCourses 221 | zip_course <- function(path, dest=NULL){ 222 | .Deprecated("swirlify::pack_course") 223 | # Cleanse the path of the trailing slash 224 | path <- sub("/$", "", path) 225 | 226 | # Get highest directory if necessary 227 | if(is.null(dest)){ 228 | dest <- sub(basename(path), "", path) 229 | } 230 | 231 | # Cleanse dest of the trailing slash 232 | dest <- sub("/$", "", dest) 233 | 234 | # Push current directory 235 | curr_dir <- getwd() 236 | 237 | # Create directory in which to zip 238 | zip_dir <- paste0(dest, "/", "swirl_zip_creator_TEMP") 239 | dir.create(zip_dir) 240 | if(file.copy(path, zip_dir, recursive=TRUE)){ 241 | swirl_out("Course directory was successfully zipped!", skip_after=TRUE) 242 | } else { 243 | swirl_out("Course installation failed.", skip_after=TRUE) 244 | } 245 | 246 | # Change directory to folder to be zipped 247 | setwd(zip_dir) 248 | 249 | # Zip-A-Dee-Doo-Dah 250 | zip(paste0(dest, "/", basename(path), ".zip"), 251 | list.files(getwd(), recursive=TRUE)) 252 | 253 | # Delete temporary directory 254 | unlink(zip_dir, recursive=TRUE, force=TRUE) 255 | 256 | # Pop the old directory 257 | setwd(curr_dir) 258 | 259 | invisible() 260 | } 261 | 262 | #' Uninstall a course 263 | #' 264 | #' @param course_name Name of course to be uninstalled 265 | #' @export 266 | #' @examples 267 | #' \dontrun{ 268 | #' 269 | #' uninstall_course("Linear Regression") 270 | #' } 271 | #' @family InstallCourses 272 | uninstall_course <- function(course_name){ 273 | path <- file.path(swirl_courses_dir(), make_pathname(course_name)) 274 | if(file.exists(path)){ 275 | unlink(path, recursive=TRUE, force=TRUE) 276 | message(s()%N%"Course uninstalled successfully!") 277 | } else { 278 | stop(s()%N%"Course not found!") 279 | } 280 | invisible() 281 | } 282 | 283 | #' Uninstall all courses 284 | #' 285 | #' @param force If \code{TRUE} the user will not be asked if they're sure they 286 | #' want to delete the contents of the directory where courses are stored. The 287 | #' default value is \code{FALSE} 288 | #' @export 289 | #' @examples 290 | #' \dontrun{ 291 | #' 292 | #' uninstall_all_courses() 293 | #' } 294 | #' @family InstallCourses 295 | uninstall_all_courses <- function(force = FALSE){ 296 | path <- swirl_courses_dir() 297 | yaml_exists <- file.exists(file.path(path, "suggested_courses.yaml")) 298 | if(yaml_exists){ 299 | temp_file <- tempfile() 300 | file.copy(file.path(path, "suggested_courses.yaml"), temp_file) 301 | } 302 | if(file.exists(path)){ 303 | if(!force){ 304 | swirl_out(s()%N%"Are you sure you want to uninstall all swirl courses?", 305 | s()%N%"This will delete all of the contents of your swirl course directory.") 306 | selection <- select.list(c(s()%N%"Yes", s()%N%"No")) 307 | if(selection == s()%N%"Yes"){ 308 | unlink(path, recursive=TRUE, force=TRUE) 309 | message(s()%N%"All courses uninstalled successfully!") 310 | } else { 311 | message("No courses were uninstalled.") 312 | return() 313 | } 314 | } else { 315 | unlink(path, recursive=TRUE, force=TRUE) 316 | message(s()%N%"All courses uninstalled successfully!") 317 | } 318 | } else { 319 | stop(s()%N%"No courses found!") 320 | } 321 | 322 | dir.create(path, showWarnings = FALSE) 323 | 324 | if(yaml_exists){ 325 | file.copy(temp_file, path) 326 | file.rename(list.files(path, full.names = TRUE), file.path(path, "suggested_courses.yaml")) 327 | } 328 | 329 | invisible() 330 | } 331 | 332 | #' Install a course from a zipped course folder 333 | #' 334 | #' @param path The path to the zipped course. 335 | #' @param multi Set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}. 336 | #' @param which_course A vector of course names. Only for use when zip file contains multiple courses, but you don't want to install all of them. 337 | #' @export 338 | #' @examples 339 | #' \dontrun{ 340 | #' 341 | #' install_course_zip("~/Desktop/my_course.zip") 342 | #' 343 | #' install_course_zip("~/Downloads/swirl_courses-master.zip", multi=TRUE, 344 | #' which_course=c("R Programming", "Data Analysis")) 345 | #' } 346 | #' @family InstallCourses 347 | install_course_zip <- function(path, multi=FALSE, which_course=NULL){ 348 | if(!is.logical(multi) || is.na(multi)) { 349 | stop(s()%N%"Argument 'multi' must be either TRUE or FALSE.") 350 | } 351 | if(!multi && !is.null(which_course)) { 352 | stop(s()%N%"Argument 'which_course' should only be specified when argument 'multi' is TRUE.") 353 | } 354 | if(multi){ 355 | # Find list of files not in top level directory 356 | file_names <- unzip(path, list=TRUE)$Name 357 | 358 | # Filter list and extract 359 | unzip_list <- Filter(function(x){grepl("/.+/", x)}, file_names) 360 | unzip(path, exdir = swirl_courses_dir(), files=unzip_list) 361 | 362 | # Copy files from unzipped directory into Courses 363 | top_dir <- file.path(swirl_courses_dir(), sort(dirname(unzip_list))[1]) 364 | dirs_to_copy <- list.files(top_dir, full.names=TRUE) 365 | # Subset desired courses if specified with which_courses arg 366 | if(!is.null(which_course)) { 367 | match_ind <- match(make_pathname(which_course), basename(dirs_to_copy), 368 | nomatch=-1) 369 | nomatch <- match_ind < 0 370 | if(any(nomatch)) { 371 | stop(s()%N%"Course ", sQuote(which_course[nomatch][1]), s()%N%" not in specified directory. Be careful, course names are case sensitive!") 372 | } 373 | dirs_to_copy <- dirs_to_copy[match_ind] 374 | } 375 | if(file.copy(dirs_to_copy, swirl_courses_dir(), recursive=TRUE)){ 376 | swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) 377 | } else { 378 | swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) 379 | } 380 | 381 | # Delete unzipped directory 382 | unlink(top_dir, recursive=TRUE, force=TRUE) 383 | 384 | } else { 385 | # Unzip file into courses 386 | file_list <- unzip(path, exdir = swirl_courses_dir()) 387 | } 388 | 389 | # If __MACOSX exists, delete it. 390 | unlink(file.path(swirl_courses_dir(), "__MACOSX"), recursive=TRUE, force=TRUE) 391 | 392 | invisible() 393 | } 394 | 395 | #' Install a course from a course directory 396 | #' 397 | #' @param path The path to the course directory. 398 | #' @export 399 | #' @examples 400 | #' \dontrun{ 401 | #' 402 | #' install_course_directory("~/Desktop/my_course") 403 | #' } 404 | #' @family InstallCourses 405 | install_course_directory <- function(path){ 406 | # Check for size of directory to prevent copying a huge directory into swirl/Courses 407 | garbage_result <- tryCatch( 408 | {setTimeLimit(elapsed=1); list.files(path, recursive=TRUE)}, 409 | finally = {setTimeLimit(elapsed=Inf)} 410 | ) 411 | 412 | # Check to make sure there are fewer than 1000 files in course directory 413 | if(length(garbage_result) > 1000){ 414 | stop(s()%N%"Course directory is too large to install") 415 | } 416 | 417 | # Copy files 418 | if(file.copy(path, swirl_courses_dir(), recursive=TRUE)){ 419 | swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) 420 | } else { 421 | swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) 422 | } 423 | 424 | invisible() 425 | } 426 | 427 | #' Install a course from a GitHub repository 428 | #' 429 | #' @param github_username The username that owns the course repository. 430 | #' @param course_name The name of the repository which should be the name of the course. 431 | #' @param branch The branch of the repository containing the course. The default branch is \code{"master"}. 432 | #' @param multi The user should set to \code{TRUE} if the repository contains multiple courses. The default value is \code{FALSE}. 433 | #' @export 434 | #' @examples 435 | #' \dontrun{ 436 | #' 437 | #' install_course_github("bcaffo", "Linear_Regression") 438 | #' install_course_github("jtleek", "Twitter_Map", "geojson") 439 | #' } 440 | #' @family InstallCourses 441 | install_course_github <- function(github_username, course_name, 442 | branch="master", multi=FALSE){ 443 | 444 | # Construct url to the zip file 445 | zip_url <- paste0("http://github.com/", github_username, "/", 446 | course_name,"/zipball/", branch) 447 | 448 | install_course_url(zip_url, multi=multi) 449 | } 450 | 451 | #' Install a course from a zipped course directory shared on Dropbox 452 | #' 453 | #' @param url URL of the shared file 454 | #' @param multi The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}. 455 | #' @export 456 | #' @examples 457 | #' \dontrun{ 458 | #' 459 | #' install_course_dropbox("https://www.dropbox.com/s/xttkmuvu7hh72vu/my_course.zip") 460 | #' } 461 | #' @family InstallCourses 462 | install_course_dropbox <- function(url, multi=FALSE){ 463 | # Construct url to the zip file 464 | zip_url <- paste0(sub("www.dropbox", "dl.dropboxusercontent", url), "?dl=1") 465 | 466 | install_course_url(zip_url, multi=multi) 467 | } 468 | 469 | #' Install a course from a zipped course directory shared on Google Drive 470 | #' 471 | #' @param url URL of the shared file 472 | #' @param multi The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}. 473 | #' @export 474 | #' @examples 475 | #' \dontrun{ 476 | #' 477 | #' install_course_google_drive("https://drive.google.com/file/d/F3fveiu873hfjZZj/edit?usp=sharing") 478 | #' } 479 | #' @family InstallCourses 480 | install_course_google_drive <- function(url, multi=FALSE){ 481 | # Construct url to the zip file 482 | zip_url <- sub("file/d/", "uc?export=download&id=", 483 | sub("/edit\\?usp=sharing", "", url)) 484 | 485 | install_course_url(zip_url, multi=multi) 486 | } 487 | 488 | #' Install a course from a url that points to a zip file 489 | #' 490 | #' @param url URL that points to a zipped course directory 491 | #' @param multi The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}. 492 | #' @export 493 | #' @importFrom httr GET content progress 494 | #' @importFrom stringr str_extract 495 | #' @examples 496 | #' \dontrun{ 497 | #' 498 | #' install_course_url("http://www.biostat.jhsph.edu/~rpeng/File_Hash_Course.zip") 499 | #' } 500 | #' @family InstallCourses 501 | install_course_url <- function(url, multi=FALSE){ 502 | # Send GET request 503 | response <- GET(url, progress()) 504 | 505 | # Construct path to Courses 506 | path <- file.path(swirl_courses_dir(), "temp.zip") 507 | 508 | # Write the response as a zip 509 | writeBin(content(response, "raw"), path) 510 | 511 | # Unzip downloaded file 512 | install_course_zip(path, multi=multi) 513 | 514 | # Clean up GitHub directory name 515 | if(grepl("github.com", url) && !multi){ 516 | # Get paths of every file in zip that will be extracted 517 | file_names <- dirname(unzip(path, list = TRUE)$Name) 518 | 519 | # Find subset of those names which is not equal to root, then get the shortest string from that subset 520 | old_name <- head( sort( file_names[which(file_names != ".")] ) , 1) 521 | 522 | # Extract course name 523 | course_name <- sub("/zipball", "", 524 | str_extract(url, "[^/]+/{1}zipball") ) 525 | 526 | # Rename unzipped directory 527 | file.rename(file.path(swirl_courses_dir(), old_name), 528 | file.path(swirl_courses_dir(), course_name)) 529 | } 530 | 531 | # Delete downloaded zip 532 | unlink(path, force=TRUE) 533 | 534 | invisible() 535 | } 536 | 537 | unpack_course <- function(file_path, export_path, force = FALSE){ 538 | # Remove trailing slash 539 | export_path <- sub(paste0(.Platform$file.sep, "$"), replacement = "", export_path) 540 | 541 | pack <- readRDS(file_path) 542 | course_path <- file.path(export_path, pack$name) 543 | if(!force && file.exists(course_path) && interactive()){ 544 | response <- "" 545 | while(response != "Y"){ 546 | response <- select.list(c("Y", "n"), title = paste("\n\n", course_path, "already exists.\nAre you sure you want to overwrite it? [Y/n]")) 547 | if(response == "n") return(invisible(course_path)) 548 | } 549 | } 550 | dir.create(course_path, showWarnings = FALSE) 551 | for(i in 1:length(pack$files)){ 552 | 553 | # Make file's ultimate path 554 | if(length(pack$files[[i]]$path) >= 2){ 555 | lesson_file_path <- Reduce(function(x, y){file.path(x, y)}, pack$files[[i]]$path[2:length(pack$files[[i]]$path)], pack$files[[i]]$path[1]) 556 | } else { 557 | lesson_file_path <- pack$files[[i]]$path 558 | } 559 | file_path <- file.path(course_path, lesson_file_path) 560 | 561 | # If the directory the file needs to be in does not exist, create the dir 562 | if(!file.exists(dirname(file_path))){ 563 | dir.create(dirname(file_path), showWarnings = FALSE, recursive = TRUE) 564 | } 565 | 566 | writeBin(pack$files[[i]]$raw_file, file_path, endian = pack$files[[i]]$endian) 567 | } 568 | swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) 569 | invisible(course_path) 570 | } 571 | -------------------------------------------------------------------------------- /R/instructionSet.R: -------------------------------------------------------------------------------- 1 | # Instruction set for swirl.R's "virtual machine". 2 | 3 | # All classes first Output, all in the same way, hence one method 4 | # suffices. 5 | # 6 | present <- function(current.row, e)UseMethod("present") 7 | 8 | present.default <- function(current.row, e){ 9 | # Present output to user 10 | post_exercise(e, current.row) 11 | # Initialize attempts counter, if necessary 12 | if(!exists("attempts", e)) e$attempts <- 1 13 | # Increment pointer 14 | e$iptr <- 1 + e$iptr 15 | } 16 | 17 | # All classes then wait for user response, in different ways, hence 18 | # different methods are required. Text and video are both finished 19 | # at this point. 20 | 21 | waitUser <- function(current.row, e)UseMethod("waitUser") 22 | 23 | waitUser.default <- function(current.row, e){ 24 | readline("...") 25 | e$row <- 1 + e$row 26 | e$iptr <- 1 27 | } 28 | 29 | waitUser.text_question <- function(current.row, e){ 30 | e$val <- str_trim(unlist(strsplit(readline("ANSWER: "),","))) 31 | e$iptr <- 1 + e$iptr 32 | } 33 | 34 | waitUser.text_many_question <- function(current.row, e){ 35 | e$val <- str_trim(unlist(strsplit(readline("ANSWER: "),","))) 36 | e$iptr <- 1 + e$iptr 37 | } 38 | 39 | waitUser.text_order_question <- function(current.row, e){ 40 | e$val <- str_trim(unlist(strsplit(readline("ANSWER: "),","))) 41 | e$iptr <- 1 + e$iptr 42 | } 43 | 44 | 45 | waitUser.video <- function(current.row, e){ 46 | response <- readline("Yes or No? ") 47 | if(tolower(response) %in% c("y", "yes")){ 48 | swirl_out(s()%N%"Type nxt() to continue") 49 | e$prompt <- TRUE 50 | e$playing <- TRUE 51 | browseURL(current.row[,"VideoLink"]) 52 | } 53 | e$row <- 1 + e$row 54 | e$iptr <- 1 55 | } 56 | 57 | waitUser.figure <- function(current.row, e){ 58 | fp <- file.path(e$path, current.row[,"Figure"]) 59 | local({ 60 | source(fp,local=TRUE) 61 | xfer(environment(), globalenv()) 62 | temp <- as.list(environment()) 63 | e$snapshot <- c(e$snapshot, temp) 64 | }) 65 | readline("...") 66 | e$row <- 1 + e$row 67 | e$iptr <- 1 68 | } 69 | 70 | 71 | waitUser.mult_question <- function(current.row, e){ 72 | # Use strsplit with split=";" to separate the choices 73 | # Use select.list to get the user's choice. 74 | choices <- strsplit(current.row[,"AnswerChoices"],";") 75 | # Strsplit returns a list but we want only its first element, 76 | # a vector of choices. Use str_trim (pkg stringr) to remove 77 | # leading and trailing white space from the choices. 78 | choices <- str_trim(choices[[1]]) 79 | # Store the choice in e$val for testing 80 | e$val <- post_mult_question(e, choices) 81 | 82 | e$iptr <- 1 + e$iptr 83 | } 84 | 85 | 86 | waitUser.exact_question <- function(current.row, e){ 87 | # Indicate a return to the prompt is necessary. 88 | e$prompt <- TRUE 89 | e$iptr <- 1 + e$iptr 90 | } 91 | 92 | waitUser.range_question <- function(current.row, e){ 93 | # Indicate a return to the prompt is necessary. 94 | e$prompt <- TRUE 95 | e$iptr <- 1 + e$iptr 96 | } 97 | 98 | waitUser.cmd_question <- function(current.row, e){ 99 | # Indicate a return to the prompt is necessary. 100 | e$prompt <- TRUE 101 | e$iptr <- 1 + e$iptr 102 | } 103 | 104 | #' @importFrom tools file_path_sans_ext 105 | waitUser.script <- function(current.row, e){ 106 | # If this is the first attempt or the user wants to start over, 107 | # then create temp files so nothing gets overwritten 108 | if(e$attempts == 1 || isTRUE(e$reset)) { 109 | # Get original script name 110 | orig_script_name <- current.row[,"Script"] 111 | # Get file path of original script 112 | orig_script_path <- file.path(e$path, "scripts", orig_script_name) 113 | # Path temp copy of original script 114 | e$script_temp_path <- file.path(tempdir(), orig_script_name) 115 | 116 | # Original correct script name 117 | correct_script_name <- paste0( 118 | tools::file_path_sans_ext(orig_script_name), "-correct.R") 119 | # Original correct script path 120 | correct_script_path <- file.path(e$path, "scripts", correct_script_name) 121 | # Path of temp correct script 122 | e$correct_script_temp_path <- file.path(tempdir(), correct_script_name) 123 | 124 | # Copy original script to temp file 125 | file.copy(orig_script_path, e$script_temp_path, overwrite = TRUE) 126 | # Copy original correct to temp correct 127 | file.copy(correct_script_path, e$correct_script_temp_path, overwrite = TRUE) 128 | 129 | # Set reset flag back to FALSE 130 | e$reset <- FALSE 131 | } 132 | # Have user edit the copy. This will reopen the file if 133 | # accidentally closed 134 | file.edit(e$script_temp_path) 135 | # Give instructions 136 | # swirl_out("INSTRUCTIONS: Edit the script and experiment in the console as much as you want. When you are ready to move on, SAVE YOUR SCRIPT and type submit() at the prompt. The script will remain open until you close it.", 137 | # skip_before = FALSE, skip_after = TRUE) 138 | # Indicate a return to the prompt is necessary 139 | e$prompt <- TRUE 140 | # Enter 'play' mode so that user can mess around in the console 141 | e$playing <- TRUE 142 | # Advance lesson 143 | e$iptr <- 1 + e$iptr 144 | } 145 | 146 | # Only the question classes enter a testing loop. Testing is the 147 | # same in both cases. If the response is correct they indicate 148 | # instruction should progress. If incorrect, they publish a hint 149 | # and return to the previous step. 150 | testResponse <- function(current.row, e)UseMethod("testResponse") 151 | 152 | testResponse.default <- function(current.row, e){ 153 | if(isTRUE(getOption("swirl_logging"))){ 154 | e$log$question_number <- c(e$log$question_number, e$row) 155 | e$log$attempt <- c(e$log$attempt, e$attempts) 156 | e$log$skipped <- c(e$log$skipped, e$skipped) 157 | e$log$datetime <- c(e$log$datetime, as.numeric(Sys.time())) 158 | } 159 | 160 | # Increment attempts counter 161 | e$attempts <- 1 + e$attempts 162 | # Get answer tests 163 | tests <- current.row[,"AnswerTests"] 164 | if(is.na(tests) || tests == ""){ 165 | results <- is(e, "dev") 166 | if(!results){ 167 | stop(s()%N%"BUG: There are no tests for this question!") 168 | } 169 | } else { 170 | tests <- str_trim(unlist(strsplit(tests,";"))) 171 | results <- lapply(tests, function(keyphrase){testMe(keyphrase,e)}) 172 | } 173 | correct <- !(FALSE %in% unlist(results)) 174 | if(correct){ 175 | if(isTRUE(getOption("swirl_logging"))){ 176 | e$log$correct <- c(e$log$correct, TRUE) 177 | } 178 | 179 | mes <- praise() 180 | post_result(e, passed = correct, feedback = mes, hint = NULL) 181 | e$iptr <- 1 182 | e$row <- 1 + e$row 183 | # Reset attempts counter, since correct 184 | e$attempts <- 1 185 | } else { 186 | if(isTRUE(getOption("swirl_logging"))){ 187 | e$log$correct <- c(e$log$correct, FALSE) 188 | } 189 | 190 | # Restore the previous global environment from the official 191 | # in case the user has garbled it, e.g., has typed x <- 3*x 192 | # instead of x <- 2*x by mistake. The hint might say to type 193 | # x <- 2*x, which would result in 6 times the original value 194 | # of x unless the original value is restored. 195 | if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv()) 196 | mes <- tryAgain() 197 | if(is(current.row, "cmd_question") && !is(e, "datacamp")) { 198 | mes <- paste(mes, s()%N%"Or, type info() for more options.") 199 | } 200 | hint <- current.row[,"Hint"] 201 | post_result(e, passed = correct, feedback = mes, hint = if(is.na(hint)) NULL else hint) 202 | e$iptr <- e$iptr - 1 203 | } 204 | # reset skipped info 205 | e$skipped <- FALSE 206 | } 207 | 208 | testMe <- function(keyphrase, e){ 209 | # patch to accommodate old-style tests 210 | oldcourse <- attr(e$les, "course_name") %in% 211 | c("Data Analysis", "Mathematical Biostatistics Boot Camp", 212 | "Open Intro") 213 | 214 | if(oldcourse){ 215 | # Use old test syntax 216 | # Add a new class attribute to the keyphrase using 217 | # the substring left of its first "=". 218 | attr(keyphrase, "class") <- c(class(keyphrase), 219 | strsplit(keyphrase, "=")[[1]][1]) 220 | return(runTest(keyphrase, e)) 221 | } else { 222 | # Use new test syntax 223 | return(eval(parse(text=keyphrase))) 224 | } 225 | } 226 | 227 | # CUSTOM TEST SUPPORT. An environment for custom tests is inserted 228 | # "between" function testMe and the swirl namespace. That is, 229 | # an environment, customTests, is created with parent swirl 230 | # and child testMe. Code evaluated within testMe will thus search 231 | # for functions first in customTests, and then in the swirl namespace. 232 | # 233 | # Custom tests must be defined in a file named "customTests.R" in the 234 | # lesson directory. Tests in such files are loaded into environment 235 | # customTests when a lesson is first loaded or progress is restored. 236 | # The environment is cleared between lessons. 237 | 238 | # An environment with parent swirl to hold custom tests. 239 | customTests <- new.env(parent=environment(testMe)) 240 | # Make customTests the parent of testMe. 241 | environment(testMe) <- customTests 242 | 243 | # Function to load custom tests from a source file. 244 | loadCustomTests <- function(lespath){ 245 | customTests$AUTO_DETECT_NEWVAR <- TRUE 246 | cfile <- file.path(lespath,"customTests.R") 247 | if(file.exists(cfile)){ 248 | source(cfile, local=customTests) 249 | } 250 | return(TRUE) # legacy 251 | } 252 | 253 | # Function to remove everything from environment customTests 254 | clearCustomTests <- function(){ 255 | remove(list=ls(customTests), envir=customTests) 256 | } 257 | -------------------------------------------------------------------------------- /R/languages.R: -------------------------------------------------------------------------------- 1 | swirl_language <- function(){ 2 | lang <- getOption("swirl_language") 3 | langs <- c("chinese_simplified", "dutch", "english", 4 | "french", "german", "german_formal", "korean", "portuguese", 5 | "spanish", "turkish") 6 | 7 | if(is.null(lang) || !(lang %in% langs)){ 8 | "english" 9 | } else { 10 | lang 11 | } 12 | } 13 | 14 | #' Select a language 15 | #' 16 | #' Select a language for swirl's menus. 17 | #' @param language The language that swirl's menus will use. 18 | #' This must be one of the following values: \code{"chinese_simplified"}. 19 | #' \code{"english"}, \code{"french"}, \code{"german"}, 20 | #' \code{"korean"}, \code{"spanish"}, or \code{"turkish"}. 21 | #' If \code{NULL} the user will be asked to choose a language 22 | #' interactively. The default value is \code{NULL}. 23 | #' @param append_rprofile If \code{TRUE} this command will append 24 | #' \code{options(swirl_language = [selected language])} to the end of your 25 | #' Rprofile. The default value is \code{FALSE}. 26 | #' 27 | #' @export 28 | select_language <- function(language = NULL, append_rprofile = FALSE){ 29 | langs <- c("chinese_simplified", "dutch", "english", 30 | "french", "german", "german_formal", "korean", "portuguese", 31 | "spanish", "turkish") 32 | if(is.null(language)){ 33 | selection <- select.list(langs) 34 | } else if(!(language %in% langs)){ 35 | stop("Invalid value for 'language.'") 36 | } else { 37 | selection <- language 38 | } 39 | 40 | options(swirl_language = selection) 41 | 42 | if(append_rprofile){ 43 | opts <- paste0("options(swirl_language = '", selection, "')") 44 | cat(opts, "\n", file = file.path("~", ".Rprofile"), append = TRUE) 45 | } 46 | } 47 | 48 | # set working directory to swirl repo before using 49 | #' @importFrom yaml yaml.load_file 50 | compile_languages <- function(){ 51 | ctime <- as.integer(Sys.time()) 52 | clone_dir <- file.path(tempdir(), ctime) 53 | dir.create(clone_dir, showWarnings = FALSE) 54 | git_clone <- paste("git clone https://github.com/swirldev/translations.git", clone_dir) 55 | system(git_clone) 56 | 57 | menus_dir <- file.path(clone_dir, "menus") 58 | menus <- list.files(menus_dir, pattern = "yaml$", full.names = TRUE) 59 | 60 | for(i in menus){ 61 | lang_name <- sub(".yaml$", "", basename(i)) 62 | cmd <- paste0(lang_name, " <- swirl:::wrap_encoding(yaml.load_file('", i, "'))") 63 | eval(parse(text=cmd)) 64 | } 65 | 66 | comma_sep_langs <- paste(sub(".yaml$", "", basename(menus)), collapse = ", ") 67 | cmd <- paste0("save(", comma_sep_langs, ", file = file.path('R', 'sysdata.rda'))") 68 | eval(parse(text=cmd)) 69 | unlink(clone_dir, recursive = TRUE, force = TRUE) 70 | } 71 | 72 | "%N%" <- function(f, y){ 73 | result <- f(y) 74 | if(is.null(result)){ 75 | y 76 | } else { 77 | result 78 | } 79 | } 80 | 81 | s <- function(){ 82 | s_helper 83 | } 84 | 85 | s_helper <- function(x){ 86 | cmd <- paste0(swirl_language(), "$`", x, "`") 87 | tryCatch(eval(parse(text=cmd)), 88 | warning = function(c) NULL 89 | ) 90 | } 91 | 92 | # set working directory to swirl repo before using 93 | # make sure the global env is clear before using 94 | 95 | #' @importFrom stringr str_match 96 | check_strings <- function(){ 97 | load(file.path("R", "sysdata.rda")) 98 | langs <- ls() 99 | ##langs <- "english" 100 | 101 | for(i in list.files("R", pattern = "\\.R$")){ 102 | source_code <- readLines(file.path("R", i), warn = FALSE) 103 | strings <- grep("s\\(\\)%N%", source_code) 104 | for(j in strings){ 105 | for(l in langs){ 106 | if(!(str_match(source_code[j], '"(.*?)"')[,2] %in% eval(parse(text = paste0("names(", l, ")"))))){ 107 | message(l, " : '", str_match(source_code[j], '"(.*?)"')[,2], "' : ", i) 108 | ##cat('"', str_match(source_code[j], '"(.*?)"')[,2], '"', ':\n "', str_match(source_code[j], '"(.*?)"')[,2], '"\n\n', sep = "") 109 | } 110 | } 111 | } 112 | } 113 | } -------------------------------------------------------------------------------- /R/lesson_constructor.R: -------------------------------------------------------------------------------- 1 | # Constructor function for objects of class "lesson" 2 | lesson <- function(df, lesson_name=NULL, course_name=NULL, author=NULL, 3 | type=NULL, organization=NULL, version=NULL, partner=NULL) { 4 | 5 | if(!is.data.frame(df)) 6 | stop("Argument 'df' must be a data frame!") 7 | 8 | # Adding secondary class of data.frame allows lessons to retain data.frame attributes (e.g. dim()) 9 | structure(df, lesson_name=lesson_name, course_name=course_name, author=author, 10 | type=type, organization=organization, version=version, partner=partner, 11 | class=c("lesson", "data.frame")) 12 | } -------------------------------------------------------------------------------- /R/log.R: -------------------------------------------------------------------------------- 1 | saveLog <- function(e)UseMethod("saveLog") 2 | 3 | saveLog.default <- function(e){ 4 | # save log 5 | suppressMessages(suppressWarnings( 6 | saveRDS(e$log, file.path(e$udat, paste0(as.integer(Sys.time()), ".swlog"))))) 7 | } -------------------------------------------------------------------------------- /R/menu.R: -------------------------------------------------------------------------------- 1 | ## Method declarations 2 | 3 | mainMenu <- function(e, ...)UseMethod("mainMenu") 4 | welcome <- function(e, ...)UseMethod("welcome") 5 | housekeeping <- function(e, ...)UseMethod("housekeeping") 6 | inProgressMenu <- function(e, choices, ...)UseMethod("inProgressMenu") 7 | courseMenu <- function(e, courses)UseMethod("courseMenu") 8 | courseDir <- function(e)UseMethod("courseDir") 9 | progressDir <- function(e)UseMethod("progressDir") 10 | lessonMenu <- function(e, choices)UseMethod("lessonMenu") 11 | restoreUserProgress <- function(e, selection)UseMethod("restoreUserProgress") 12 | loadLesson <- function(e, ...)UseMethod("loadLesson") 13 | loadInstructions <- function(e, ...)UseMethod("loadInstructions") 14 | 15 | # Default course and lesson navigation logic 16 | # 17 | # This method implements default course and lesson navigation logic, 18 | # decoupling menu presentation from internal processing of user 19 | # selections. It relies on several methods for menu presentation, 20 | # namely welcome(e), housekeeping(e), inProgressMenu(e, lessons), 21 | # courseMenu(e, courses), and lessonMenu(e, lessons). Defaults 22 | # are provided. 23 | # 24 | # @param e persistent environment accessible to the callback 25 | #'@importFrom yaml yaml.load_file 26 | mainMenu.default <- function(e){ 27 | # Welcome the user if necessary and set up progress tracking 28 | if(!exists("usr",e,inherits = FALSE)){ 29 | e$usr <- welcome(e) 30 | udat <- file.path(progressDir(e), e$usr) 31 | if(!file.exists(udat)){ 32 | housekeeping(e) 33 | dir.create(udat, recursive=TRUE) 34 | } 35 | e$udat <- udat 36 | } 37 | # If there is no active lesson, obtain one. 38 | if(!exists("les",e,inherits = FALSE)){ 39 | # First, allow user to continue unfinished lessons 40 | # if there are any 41 | pfiles <- inProgress(e) 42 | response <- "" 43 | if(length(pfiles) > 0){ 44 | response <- inProgressMenu(e, pfiles) 45 | } 46 | if(response != "" ){ 47 | # If the user has chosen to continue, restore progress 48 | response <- gsub(" ", "_", response) 49 | response <- paste0(response,".rda") 50 | restoreUserProgress(e, response) 51 | } else { 52 | # Else load a new lesson. 53 | # Let user choose the course. 54 | coursesU <- dir(courseDir(e)) 55 | # Eliminate empty directories 56 | idx <- unlist(sapply(coursesU, 57 | function(x)length(dir(file.path(courseDir(e),x)))>0)) 58 | coursesU <- coursesU[idx] 59 | 60 | # If no courses are available, offer to install one 61 | if(length(coursesU)==0){ 62 | suggestions <- yaml.load_file(file.path(find.package("swirl"), "Courses", "suggested_courses.yaml")) 63 | choices <- sapply(suggestions, function(x)paste0(x$Course, ": ", x$Description)) 64 | swirl_out(s()%N%"To begin, you must install a course. I can install a course for you from the internet, or I can send you to a web page (https://github.com/swirldev/swirl_courses) which will provide course options and directions for installing courses yourself. (If you are not connected to the internet, type 0 to exit.)") 65 | choices <- c(choices, s()%N%"Don't install anything for me. I'll do it myself.") 66 | choice <- select.list(choices, graphics=FALSE) 67 | n <- which(choice == choices) 68 | if(length(n) == 0)return(FALSE) 69 | if(n < length(choices)){ 70 | repeat { 71 | temp <- try(eval(parse(text=suggestions[[n]]$Install)), silent=TRUE) 72 | if(is(temp, "try-error")){ 73 | swirl_out(s()%N%"Sorry, but I'm unable to fetch ", sQuote(choice), 74 | s()%N%"right now. Are you sure you have an internet connection?", 75 | s()%N%"If so, would you like to try again or visit", 76 | s()%N%"the course repository for instructions on how to", 77 | s()%N%"install a course manually? Type 0 to exit.") 78 | ch <- c(s()%N%"Try again!", 79 | s()%N%"Send me to the course repository for manual installation.") 80 | resp <- select.list(ch, graphics=FALSE) 81 | if(resp == "") return(FALSE) 82 | if(resp == ch[2]) { 83 | swirl_out(s()%N%"OK. I'm opening the swirl course respository in your browser.") 84 | browseURL("https://github.com/swirldev/swirl_courses") 85 | return(FALSE) 86 | } 87 | } else { 88 | break # Break repeat loop if install is successful 89 | } 90 | } 91 | coursesU <- dir(courseDir(e)) 92 | if(length(coursesU) > 0){ 93 | for(i in 1:length(coursesU)){ 94 | coursesU[i] <- enc2utf8(coursesU[i]) 95 | } 96 | } 97 | if(any(is.na(coursesU))){ 98 | coursesU <- dir(courseDir(e)) 99 | } 100 | # Eliminate empty directories 101 | idx <- unlist(sapply(coursesU, 102 | function(x)length(dir(file.path(courseDir(e),x)))>0)) 103 | coursesU <- coursesU[idx] 104 | } else { 105 | swirl_out(s()%N%"OK. I'm opening the swirl course respository in your browser.") 106 | browseURL("https://github.com/swirldev/swirl_courses") 107 | return(FALSE) 108 | } 109 | } 110 | # path cosmetics 111 | coursesR <- gsub("_", " ", coursesU) 112 | lesson <- "" 113 | while(lesson == ""){ 114 | course <- courseMenu(e, coursesR) 115 | if(!is.null(names(course)) && names(course)=="repo") { 116 | swirl_out(s()%N%"OK. I'm opening the swirl courses web page in your browser.") 117 | browseURL("https://github.com/swirldev/swirl_courses") 118 | return(FALSE) 119 | } 120 | if(course=="")return(FALSE) 121 | # Set temp course name since csv files don't carry attributes 122 | e$temp_course_name <- course 123 | # reverse path cosmetics 124 | courseU <- coursesU[course == coursesR] 125 | course_dir <- file.path(courseDir(e), courseU) 126 | 127 | # Get all files/folders from course dir, excluding MANIFEST 128 | lessons <- dir(course_dir) 129 | lessons <- lessons[lessons != "MANIFEST"] 130 | # If MANIFEST exists in course directory, then order courses 131 | man_path <- file.path(course_dir, "MANIFEST") 132 | if(file.exists(man_path)) { 133 | manifest <- get_manifest(course_dir) 134 | lessons <- order_lessons(current_order=lessons, 135 | manifest_order=manifest) 136 | } 137 | # If the manifest introduced NAs, try reading without UTF-8 138 | if(any(is.na(lessons))){ 139 | manifest <- get_manifest(course_dir, utf8 = FALSE) 140 | lessons <- order_lessons(current_order=lessons, 141 | manifest_order=manifest) 142 | } 143 | # If there are still NAs, throw the manifest out 144 | if(any(is.na(lessons))){ 145 | lessons <- list.dirs(course_dir, full.names = FALSE, recursive = FALSE) 146 | # Get rid of hidden folders if they exist 147 | if(length(grep("^\\.", lessons)) > 0){ 148 | lessons <- lessons[-grep("^\\.", lessons)] 149 | } 150 | } 151 | 152 | # Clean up lesson names 153 | lessons_clean <- gsub("_", " ", lessons) 154 | # Let user choose the lesson. 155 | lesson_choice <- lessonMenu(e, lessons_clean) 156 | # Set temp lesson name since csv files don't have lesson name attribute 157 | e$temp_lesson_name <- lesson_choice 158 | # reverse path cosmetics 159 | lesson <- ifelse(lesson_choice=="", "", 160 | lessons[lesson_choice == lessons_clean]) 161 | # Return to the course menu if the lesson failed to load 162 | if(lesson == ""){ 163 | if(exists("les", e, inherits=FALSE)){ 164 | rm("les", envir=e, inherits=FALSE) 165 | } 166 | lesson <- "" 167 | next() 168 | } else { 169 | # Load the lesson and intialize everything 170 | e$les <- loadLesson(e, courseU, lesson) 171 | } 172 | } 173 | # For sourcing files which construct figures etc 174 | e$path <- file.path(courseDir(e), courseU, lesson) 175 | # If running in 'test' mode and starting partway through 176 | # lesson, then complete first part 177 | if((is(e, "test") || is(e, "datacamp")) && e$test_from > 1) { 178 | complete_part(e) 179 | } 180 | 181 | # Remove temp lesson name and course name vars, which were surrogates 182 | # for csv attributes -- they've been attached via lesson() by now 183 | rm("temp_lesson_name", "temp_course_name", envir=e, inherits=FALSE) 184 | 185 | # Initialize the progress bar 186 | if(!is(e,"datacamp")) { 187 | e$pbar <- txtProgressBar(style=3) 188 | } 189 | e$pbar_seq <- seq(0, 1, length.out=nrow(e$les)) 190 | 191 | # expr, val, ok, and vis should have been set by the callback. 192 | # The lesson's current row - could start after 1 if in 'test' mode 193 | if(is(e, 'test') || is(e, 'datacamp')) { 194 | e$row <- e$test_from 195 | } else { 196 | e$row <- 1 197 | } 198 | # The current row's instruction pointer 199 | e$iptr <- 1 200 | # A flag indicating we should return to the prompt 201 | e$prompt <- FALSE 202 | # The job of loading instructions for this "virtual machine" 203 | # is relegated to an S3 method to allow for different "programs." 204 | loadInstructions(e) 205 | # An identifier for the active row 206 | e$current.row <- NULL 207 | # Set up paths and files to save user progress 208 | # Make file path from lesson info 209 | fname <- progressName(attr(e$les,"course_name"), attr(e$les,"lesson_name")) 210 | # path to file 211 | e$progress <- file.path(e$udat, fname) 212 | # indicator that swirl is not reacting to console input 213 | e$playing <- FALSE 214 | 215 | # Create log 216 | if(isTRUE(getOption("swirl_logging"))){ 217 | e$log <- list(user = e$usr, 218 | course_name = attr(e$les,"course_name"), 219 | lesson_name = attr(e$les,"lesson_name"), 220 | question_number = NULL, 221 | correct = NULL, 222 | attempt = NULL, 223 | skipped = NULL, 224 | datetime = NULL) 225 | } 226 | 227 | # create the file 228 | suppressMessages(suppressWarnings(saveRDS(e, e$progress))) 229 | # post initialization message 230 | post_init(e) 231 | } 232 | } 233 | return(TRUE) 234 | } 235 | 236 | welcome.test <- function(e, ...){ 237 | "author" 238 | } 239 | 240 | # Default version. 241 | #' @importFrom stringr str_detect str_trim 242 | welcome.default <- function(e, ...){ 243 | swirl_out(s()%N%"Welcome to swirl! Please sign in. If you've been here before, use the same name as you did then. If you are new, call yourself something unique.", skip_after=TRUE) 244 | resp <- readline(s()%N%"What shall I call you? ") 245 | while(str_detect(resp, '[[:punct:]]') || nchar(str_trim(resp)) < 1) { 246 | swirl_out(s()%N%"Please don't use any quotes or other punctuation in your name.", 247 | skip_after = TRUE) 248 | resp <- readline(s()%N%"What shall I call you? ") 249 | } 250 | return(resp) 251 | } 252 | 253 | # Presents preliminary information to a new user 254 | # 255 | # @param e persistent environment used here only for its class attribute 256 | # 257 | housekeeping.default <- function(e){ 258 | swirl_out(paste0(s()%N%"Thanks, ", e$usr, s()%N%". Let's cover a couple of quick housekeeping items before we begin our first lesson. First of all, you should know that when you see '...', that means you should press Enter when you are done reading and ready to continue.")) 259 | readline(s()%N%"\n... <-- That's your cue to press Enter to continue") 260 | swirl_out(s()%N%"Also, when you see 'ANSWER:', the R prompt (>), or when you are asked to select from a list, that means it's your turn to enter a response, then press Enter to continue.") 261 | select.list(c(s()%N%"Continue.", s()%N%"Proceed.", s()%N%"Let's get going!"), 262 | title=s()%N%"\nSelect 1, 2, or 3 and press Enter", graphics=FALSE) 263 | swirl_out(s()%N%"You can exit swirl and return to the R prompt (>) at any time by pressing the Esc key. If you are already at the prompt, type bye() to exit and save your progress. When you exit properly, you'll see a short message letting you know you've done so.") 264 | info() 265 | swirl_out(s()%N%"Let's get started!", skip_before=FALSE) 266 | readline("\n...") 267 | } 268 | 269 | housekeeping.test <- function(e){} 270 | 271 | # A stub. Eventually this should be a full menu 272 | inProgressMenu.default <- function(e, choices){ 273 | nada <- s()%N%"No. Let me start something new." 274 | swirl_out(s()%N%"Would you like to continue with one of these lessons?") 275 | selection <- select.list(c(choices, nada), graphics=FALSE) 276 | # return a blank if the user rejects all choices 277 | if(identical(selection, nada))selection <- "" 278 | return(selection) 279 | } 280 | 281 | inProgressMenu.test <- function(e, choices) { 282 | "" 283 | } 284 | 285 | # A stub. Eventually this should be a full menu 286 | courseMenu.default <- function(e, choices){ 287 | repo_option <- s()%N%"Take me to the swirl course repository!" 288 | choices <- c(choices, repo = repo_option) 289 | swirl_out(s()%N%"Please choose a course, or type 0 to exit swirl.") 290 | return(select.list(choices, graphics=FALSE)) 291 | } 292 | 293 | courseMenu.test <- function(e, choices) { 294 | e$test_course 295 | } 296 | 297 | # A stub. Eventually this should be a full menu 298 | lessonMenu.default <- function(e, choices){ 299 | swirl_out(s()%N%"Please choose a lesson, or type 0 to return to course menu.") 300 | return(select.list(choices, graphics=FALSE)) 301 | } 302 | 303 | lessonMenu.test <- function(e, choices) { 304 | e$test_lesson 305 | } 306 | 307 | loadLesson.default <- function(e, courseU, lesson){ 308 | # Load the content file 309 | lesPath <- file.path(courseDir(e), courseU, lesson) 310 | shortname <- find_lesson(lesPath) 311 | dataName <- file.path(lesPath,shortname) 312 | # Handle dependencies 313 | if(!loadDependencies(lesPath))return(FALSE) 314 | # Initialize list of official variables 315 | e$snapshot <- list() 316 | # initialize course lesson, assigning lesson-specific variables 317 | initFile <- file.path(lesPath,"initLesson.R") 318 | if(file.exists(initFile))local({ 319 | source(initFile, local=TRUE) 320 | # NOTE: the order of the next two statements is important, 321 | # since a reference to e$snapshot will cause e to appear in 322 | # local environment. 323 | xfer(environment(), globalenv()) 324 | # Only add to the "official record" if are auto-detecting new variables 325 | if(isTRUE(customTests$AUTO_DETECT_NEWVAR)) { 326 | e$snapshot <- as.list(environment()) 327 | } 328 | }) 329 | # load any custom tests, returning FALSE if they fail to load 330 | clearCustomTests() 331 | loadCustomTests(lesPath) 332 | 333 | # Attached class to content based on file extension 334 | class(dataName) <- get_content_class(dataName) 335 | 336 | # Parse content, returning object of class "lesson" 337 | return(parse_content(dataName, e)) 338 | } 339 | 340 | restoreUserProgress.default <- function(e, selection){ 341 | # read the progress file 342 | temp <- readRDS(file.path(e$udat, selection)) 343 | # transfer its contents to e 344 | xfer(temp, e) 345 | # Since loadDepencies will have worked once, we don't 346 | # check for failure here. Perhaps we should. 347 | loadDependencies(e$path) 348 | # source the initLesson.R file if it exists 349 | initf <- file.path(e$path, "initLesson.R") 350 | if(file.exists(initf))local({ 351 | source(initf, local=TRUE) 352 | xfer(environment(), globalenv()) 353 | }) 354 | # transfer swirl's "official" list of variables to the 355 | # global environment. 356 | if(length(e$snapshot)>0){ 357 | xfer(as.environment(e$snapshot), globalenv()) 358 | } 359 | # load any custom tests 360 | clearCustomTests() 361 | loadCustomTests(e$path) 362 | # Restore figures which precede current row (Issue #44) 363 | idx <- 1:(e$row - 1) 364 | figs <- e$les[idx,"Figure"] 365 | # Check for missing Figure column (Issue #47) and omit NA's 366 | if(is.null(figs) || length(figs) == 0)return() 367 | figs <- figs[!is.na(figs)] 368 | figs <- file.path(e$path, figs) 369 | lapply(figs, function(x)source(file=x, local=TRUE)) 370 | } 371 | 372 | loadInstructions.default <- function(e){ 373 | e$instr <- list(present, waitUser, testResponse) 374 | } 375 | 376 | 377 | # UTILITIES 378 | 379 | progressName <- function(courseName, lesName){ 380 | pn <- paste0(courseName, "_", lesName, ".rda") 381 | gsub(" ", "_", pn) 382 | } 383 | 384 | inProgress <- function(e){ 385 | pfiles <- dir(e$udat)[grep("[.]rda$", dir(e$udat))] 386 | pfiles <- gsub("[.]rda", "", pfiles) 387 | pfiles <- str_trim(gsub("_", " ", pfiles)) 388 | return(pfiles) 389 | } 390 | 391 | completed <- function(e){ 392 | pfiles <- dir(e$udat)[grep("[.]done$", dir(e$udat))] 393 | pfiles <- gsub("[.]done", "", pfiles) 394 | pfiles <- gsub("[.]rda", "", pfiles) 395 | pfiles <- str_trim(gsub("_", " ", pfiles)) 396 | return(pfiles) 397 | } 398 | 399 | get_manifest <- function(course_dir, utf8 = TRUE) { 400 | if(utf8){ 401 | man <- readLines(file.path(course_dir, "MANIFEST"), warn=FALSE, encoding = "UTF-8") 402 | } else { 403 | man <- readLines(file.path(course_dir, "MANIFEST"), warn=FALSE) 404 | } 405 | # Remove leading and trailing whitespace 406 | man <- str_trim(man) 407 | # Remove empty lines 408 | man <- man[which(man != "")] 409 | } 410 | 411 | # Take vector of lessons and return in order given by manifest. 412 | # Any courses not included in manifest are excluded! 413 | order_lessons <- function(current_order, manifest_order) { 414 | current_order[match(manifest_order, current_order)] 415 | } 416 | 417 | courseDir.default <- function(e){ 418 | # e's only role is to determine the method used 419 | swirl_courses_dir() 420 | } 421 | 422 | progressDir.default <- function(e) { 423 | swirl_data_dir() 424 | } 425 | 426 | # Default for determining the user 427 | getUser <- function()UseMethod("getUser") 428 | getUser.default <- function(){"swirladmin"} 429 | -------------------------------------------------------------------------------- /R/options.R: -------------------------------------------------------------------------------- 1 | # Get path to a lesson 2 | lesson_path <- function(course_name, lesson_name){ 3 | file.path(swirl_courses_dir(), course_name, lesson_name) 4 | } 5 | 6 | # Get swirl data file path 7 | swirl_data_dir <- function(){ 8 | sdd <- getOption("swirl_data_dir") 9 | 10 | if(is.null(sdd)){ 11 | file.path(find.package("swirl"), "user_data") 12 | } else { 13 | sdd 14 | } 15 | } 16 | 17 | # Get swirl courses dir 18 | swirl_courses_dir <- function(){ 19 | scd <- getOption("swirl_courses_dir") 20 | 21 | if(is.null(scd)){ 22 | file.path(find.package("swirl"), "Courses") 23 | } else { 24 | scd 25 | } 26 | } 27 | 28 | #' Get swirl options 29 | #' 30 | #' This function is a wrapper for \code{options()} that allows the user to 31 | #' see the state of how certain options for swirl are set up. 32 | #' 33 | #' @param ... any options can be defined, using name = value. 34 | #' 35 | #' @export 36 | #' @examples 37 | #' \dontrun{ 38 | #' # See current current swirl options 39 | #' swirl_options() 40 | #' 41 | #' # Set an option 42 | #' swirl_options(swirl_logging = TRUE) 43 | #' } 44 | swirl_options <- function(...){ 45 | if(length(list(...)) == 0){ 46 | list( 47 | swirl_courses_dir = getOption("swirl_courses_dir"), 48 | swirl_data_dir = getOption("swirl_data_dir"), 49 | swirl_language = getOption("swirl_language"), 50 | swirl_logging = getOption("swirl_logging"), 51 | swirl_is_fun = getOption("swirl_is_fun") 52 | ) 53 | } else { 54 | options(...) 55 | } 56 | } -------------------------------------------------------------------------------- /R/parse_content.R: -------------------------------------------------------------------------------- 1 | find_lesson <- function(lesson_dir) { 2 | # Find 'lesson' file with or without extension 3 | grep("^lesson[.]?[A-Za-z]*$", list.files(lesson_dir), value=TRUE) 4 | } 5 | 6 | #' @importFrom tools file_ext 7 | get_content_class <- function(file_name) { 8 | ext <- file_ext(file_name) 9 | tolower(ext) 10 | } 11 | 12 | ### FUNCTIONS THAT RETURN LESSON OBJECT WITH ASSOCIATED ATTRIBUTES ### 13 | 14 | parse_content <- function(file, e) UseMethod("parse_content") 15 | 16 | parse_content.default <- function(file, e) { 17 | # If no extension on lesson file, then assume it's yaml 18 | parse_content.yaml(file, e) 19 | } 20 | 21 | parse_content.csv <- function(file, e) { 22 | df <- read.csv(file, as.is=TRUE) 23 | # Return lesson object 24 | lesson(df, lesson_name=e$temp_lesson_name, course_name=e$temp_course_name) 25 | } 26 | 27 | parse_content.rmd <- function(file, e) { 28 | rmd2df(file) 29 | } 30 | 31 | wrap_encoding <- function(raw_yaml) { 32 | if (class(raw_yaml) == "list") { 33 | retval <- lapply(raw_yaml, wrap_encoding) 34 | attributes(retval) <- attributes(raw_yaml) 35 | retval 36 | } else { 37 | if (class(raw_yaml) == "character") { 38 | if (Encoding(raw_yaml) == "unknown") { 39 | Encoding(raw_yaml) <- "UTF-8" 40 | } 41 | } 42 | raw_yaml 43 | } 44 | } 45 | 46 | #' @importFrom yaml yaml.load_file 47 | parse_content.yaml <- function(file, e){ 48 | newrow <- function(element){ 49 | temp <- data.frame(Class=NA, Output=NA, CorrectAnswer=NA, 50 | AnswerChoices=NA, AnswerTests=NA, 51 | Hint=NA, Figure=NA, FigureType=NA, 52 | VideoLink=NA, Script=NA) 53 | for(nm in names(element)){ 54 | # Only replace NA with value if value is not NULL, i.e. instructor 55 | # provided a nonempty value 56 | if(!is.null(element[[nm]])) { 57 | temp[,nm] <- element[[nm]] 58 | } 59 | } 60 | temp 61 | } 62 | raw_yaml <- yaml.load_file(file) 63 | raw_yaml <- wrap_encoding(raw_yaml) 64 | temp <- lapply(raw_yaml[-1], newrow) 65 | df <- NULL 66 | for(row in temp){ 67 | df <- rbind(df, row) 68 | } 69 | meta <- raw_yaml[[1]] 70 | lesson(df, lesson_name=meta$Lesson, course_name=meta$Course, 71 | author=meta$Author, type=meta$Type, organization=meta$Organization, 72 | version=meta$Version, partner=meta$Partner) 73 | } 74 | -------------------------------------------------------------------------------- /R/phrases.R: -------------------------------------------------------------------------------- 1 | # Return random praise. 2 | praise <- function() { 3 | swirl_is_fun <- getOption("swirl_is_fun") 4 | 5 | if(is.null(swirl_is_fun) || isTRUE(swirl_is_fun)) { 6 | phrases <- c(s()%N%"You got it!", 7 | s()%N%"Nice work!", 8 | s()%N%"Keep up the great work!", 9 | s()%N%"You are doing so well!", 10 | s()%N%"All that hard work is paying off!", 11 | s()%N%"You nailed it! Good job!", 12 | s()%N%"You're the best!", 13 | s()%N%"You are amazing!", 14 | s()%N%"Keep working like that and you'll get there!", 15 | s()%N%"Perseverance, that's the answer.", 16 | s()%N%"Great job!", 17 | s()%N%"You are quite good my friend!", 18 | s()%N%"Your dedication is inspiring!", 19 | s()%N%"You got it right!", 20 | s()%N%"That's correct!", 21 | s()%N%"You are really on a roll!", 22 | s()%N%"Excellent job!", 23 | s()%N%"All that practice is paying off!", 24 | s()%N%"Excellent work!", 25 | s()%N%"That's a job well done!", 26 | s()%N%"That's the answer I was looking for.") 27 | } else { 28 | phrases <- s()%N%"Correct!" 29 | } 30 | sample(phrases, 1) 31 | } 32 | 33 | # Return random "try again" message. 34 | tryAgain <- function() { 35 | swirl_is_fun <- getOption("swirl_is_fun") 36 | 37 | if(is.null(swirl_is_fun) || isTRUE(swirl_is_fun)) { 38 | phrases <- c(s()%N%"Almost! Try again.", 39 | s()%N%"You almost had it, but not quite. Try again.", 40 | s()%N%"Give it another try.", 41 | s()%N%"Not quite! Try again.", 42 | s()%N%"Not exactly. Give it another go.", 43 | s()%N%"That's not exactly what I'm looking for. Try again.", 44 | s()%N%"Nice try, but that's not exactly what I was hoping for. Try again.", 45 | s()%N%"Keep trying!", 46 | s()%N%"That's not the answer I was looking for, but try again.", 47 | s()%N%"Not quite right, but keep trying.", 48 | s()%N%"You're close...I can feel it! Try it again.", 49 | s()%N%"One more time. You can do it!", 50 | s()%N%"Not quite, but you're learning! Try again.", 51 | s()%N%"Try again. Getting it right on the first try is boring anyway!") 52 | } else { 53 | phrases <- s()%N%"Incorrect. Please try again." 54 | } 55 | sample(phrases, 1) 56 | } 57 | -------------------------------------------------------------------------------- /R/post.R: -------------------------------------------------------------------------------- 1 | post_init <- function(e) UseMethod("post_init") 2 | post_exercise <- function(e, current.row) UseMethod("post_exercise") 3 | post_mult_question <- function(e, choices) UseMethod("post_mult_question") 4 | post_result <- function(e, passed, submission, feedback, hint) UseMethod("post_result") 5 | post_progress <- function(e) UseMethod("post_progress") 6 | post_finished <- function(e) UseMethod("post_finished") 7 | 8 | post_init.default <- function(e) { 9 | # do nothing 10 | } 11 | 12 | post_exercise.default <- function(e, current.row) { 13 | # Suppress extra space if multiple choice 14 | is_mult <- is(e$current.row, "mult_question") 15 | # Present output to user 16 | swirl_out(current.row[, "Output"], skip_after = !is_mult) 17 | } 18 | 19 | post_mult_question.default <- function(e, choices) { 20 | return(select.list(sample(choices), graphics=FALSE)) 21 | } 22 | 23 | post_result.default <- function(e, passed, feedback, hint) { 24 | swirl_out(feedback) 25 | if(!passed) { 26 | # If hint is specified, print it. Otherwise, just skip a line. 27 | if(!is.null(hint)) { 28 | # Suppress extra space if multiple choice 29 | is_mult <- is(e$current.row, "mult_question") 30 | swirl_out(hint, skip_after = !is_mult) 31 | } else { 32 | message() 33 | } 34 | } 35 | } 36 | 37 | post_progress.default <- function(e) { 38 | cat("\n") 39 | setTxtProgressBar(e$pbar, e$pbar_seq[e$row]) 40 | } 41 | 42 | post_finished.default <- function(e) { 43 | swirl_out(s()%N%"Lesson complete! Exiting swirl now...", skip_after=TRUE) 44 | } 45 | -------------------------------------------------------------------------------- /R/progress.R: -------------------------------------------------------------------------------- 1 | saveProgress <- function(e)UseMethod("saveProgress") 2 | 3 | saveProgress.default <- function(e){ 4 | # save progress 5 | suppressMessages(suppressWarnings(saveRDS(e, e$progress))) 6 | } 7 | 8 | #' Delete a user's progress 9 | #' 10 | #' @param user The user name whose progress will be deleted. 11 | #' @param path If specified, the directory where the user_data can be found 12 | #' @export 13 | #' @examples 14 | #' \dontrun{ 15 | #' 16 | #' delete_progress("bill") 17 | #' } 18 | delete_progress <- function(user, path = NULL){ 19 | # Make sure user entered a user name 20 | if(nchar(user) < 1){ 21 | stop("Please enter a valid username.") 22 | } 23 | 24 | # Find path to user data 25 | if(is.null(path)) { 26 | path <- system.file("user_data", user, package = "swirl") 27 | } 28 | 29 | # Delete all files within a user folder 30 | if(file.exists(path)){ 31 | invisible(file.remove(list.files(path, full.names = TRUE), recursive = TRUE)) 32 | message(paste0(s()%N%"Deleted progress for user: ", user)) 33 | } else { 34 | message(paste0(s()%N%"Could not find account for user: ", user)) 35 | } 36 | } -------------------------------------------------------------------------------- /R/rmatch_calls.R: -------------------------------------------------------------------------------- 1 | # Reference: Creating a More Robust Version of Omnitest, https://github.com/swirldev/swirl/issues/196 2 | 3 | #' Recursively expand both the correct expression and the user's expression and 4 | #' test for a match. CAUTION: May raise errors, as in rmatch_calls. 5 | #' 6 | #' @export 7 | #' @param expr1 expression 8 | #' @param expr2 expression 9 | #' @param eval_for_class TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE. 10 | #' @param eval_env parent environment for evaluations to determine class. Ignored if eval_for_class=FALSE 11 | #' @return TRUE or FALSE according to whether expanded expressions match. 12 | #' @examples 13 | #' \dontrun{ 14 | #' 15 | #' expr1 <- quote(print(paste("my_name_is", "mud"))) 16 | #' expr2 <- quote(print(paste("my_name_is", "mud", sep=" "))) 17 | #' err <- try(ans <- is_robust_match(expr1, expr2, eval_for_class=TRUE), silent=TRUE) 18 | #' if(is(ans, "try-error")){ 19 | #' ans <- isTRUE(all.equal()) 20 | #' } 21 | #' } 22 | is_robust_match <- function(expr1, expr2, eval_for_class, eval_env=NULL){ 23 | expr1 <- rmatch_calls(expr1, eval_for_class, eval_env) 24 | expr2 <- rmatch_calls(expr2, eval_for_class, eval_env) 25 | isTRUE(all.equal(expr1, expr2)) 26 | } 27 | 28 | #' Recursively expand match calls in an expression from the bottom up. 29 | #' 30 | #' Given an expression, expr, traverse the syntax tree from the 31 | #' bottom up, expanding the call to include default values of 32 | #' named formals as appropriate, and applying match.call to the result. 33 | #' Functionality is limited to expressions containing ordinary functions 34 | #' or S3 methods. If parameter eval_for_class has its default value of FALSE, 35 | #' an error will be raised for any S3 method whose first argument (as an expression) 36 | #' is not atomic. If eval_for_class is TRUE, the first argument will be evaluated 37 | #' to determine its class. Evaluation will take place in the environment given by 38 | #' parameter eval_env. 39 | #' CAUTION: eval_for_class=TRUE is likely to result in multiple evaluations of the same code. 40 | #' Expressions containing S4 or reference class methods will also raise errors. 41 | #' @export 42 | #' @param expr an R expression (a.k.a. abstract syntax tree) 43 | #' @param eval_for_class TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE. 44 | #' @param eval_env environment in which to evaluate for class. Ignored if eval_for_class=FALSE 45 | #' @return an equivalent R expression with function or method calls in canonical form. 46 | #' @examples 47 | #' \dontrun{ 48 | #' 49 | #' # Function 50 | #' rmatch_calls(quote(help("print"))) 51 | #' help(topic = "print", package = NULL, lib.loc = NULL, verbose = getOption("verbose"), 52 | #' try.all.packages = getOption("help.try.all.packages"), help_type = getOption("help_type")) 53 | #' 54 | #' # S3 method with atomic first argument 55 | #' rmatch_calls(quote(seq(0, 1, by=.5))) 56 | #' seq(from = 0, to = 1, by = 0.5, length.out = NULL, along.with = NULL) 57 | #' 58 | #' # S3 method with non-atomic first argument, eval_for_class = FALSE (default) 59 | #' rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) 60 | #' #Error in rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) : 61 | #' # Illegal expression, seq(as.Date(x = "2014-02-01"), as.Date(x = "2014-03-01")): 62 | #' # The first argument, as.Date(x = "2014-02-01"), to S3 method 'seq', is a call, 63 | #' # which (as an expression) is not atomic, hence its class can't be determined in an 64 | #' # abstract syntax tree without additional information. 65 | #' 66 | #' # S3 method with non-atomic first argument, eval_for_class = TRUE 67 | #' rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01"))), eval_for_class=TRUE) 68 | #' seq(from = as.Date(x = "2014-02-01"), to = as.Date(x = "2014-03-01"), 69 | #' length.out = NULL, along.with = NULL) 70 | #' } 71 | rmatch_calls <- function(expr, eval_for_class=FALSE, eval_env=NULL){ 72 | # If expr is not a call, just return it. 73 | if(!is.call(expr))return(expr) 74 | # Replace expr's components with matched versions. 75 | for(n in 1:length(expr)){ 76 | expr[[n]] <- rmatch_calls(expr[[n]],eval_for_class) 77 | } 78 | # If match.fun(expr[[1]]) raises an exception here, the code which follows 79 | # would be likely to give a misleading result. Catch the error merely to 80 | # produce a better diagnostic. 81 | tryCatch(fct <- match.fun(expr[[1]]), 82 | error=function(e)stop(paste0("Illegal expression ", dprs(expr), 83 | ": ", dprs(expr[[1]]), " is not a function.\n"))) 84 | # If fct is a special function such as `$`, or builtin such as `+`, return expr. 85 | if(is.primitive(fct)){ 86 | return(expr) 87 | } 88 | # If fct is an (S4) standardGeneric, match.call is likely to give a misleading result, 89 | # so raise an exception. (Note that builtins were handled earlier.) 90 | if(is(fct, "standardGeneric")){ 91 | stop(paste0("Illegal expression, ", dprs(expr), ": ", dprs(expr[[1]]), " is a standardGeneric.\n")) 92 | } 93 | # At this point, fct should be an ordinary function or an S3 method. 94 | if(isS3(fct)){ 95 | # If the S3 method's first argument, expr[[2]], is anything but atomic 96 | # its class can't be determined here without evaluation. 97 | if(!is.atomic(expr[[2]]) & !eval_for_class){ 98 | stop(paste0("Illegal expression, ", dprs(expr),": The first argument, ", dprs(expr[[2]]), 99 | ", to S3 method '", dprs(expr[[1]]), 100 | "', is a ", class(expr[[2]]) , ", which (as an expression) is not atomic,", 101 | " hence its class can't be determined in an abstract", 102 | " syntax tree without additional information.\n")) 103 | } 104 | # Otherwise, attempt to find the appropriate method. 105 | if(is.null(eval_env)){ 106 | eval_env <- new.env() 107 | } else { 108 | eval_env <- new.env(parent=eval_env) 109 | } 110 | temp <- eval(expr[[2]], envir = eval_env) 111 | classes <- try(class(temp), silent=TRUE) 112 | for(cls in classes){ 113 | err <- try(fct <- getS3method(as.character(expr[[1]]), cls), silent=TRUE) 114 | if(!is(err, "try-error"))break 115 | } 116 | # If there was no matching method, attempt to find the default method. If that fails, 117 | # raise an error 118 | if(is(err, "try-error")){ 119 | tryCatch(fct <- getS3method(as.character(expr[[1]]), "default"), 120 | error = function(e)stop(paste0("Illegal expression ", dprs(expr), ": ", 121 | "There is no matching S3 method or default for object, ", 122 | dprs(expr[[2]]), ", of class, ", cls,".\n"))) 123 | } 124 | } 125 | # Form preliminary match. If match.call raises an error here, the remaining code is 126 | # likely to give a misleading result. Catch the error merely to give a better diagnostic. 127 | tryCatch(expr <- match.call(fct, expr), 128 | error = function(e)stop(paste0("Illegal expression ", dprs(expr), ": ", 129 | dprs(expr[[1]]), " is not a function.\n"))) 130 | # Append named formals with default values which are not included 131 | # in the preliminary match 132 | fmls <- formals(fct) 133 | for(n in names(fmls)){ 134 | if(!isTRUE(fmls[[n]] == quote(expr=)) && !(n %in% names(expr[-1]))){ 135 | expr[n] <- fmls[n] 136 | } 137 | } 138 | # match call again, for order 139 | expr <- match.call(fct, expr) 140 | return(expr) 141 | } 142 | # Helpers 143 | isS3 <- function(fct)isTRUE(grep("UseMethod", body(fct)) > 0) 144 | dprs <- function(expr)deparse(expr, width.cutoff=500) 145 | -------------------------------------------------------------------------------- /R/rmd2df.R: -------------------------------------------------------------------------------- 1 | library(stringr) 2 | 3 | ## GET CORRECT ANSWER -- GENERIC AND METHODS 4 | 5 | get_corr_ans <- function(unit) UseMethod("get_corr_ans") 6 | 7 | get_corr_ans.default <- function(unit) { 8 | NA 9 | } 10 | 11 | get_corr_ans.cmd_question <- function(unit) { 12 | # Find code chunk delimeters 13 | beg_chunk <- grep("```{r", unit, fixed=TRUE) 14 | end_chunk <- grep("^```$", unit) 15 | 16 | if(length(beg_chunk) == 0 | length(end_chunk) == 0) { 17 | stop("You forgot to specify the correct answer on a command question!") 18 | } 19 | 20 | # Capture everything in between (exclusive) 21 | corr_ans <- unit[seq(beg_chunk + 1, end_chunk - 1)] 22 | 23 | # Check for comments 24 | if(any(grepl("#", corr_ans))) { 25 | stop("No comments allowed in correct answer!") 26 | } 27 | # Return correct answer 28 | corr_ans 29 | } 30 | 31 | get_corr_ans.mult_question <- function(unit) { 32 | corr_ans_ind <- grep("^_[1-9][.].+_$", unit) 33 | if(length(corr_ans_ind) == 0) { 34 | stop("You forgot to specify the correct answer on a multiple choice question!") 35 | } 36 | gsub("^_[1-9][.]\\s|_$", "", unit[corr_ans_ind]) 37 | } 38 | 39 | ## GET ANSWER CHOICES -- GENERIC AND METHODS 40 | 41 | get_ans_choices <- function(unit) UseMethod("get_ans_choices") 42 | 43 | get_ans_choices.default <- function(unit) { 44 | NA 45 | } 46 | 47 | get_ans_choices.mult_question <- function(unit) { 48 | # Find answer choices 49 | choice_ind <- grep("^_?[1-9][.]", unit) 50 | if(length(choice_ind) == 0) { 51 | stop("You forgot to specify answer choices!") 52 | } 53 | # Collapse answer choices 54 | collapse_choices(unit[choice_ind]) 55 | } 56 | 57 | ## GET ANSWER TESTS -- GENERIC AND METHODS 58 | 59 | get_ans_tests <- function(unit) UseMethod("get_ans_tests") 60 | 61 | get_ans_tests.default <- function(unit) { 62 | NA 63 | } 64 | 65 | get_ans_tests.cmd_question <- function(unit) { 66 | ans_tests_ind <- grep("*** .ans_tests", unit, fixed = TRUE) + 1 67 | if(length(ans_tests_ind) == 0) { 68 | #warning("No answer tests specified for a command question!") 69 | return(paste0("omnitest(correctExpr=\'", get_corr_ans(unit), "\')")) 70 | } 71 | unit[ans_tests_ind] 72 | } 73 | 74 | get_ans_tests.mult_question <- function(unit) { 75 | paste0("omnitest(correctVal=\'", get_corr_ans(unit), "\')") 76 | } 77 | 78 | ## GET HINT -- GENERIC AND METHODS 79 | 80 | get_hint <- function(unit) UseMethod("get_hint") 81 | 82 | get_hint.default <- function(unit) { 83 | NA 84 | } 85 | 86 | get_hint.cmd_question <- function(unit) { 87 | hint_ind <- grep("*** .hint", unit, fixed = TRUE) + 1 88 | if(length(hint_ind) == 0) stop("You forgot to specify a hint!") 89 | hint <- unit[hint_ind] 90 | } 91 | 92 | get_hint.mult_question <- function(unit) { 93 | hint_ind <- grep("*** .hint", unit, fixed = TRUE) + 1 94 | if(length(hint_ind) == 0) stop("You forgot to specify a hint!") 95 | hint <- unit[hint_ind] 96 | } 97 | 98 | ## GET FIGURE FILENAME AND TYPE -- GENERIC AND METHODS 99 | 100 | get_fig_filename <- function(unit) UseMethod("get_fig_filename") 101 | 102 | get_fig_filename.default <- function(unit) { 103 | NA 104 | } 105 | 106 | get_fig_filename.figure <- function(unit) { 107 | fig_ind <- grep("*** .figure", unit, fixed = TRUE) + 1 108 | if(length(fig_ind) == 0) stop("You forgot to specify a figure filename!") 109 | fig <- unit[fig_ind] 110 | } 111 | 112 | get_fig_type <- function(unit) UseMethod("get_fig_type") 113 | 114 | get_fig_type.default <- function(unit) { 115 | NA 116 | } 117 | 118 | get_fig_type.figure <- function(unit) { 119 | figtype_ind <- grep("*** .fig_type", unit, fixed = TRUE) + 1 120 | if(length(figtype_ind) == 0) stop("You forgot to specify a figure type!") 121 | figtype <- unit[figtype_ind] 122 | } 123 | 124 | ## GET VIDEO URL -- GENERIC AND METHODS 125 | 126 | get_video_url <- function(unit) UseMethod("get_video_url") 127 | 128 | get_video_url.default <- function(unit) { 129 | NA 130 | } 131 | 132 | get_video_url.video <- function(unit) { 133 | vid_ind <- grep("*** .video_url", unit, fixed = TRUE) + 1 134 | if(length(vid_ind) == 0) stop("You forgot to specify a video URL!") 135 | vid <- unit[vid_ind] 136 | } 137 | 138 | ## MAKE ROW 139 | 140 | make_row <- function(unit) { 141 | output <- unit[2] 142 | corr_ans <- get_corr_ans(unit) 143 | ans_choices <- get_ans_choices(unit) 144 | ans_tests <- get_ans_tests(unit) 145 | hint <- get_hint(unit) 146 | fig <- get_fig_filename(unit) 147 | fig_type <- get_fig_type(unit) 148 | vid_link <- get_video_url(unit) 149 | 150 | c(Class = class(unit), Output = output, CorrectAnswer = corr_ans, 151 | AnswerChoices = ans_choices, AnswerTests = ans_tests, Hint = hint, 152 | Figure = fig, FigureType = fig_type, VideoLink = vid_link) 153 | } 154 | 155 | ## UTILITIES 156 | 157 | # Return indices of YAML 158 | yaml_ind <- function(rmd) { 159 | yaml_end <- min(grep("=======", rmd, value=FALSE)) 160 | seq(1:yaml_end) 161 | } 162 | 163 | #' @importFrom yaml yaml.load 164 | get_yaml <- function(rmd) { 165 | # Find index of end of YAML 166 | yaml_end <- max(yaml_ind(rmd)) 167 | 168 | # Return lesson metadata 169 | sapply(seq(1, yaml_end - 1), function(i) yaml.load(rmd[i])) 170 | } 171 | 172 | clean_me <- function(rmd) { 173 | # Remove leading and trailing whitespace 174 | rmd_clean <- str_trim(rmd) 175 | 176 | # Remove empty lines 177 | rmd_clean <- rmd_clean[which(rmd_clean != "")] 178 | 179 | # Get rid of yaml 180 | rmd_clean[-yaml_ind(rmd_clean)] 181 | } 182 | 183 | into_units <- function(rmd) { 184 | # Separate rmd into groups based on units of instruction 185 | unit_num <- cumsum(str_detect(rmd, "^---")) 186 | 187 | # Return list of units 188 | split(rmd, unit_num) 189 | } 190 | 191 | get_unit_class <- function(unit) { 192 | cl <- str_split_fixed(unit[1], "&", 2)[2] 193 | valid_classes <- c("text", 194 | "cmd_question", 195 | "mult_question", 196 | "video", 197 | "figure") 198 | if(!cl %in% valid_classes) stop("Invalid unit class used!") 199 | cl 200 | } 201 | 202 | collapse_choices <- function(choices) { 203 | no_num <- gsub("^_?[1-9][.]\\s|_?$", "", choices) 204 | paste(no_num, collapse = "; ") 205 | } 206 | 207 | rmd2df <- function(rmd_path) { 208 | my_rmd <- readLines(rmd_path, warn=FALSE) 209 | # Get metadata from yaml - set as lesson attributes below 210 | meta <- get_yaml(my_rmd) 211 | cleaned <- clean_me(my_rmd) 212 | units <- into_units(cleaned) 213 | classes <- lapply(units, get_unit_class) 214 | units_with_class <- mapply(`class<-`, units, classes) 215 | rows <- sapply(units_with_class, make_row) 216 | 217 | # Assemble content data frame 218 | df <- as.data.frame(t(rows), stringsAsFactors=FALSE) 219 | 220 | # Return object of class "lesson" 221 | lesson(df, lesson_name=meta$`Lesson Name`, course_name=meta$`Course Name`, 222 | author=meta$Author, type=meta$Type, organization=meta$Organization, 223 | version=meta$Version) 224 | } -------------------------------------------------------------------------------- /R/swirl.R: -------------------------------------------------------------------------------- 1 | #' An interactive learning environment for R and statistics. 2 | #' 3 | #' This function presents a choice of course lessons and interactively 4 | #' tutors a user through them. A user may be asked to watch a video, to 5 | #' answer a multiple-choice or fill-in-the-blanks question, or to 6 | #' enter a command in the R console precisely as if he or she were 7 | #' using R in practice. Emphasis is on the last, interacting with the 8 | #' R console. User responses are tested for correctness and hints are 9 | #' given if appropriate. Progress is automatically saved so that a user 10 | #' may quit at any time and later resume without losing work. 11 | #' 12 | #' There are several ways to exit swirl: by typing \code{bye()} while in the R 13 | #' console, by hitting the Esc key while not in the R console, or by 14 | #' entering 0 from the swirl course menu. swirl will print a goodbye 15 | #' message whenever it exits. 16 | #' 17 | #' While swirl is in operation, it may be controlled by entering special 18 | #' commands in the R console. One of the special commands is \code{bye()} 19 | #' as discussed above. Others are \code{play()}, \code{nxt()}, \code{skip()}, 20 | #' and \code{info()}. The parentheses are important. 21 | #' 22 | #' Sometimes a user will want to play around in the R console without 23 | #' interference or commentary from swirl. This can be accomplished by 24 | #' using the special command \code{play()}. swirl will remain in operation, 25 | #' silently, until the special command \code{nxt()} is entered. 26 | #' 27 | #' The special command \code{skip()} can be used to skip a question if 28 | #' necessary. swirl will enter the correct answer and notify the 29 | #' user of the names of any new variables which it may have created 30 | #' in doing so. These may be needed for subsequent questions. 31 | #' 32 | #' Finally, \code{info()} may be used to display a list of the special commands 33 | #' themselves with brief explanations of what they do. 34 | #' @param resume.class for development only; please accept the default. 35 | #' @param ... arguments for special purposes only, such as lesson testing 36 | #' @export 37 | #' @importFrom stringr str_c str_trim str_split str_length 38 | #' @importFrom stringr str_detect str_locate fixed str_split_fixed 39 | #' @importFrom methods is 40 | #' @examples 41 | #' \dontrun{ 42 | #' 43 | #' swirl() 44 | #' } 45 | swirl <- function(resume.class="default", ...){ 46 | # Creates an environment, e, defines a function, cb, and registers 47 | # cb as a callback with data argument, e. The callback retains a 48 | # reference to the environment in which it was created, environment(cb), 49 | # hence that environment, which also contains e, persists as long 50 | # as cb remains registered. Thus e can be used to store infomation 51 | # between invocations of cb. 52 | removeTaskCallback("mini") 53 | # e lives here, in the environment created when swirl() is run 54 | e <- new.env(globalenv()) 55 | # This dummy object of class resume.class "tricks" the S3 system 56 | # into calling the proper resume method. We retain the "environment" 57 | # class so that as.list(e) works. 58 | class(e) <- c("environment", resume.class) 59 | # The callback also lives in the environment created when swirl() 60 | # is run and retains a reference to it. Because of this reference, 61 | # the environment which contains both e and cb() persists as 62 | # long as cb() remains registered. 63 | cb <- function(expr, val, ok, vis, data=e){ 64 | # The following will modify the persistent e 65 | e$expr <- expr 66 | e$val <- val 67 | e$ok <- ok 68 | e$vis <- vis 69 | # The result of resume() will determine whether the callback 70 | # remains active 71 | return(resume(e, ...)) 72 | } 73 | addTaskCallback(cb, name="mini") 74 | invisible() 75 | } 76 | 77 | ## SPECIAL COMMANDS 78 | 79 | #' Exit swirl. 80 | #' 81 | #' swirl operates by installing a callback function which responds 82 | #' to commands entered in the R console. This is how it captures 83 | #' and tests answers given by the user in the R console. swirl will 84 | #' remain in operation until this callback is removed, which is 85 | #' what \code{bye()} does. 86 | #' @export 87 | #' @examples 88 | #' \dontrun{ 89 | #' 90 | #' | Create a new variable called `x` that contains the number 3. 91 | #' 92 | #' > bye() 93 | #' 94 | #' | Leaving swirl now. Type swirl() to resume. 95 | #' } 96 | bye <- function(){ 97 | removeTaskCallback("mini") 98 | swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) 99 | invisible() 100 | } 101 | 102 | #' Begin the upcoming question or unit of instruction. 103 | #' 104 | #' This is the way to regain swirl's attention after viewing 105 | #' a video or \code{play()}'ing around in the console. 106 | #' @export 107 | #' @examples 108 | #' \dontrun{ 109 | #' 110 | #' | Create a new variable called `y` that contains the number 8. 111 | #' 112 | #' > play() 113 | #' 114 | #' | Entering play mode. Experiment as you please, then type nxt() 115 | #' | when you ready to resume the lesson. 116 | #' 117 | #' > 10/14 118 | #' > [1] 0.7142857 119 | #' > zz <- 99 120 | #' > zz 121 | #' > [1] 99 122 | #' > nxt() 123 | #' 124 | #' | Resuming lesson... 125 | #' } 126 | nxt <- function(){invisible()} 127 | 128 | #' Skip the current unit of instruction. 129 | #' 130 | #' swirl will enter the correct answer and notify the 131 | #' user of the names of any new variables which it may have created 132 | #' in doing so. These may be needed for subsequent questions. 133 | #' @export 134 | #' @examples 135 | #' \dontrun{ 136 | #' 137 | #' | Create a new variable called `y` that contains the number 8. 138 | #' 139 | #' > skip() 140 | #' 141 | #' | I've entered the correct answer for you. 142 | #' 143 | #' | In doing so, I've created the variable(s) y, which you may need later. 144 | #' } 145 | skip <- function(){invisible()} 146 | 147 | #' Start over on the current script question. 148 | #' 149 | #' During a script question, this will reset the script 150 | #' back to its original state, which can be helpful if you 151 | #' get stuck. 152 | #' @export 153 | reset <- function(){invisible()} 154 | 155 | #' Submit the active R script in response to a question. 156 | #' 157 | #' When a swirl question requires the user to edit an R script, the 158 | #' \code{submit()} function allows the user to submit their response. 159 | #' @export 160 | #' @examples 161 | #' \dontrun{ 162 | #' 163 | #' | Create a function called f that takes one argument, x, and 164 | #' | returns the value of x squared. 165 | #' 166 | #' > submit() 167 | #' 168 | #' | You are quite good my friend! 169 | #' } 170 | submit <- function(){invisible()} 171 | 172 | #' Tell swirl to ignore console input for a while. 173 | #' 174 | #' It is sometimes useful to play around in the R console out of 175 | #' curiosity or to solidify a concept. This command will cause 176 | #' swirl to remain idle, allowing the user to experiment at will, 177 | #' until the command \code{nxt()} is entered. 178 | #' @export 179 | #' @examples 180 | #' \dontrun{ 181 | #' 182 | #' | Create a new variable called `y` that contains the number 8. 183 | #' 184 | #' > play() 185 | #' 186 | #' | Entering play mode. Experiment as you please, then type nxt() 187 | #' | when you ready to resume the lesson. 188 | #' 189 | #' > 10/14 190 | #' > [1] 0.7142857 191 | #' > zz <- 99 192 | #' > zz 193 | #' > [1] 99 194 | #' > nxt() 195 | #' 196 | #' | Resuming lesson... 197 | #' } 198 | play <- function(){invisible()} 199 | 200 | #' Return to swirl's main menu. 201 | #' 202 | #' Return to swirl's main menu from a lesson in progress. 203 | #' @export 204 | #' @examples 205 | #' \dontrun{ 206 | #' 207 | #' | The simplest way to create a sequence of numbers in R is by using 208 | #' | the `:` operator. Type 1:20 to see how it works. 209 | #' 210 | #' > main() 211 | #' 212 | #' | Returning to the main menu... 213 | #' } 214 | main <- function(){invisible()} 215 | 216 | #' Restart the current swirl lesson. 217 | #' 218 | #' Restart the current swirl lesson. 219 | #' 220 | #' @export 221 | restart <- function(){invisible()} 222 | 223 | #' Display a list of special commands. 224 | #' 225 | #' Display a list of the special commands, \code{bye()}, \code{play()}, 226 | #' \code{nxt()}, \code{skip()}, and \code{info()}. 227 | #' @export 228 | info <- function(){ 229 | swirl_out(s()%N%"When you are at the R prompt (>):") 230 | swirl_out(s()%N%"-- Typing skip() allows you to skip the current question.", skip_before=FALSE) 231 | swirl_out(s()%N%"-- Typing play() lets you experiment with R on your own; swirl will ignore what you do...", skip_before=FALSE) 232 | swirl_out(s()%N%"-- UNTIL you type nxt() which will regain swirl's attention.", skip_before=FALSE) 233 | swirl_out(s()%N%"-- Typing bye() causes swirl to exit. Your progress will be saved.", skip_before=FALSE) 234 | swirl_out(s()%N%"-- Typing main() returns you to swirl's main menu.", skip_before=FALSE) 235 | swirl_out(s()%N%"-- Typing info() displays these options again.", skip_before=FALSE, skip_after=TRUE) 236 | invisible() 237 | } 238 | 239 | ## RESUME METHOD 240 | 241 | resume <- function(...)UseMethod("resume") 242 | 243 | # Default method resume implements a finite state (or virtual) machine. 244 | # It runs a fixed "program" consisting of three "instructions" which in 245 | # turn present information, capture a user's response, and test and retry 246 | # if necessary. The three instructions are themselves S3 methods which 247 | # depend on the class of the active row of the course lesson. The 248 | # instruction set is thus extensible. It can be found in R/instructionSet.R. 249 | 250 | resume.default <- function(e, ...){ 251 | # Specify additional arguments 252 | args_specification(e, ...) 253 | 254 | esc_flag <- TRUE 255 | on.exit(if(esc_flag)swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)) 256 | # Trap special functions 257 | if(uses_func("info")(e$expr)[[1]]){ 258 | esc_flag <- FALSE 259 | return(TRUE) 260 | } 261 | 262 | if(uses_func("nxt")(e$expr)[[1]]){ 263 | do_nxt(e) 264 | } 265 | 266 | # The user wants to reset their script to the original 267 | if(uses_func("reset")(e$expr)[[1]]) { 268 | do_reset(e) 269 | } 270 | 271 | # The user wants to submit their R script 272 | if(uses_func("submit")(e$expr)[[1]]){ 273 | do_submit(e) 274 | } 275 | 276 | if(uses_func("play")(e$expr)[[1]]){ 277 | do_play(e) 278 | } 279 | 280 | # If the user wants to skip the current question, do the bookkeeping. 281 | if(uses_func("skip")(e$expr)[[1]]){ 282 | # Increment a skip count kept in e. 283 | if(!exists("skips", e)) e$skips <- 0 284 | e$skips <- 1 + e$skips 285 | e$skipped <- TRUE 286 | # Enter the correct answer for the user 287 | # by simulating what the user should have done 288 | correctAns <- e$current.row[,"CorrectAnswer"] 289 | 290 | # If we are on a script question, the correct answer should 291 | # simply source the correct script 292 | if(is(e$current.row, "script") && is.na(correctAns)) { 293 | correct_script_path <- e$correct_script_temp_path 294 | if(file.exists(correct_script_path)) { 295 | # Get contents of the correct script 296 | e$script_contents <- readLines(correct_script_path, warn = FALSE) 297 | # Save expr to e 298 | e$expr <- try(parse(text = e$script_contents), silent = TRUE) 299 | # Source the correct script 300 | try(source(correct_script_path)) 301 | # Inform the user and open the correct script 302 | swirl_out(s()%N%"I just sourced the following script, which demonstrates one possible solution.", 303 | skip_after=TRUE) 304 | file.edit(correct_script_path) 305 | readline(s()%N%"Press Enter when you are ready to continue...") 306 | } 307 | 308 | # If this is not a script question... 309 | } else { 310 | # In case correctAns refers to newVar, add it 311 | # to the official list AND the global environment 312 | if(exists("newVarName",e)) { 313 | correctAns <- gsub("newVar", e$newVarName, correctAns) 314 | } 315 | e$expr <- parse(text=correctAns)[[1]] 316 | ce <- cleanEnv(e$snapshot) 317 | # evaluate e$expr keeping value and visibility information 318 | # store the result in temporary object evaluation in order 319 | # to avoid double potentially time consuming eval call 320 | evaluation <- withVisible(eval(e$expr, ce)) 321 | e$vis <- evaluation$visible 322 | e$val <- suppressMessages(suppressWarnings(evaluation$value)) 323 | xfer(ce, globalenv()) 324 | ce <- as.list(ce) 325 | 326 | # Inform the user and expose the correct answer 327 | swirl_out(s()%N%"Entering the following correct answer for you...", 328 | skip_after=TRUE) 329 | message("> ", e$current.row[, "CorrectAnswer"]) 330 | 331 | if(e$vis & !is.null(e$val)) { 332 | print(e$val) 333 | } 334 | } 335 | 336 | # Make sure playing flag is off since user skipped 337 | e$playing <- FALSE 338 | 339 | # If the user is not trying to skip and is playing, 340 | # ignore console input, but remain in operation. 341 | } else if(exists("playing", envir=e, inherits=FALSE) && e$playing) { 342 | esc_flag <- FALSE 343 | return(TRUE) 344 | } 345 | 346 | # If the user want to return to the main menu, do the bookkeeping 347 | if(uses_func("main")(e$expr)[[1]]){ 348 | do_main(e) 349 | } 350 | 351 | # If the user want to restart the lesson, do the bookkeeping 352 | if(uses_func("restart")(e$expr)[[1]]){ 353 | do_restart(e) 354 | } 355 | 356 | # If user is looking up a help file, ignore their input 357 | # unless the correct answer involves do so 358 | if(uses_func("help")(e$expr)[[1]] || 359 | uses_func("`?`")(e$expr)[[1]]){ 360 | # Get current correct answer 361 | corrans <- e$current.row[, "CorrectAnswer"] 362 | # Parse the correct answer 363 | corrans_parsed <- parse(text = corrans) 364 | # See if it contains ? or help 365 | uses_help <- uses_func("help")(corrans_parsed)[[1]] || 366 | uses_func("`?`")(corrans_parsed)[[1]] 367 | if(!uses_help) { 368 | esc_flag <- FALSE 369 | return(TRUE) 370 | } 371 | } 372 | 373 | # Method menu initializes or reinitializes e if necessary. 374 | temp <- mainMenu(e) 375 | # If menu returns FALSE, the user wants to exit. 376 | if(is.logical(temp) && !isTRUE(temp)){ 377 | swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) 378 | esc_flag <- FALSE # To supress double notification 379 | return(FALSE) 380 | } 381 | 382 | # if e$expr is NOT swirl() or nxt(), the user has just responded to 383 | # a question at the command line. Simulate evaluation of the 384 | # user's expression and save any variables changed or created 385 | # in e$delta. 386 | # TODO: Eventually make auto-detection of new variables an option. 387 | # Currently it can be set in customTests.R 388 | if(!uses_func("swirl")(e$expr)[[1]] && 389 | !uses_func("swirlify")(e$expr)[[1]] && 390 | !uses_func("testit")(e$expr)[[1]] && 391 | !uses_func("demo_lesson")(e$expr)[[1]] && 392 | !uses_func("nxt")(e$expr)[[1]] && 393 | isTRUE(customTests$AUTO_DETECT_NEWVAR)) { 394 | e$delta <- mergeLists(safeEval(e$expr, e), e$delta) 395 | } 396 | # Execute instructions until a return to the prompt is necessary 397 | while(!e$prompt){ 398 | # If the lesson is complete, save progress, remove the current 399 | # lesson from e, and invoke the top level menu method. 400 | # Below, min() ignores e$test_to if it is NULL (i.e. not in 'test' mode) 401 | if(e$row > min(nrow(e$les), e$test_to)) { 402 | # If in test or datacamp mode, we don't want to run another lesson 403 | if(is(e, "test") || is(e, "datacamp")) { 404 | post_finished(e) 405 | esc_flag <- FALSE # to supress double notification 406 | return(FALSE) 407 | } 408 | saveProgress(e) 409 | # form a new path for the progress file 410 | # which indicates completion and doesn't 411 | # fit the regex pattern "[.]rda$" i.e. 412 | # doesn't end in .rda, hence won't be 413 | # recognized as an active progress file. 414 | new_path <- paste(e$progress,".done", sep="") 415 | # rename the progress file to indicate completion 416 | if(file.exists(new_path))file.remove(new_path) 417 | file.rename(e$progress, new_path) 418 | # Coursera check 419 | courseraCheck(e) 420 | # remove the current lesson and any custom tests 421 | if(exists("les", e, inherits=FALSE)){ 422 | rm("les", envir=e, inherits=FALSE) 423 | } 424 | # Reset skip count if it exists 425 | if(exists("skips", e)) e$skips <- 0 426 | clearCustomTests() 427 | 428 | # Save log 429 | if(isTRUE(getOption("swirl_logging"))){ 430 | saveLog(e) 431 | } 432 | 433 | # Let user know lesson is complete 434 | swirl_out(s()%N%"You've reached the end of this lesson! Returning to the main menu...") 435 | # let the user select another course lesson 436 | temp <- mainMenu(e) 437 | # if menu returns FALSE, user wants to quit. 438 | if(is.logical(temp) && !isTRUE(temp)){ 439 | swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) 440 | esc_flag <- FALSE # to supress double notification 441 | return(FALSE) 442 | } 443 | } 444 | # If we are ready for a new row, prepare it 445 | if(e$iptr == 1){ 446 | # Display progress 447 | post_progress(e) 448 | 449 | # Any variables changed or created during the previous 450 | # question must have been correct or we would not be about 451 | # to advance to a new row. Incorporate these in the list 452 | # of swirl's "official" names and values. 453 | if (!is.null(e$delta)){ 454 | e$snapshot <- mergeLists(e$delta,e$snapshot) 455 | } 456 | e$delta <- list() 457 | saveProgress(e) 458 | e$current.row <- e$les[e$row,] 459 | # Prepend the row's swirl class to its class attribute 460 | class(e$current.row) <- c(e$current.row[,"Class"], 461 | class(e$current.row)) 462 | } 463 | 464 | # Execute the current instruction 465 | e$instr[[e$iptr]](e$current.row, e) 466 | # Check if a side effect, such as a sourced file, has changed the 467 | # values of any variables in the official list. If so, add them 468 | # to the list of changed variables. 469 | for(nm in names(e$snapshot)){ 470 | if(exists(nm, globalenv()) && 471 | !identical(e$snapshot[[nm]], get(nm, globalenv()))){ 472 | e$delta[[nm]] <- get(nm, globalenv()) 473 | } 474 | } 475 | } 476 | 477 | e$prompt <- FALSE 478 | esc_flag <- FALSE 479 | return(TRUE) 480 | } 481 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/swirldev/swirl/25938d2ba2f1d00c50c1a1dece19623648f796cf/R/sysdata.rda -------------------------------------------------------------------------------- /R/testthat_legacy.R: -------------------------------------------------------------------------------- 1 | # The versions of the functions below have been graciously borrowed 2 | # from version 0.11.0 of the testthat package by 3 | # Hadley Wickham and others at RStudio. These APIs 4 | # were broken in later versions of testthat and we know the 5 | # old version works for our purposes. 6 | 7 | expectation_legacy <- function(passed, failure_msg, 8 | success_msg = "unknown", 9 | srcref = NULL) { 10 | structure( 11 | list( 12 | passed = passed, 13 | error = FALSE, 14 | skipped = FALSE, 15 | failure_msg = failure_msg, 16 | success_msg = success_msg, 17 | srcref = srcref 18 | ), 19 | class = "expectation" 20 | ) 21 | } 22 | 23 | #' @importFrom testthat compare 24 | equals_legacy <- function(expected, label = NULL, ...) { 25 | if (is.null(label)) { 26 | label <- findExpr("expected") 27 | } else if (!is.character(label) || length(label) != 1) { 28 | label <- deparse(label) 29 | } 30 | 31 | function(actual) { 32 | same <- compare(actual, expected, ...) 33 | 34 | expectation_legacy( 35 | same$equal, 36 | paste0("not equal to ", label, "\n", same$message), 37 | paste0("equals ", label) 38 | ) 39 | } 40 | } 41 | 42 | is_a_legacy <- function(class) { 43 | function(x) { 44 | actual_s <- paste0(class(x), collapse = ", ") 45 | class_s <- paste(class, collapse = ", ") 46 | expectation_legacy( 47 | inherits(x, class), 48 | paste0("inherits from ", actual_s, " not ", class_s), 49 | paste0("inherits from ", class_s) 50 | ) 51 | } 52 | } 53 | 54 | is_equivalent_to_legacy <- function(expected, label = NULL) { 55 | if (is.null(label)) { 56 | label <- findExpr("expected") 57 | } else if (!is.character(label) || length(label) != 1) { 58 | label <- deparse(label) 59 | } 60 | function(actual) { 61 | equals_legacy(expected, check.attributes = FALSE)(actual) 62 | } 63 | } 64 | 65 | is_identical_to_legacy <- function(expected, label = NULL) { 66 | if (is.null(label)) { 67 | label <- findExpr("expected") 68 | } else if (!is.character(label) || length(label) != 1) { 69 | label <- deparse(label) 70 | } 71 | 72 | function(actual) { 73 | if (identical(actual, expected)) { 74 | diff <- "" 75 | } else { 76 | same <- all.equal(expected, actual) 77 | if (isTRUE(same)) { 78 | diff <- "Objects equal but not identical" 79 | } else { 80 | diff <- paste0(same, collapse = "\n") 81 | } 82 | } 83 | 84 | expectation_legacy( 85 | identical(actual, expected), 86 | paste0("is not identical to ", label, ". Differences: \n", diff), 87 | paste0("is identical to ", label) 88 | ) 89 | } 90 | } 91 | 92 | matches_legacy <- function(regexp, all = TRUE, ...) { 93 | stopifnot(is.character(regexp), length(regexp) == 1) 94 | function(char) { 95 | matches <- grepl(regexp, char, ...) 96 | if (length(char) > 1) { 97 | values <- paste0("Actual values:\n", 98 | paste0("* ", encodeString(char), collapse = "\n")) 99 | } else { 100 | values <- paste0("Actual value: \"", encodeString(char), "\"") 101 | } 102 | 103 | expectation_legacy( 104 | length(matches) > 0 && if (all) all(matches) else any(matches), 105 | paste0("does not match '", encodeString(regexp), "'. ", values), 106 | paste0("matches '", encodeString(regexp), "'") 107 | ) 108 | } 109 | } -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | swirl_out <- function(..., skip_before=TRUE, skip_after=FALSE) { 2 | wrapped <- strwrap(str_c(..., sep = " "), 3 | width = getOption("width") - 2) 4 | mes <- str_c("| ", wrapped, collapse = "\n") 5 | if(skip_before) mes <- paste0("\n", mes) 6 | if(skip_after) mes <- paste0(mes, "\n") 7 | Encoding(mes) <- "UTF-8" 8 | message(mes) 9 | } 10 | 11 | # Takes a plain English name and turns it into a more proper 12 | # file or directory name 13 | make_pathname <- function(name) { 14 | gsub(" ", "_", str_trim(name)) 15 | } 16 | 17 | xfer <- function(env1, env2){ 18 | if(length(ls(env1))==0)return() 19 | lapply(ls(env1), function(var)getAssign(var, env1, env2)) 20 | } 21 | 22 | getAssign <- function(var, env1, env2){ 23 | assign(var, get(var, env1, inherits=FALSE), envir=env2) 24 | } 25 | 26 | cleanAdmin <- function(){ 27 | udat <- file.path(find.package("swirl"), "user_data", "swirladmin") 28 | file.remove(dir(udat, pattern="*[.]rda", full.names=TRUE)) 29 | invisible() 30 | } 31 | 32 | mergeLists <- function(sourceList, destList){ 33 | for (n in names(sourceList)){ 34 | destList[[n]] <- sourceList[[n]] 35 | } 36 | return(destList) 37 | } 38 | 39 | # Evaluates a user's expression in a clean environment 40 | # whose parent is a snapshot of the previous official 41 | # environment, i.e., the same environment in which 42 | # the user entered the expression. Any values required 43 | # for evaluation will be found in the snapshot. Any variables 44 | # changed or created by the expression will appear in the 45 | # clean environment, even if nothing changes in the global. 46 | # 47 | # For example, if x already has the value c(1, 2, 3) and 48 | # the user enters x <- c(1, 2, 3), nothing will change 49 | # in the global environment, but x with the value c(1, 2, 3) 50 | # will appear in the clean environment. 51 | # 52 | # In case the user's expression involves random numbers, the 53 | # values of variables which appear in the clean environment 54 | # are copied from the global environment. 55 | # 56 | # For example, if the user enters x <- rnorm(100), then 57 | # evaluating the expression in a clean environment will create 58 | # a variable named x, but it will have a different value 59 | # than that created by the user. 60 | # 61 | safeEval <- function(expr, e){ 62 | e1 <- cleanEnv(e$snapshot) 63 | ans <- list() 64 | temp <- capture.output( 65 | try(suppressMessages(suppressWarnings(eval(expr,e1))), silent=TRUE) 66 | ) 67 | if(is(temp, "try-error"))return(ans) 68 | for (x in ls(e1)){ 69 | if(exists(x,globalenv())) 70 | ans[[x]] <- get(x,globalenv()) 71 | } 72 | return(ans) 73 | } 74 | 75 | # Creates a clean environment whose parent is 76 | # a snapshot of the official environment in an 77 | # earlier state. The snapshot itself is given the 78 | # same parent as the global environment, which will 79 | # consist of loaded namespaces and packages. 80 | # 81 | # Environments in R are subject to reference semantics, 82 | # i.e., all references refer to the same copy. Hence, 83 | # the state of an environment cannot be saved for later 84 | # comparison merely by creating a second reference. Any 85 | # change in the environment will affect all references. 86 | # Lists, however, have R's usual copy-on-modify semantics. 87 | # If snapshot <- as.list(globalenv()), a subsequent change 88 | # in the global environment will not cause a change in 89 | # the list (with the exotic exception of environments 90 | # contained in the global environment.) 91 | # 92 | # Clean environments can be used to detect variables 93 | # changed or created by a user, as in function safeEval. 94 | # They can also be used to check the correctness of 95 | # a value computed by a user. 96 | # 97 | # For example, if the user enters x <- 2*x, then the 98 | # value of x in the global environment will have changed, 99 | # but if the expression is evaluated in a clean environment 100 | # the value of x on the right will be found in the snapshot 101 | # hence will be the same as that found by the user. 102 | # 103 | cleanEnv <- function(snapshot){ 104 | # clone of snapshot 105 | pe <- if(length(snapshot) > 0){ 106 | as.environment(as.list(snapshot)) 107 | } else { 108 | new.env() 109 | } 110 | parent.env(pe) <- globalenv() 111 | # return new environment whose parent is pe 112 | return(new.env(parent=pe)) 113 | } 114 | 115 | 116 | # LESSON PACKAGE DEPENDENCY SUPPORT 117 | 118 | # Load lesson package dependencies quietly 119 | loadDependencies <- function(lesson_dir) { 120 | depends <- file.path(lesson_dir, "dependson.txt") 121 | if(file.exists(depends)) { 122 | packages_as_chars <- setdiff(readLines(depends, warn=FALSE), "") 123 | # If the dependson file is empty, then proceed with lesson 124 | if(length(packages_as_chars) == 0) return(TRUE) 125 | swirl_out(s()%N%"Attempting to load lesson dependencies...") 126 | for(p in packages_as_chars) { 127 | p <- gsub("^\\s+|\\s+$", "", p) # trim leading and trailing whitespace 128 | if(suppressPackageStartupMessages( 129 | suppressWarnings( 130 | suppressMessages(require(p, character.only=TRUE, quietly=TRUE))))) { 131 | swirl_out(s()%N%"Package", sQuote(p), s()%N%"loaded correctly!") 132 | } else { 133 | swirl_out(s()%N%"This lesson requires the", sQuote(p), 134 | s()%N%"package. Would you like me to install it for you now?") 135 | yn <- select.list(choices=c(s()%N%"Yes", s()%N%"No"), graphics=FALSE) 136 | if(yn == s()%N%"Yes") { 137 | swirl_out(s()%N%"Trying to install package", sQuote(p), s()%N%"now...") 138 | install.packages(p, quiet=TRUE) 139 | if(suppressPackageStartupMessages( 140 | suppressWarnings( 141 | suppressMessages(require(p, 142 | character.only=TRUE, 143 | quietly=TRUE))))) { 144 | swirl_out(s()%N%"Package", sQuote(p), s()%N%"loaded correctly!") 145 | } else { 146 | swirl_out(s()%N%"Could not install package", paste0(sQuote(p), "!")) 147 | return(FALSE) 148 | } 149 | } else { 150 | return(FALSE) 151 | } 152 | } 153 | } 154 | } 155 | # If loop completes, then print a blank line and return TRUE 156 | cat("\n") 157 | return(TRUE) 158 | } 159 | 160 | # Execute correct answers for rows 1 through 'up_through' of lesson 161 | complete_part <- function(e) { 162 | up_through <- e$test_from - 1 163 | # Get rows though 'up_through' argument 164 | les <- e$les[seq(up_through), ] 165 | # Execute previous correct answers in global env 166 | exec_cmd <- function(row) { 167 | if(row['Class'] == "cmd_question") { 168 | eval(parse(text = row['CorrectAnswer']), envir=globalenv()) 169 | } else if(row['Class'] == "script") { 170 | orig_script_name <- row['Script'] 171 | correct_script_name <- paste0( 172 | tools::file_path_sans_ext(orig_script_name), "-correct.R") 173 | correct_script_path <- file.path(e$path, "scripts", 174 | correct_script_name) 175 | if(file.exists(correct_script_path)) { 176 | try(source(correct_script_path)) 177 | } else { 178 | stop("Correct script not found at ", correct_script_path) 179 | } 180 | } 181 | } 182 | message("Completing the first part of the lesson for you...\n") 183 | apply(les, 1, exec_cmd) 184 | invisible() 185 | } 186 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(...) { 2 | if(length(ls(envir=globalenv())) > 0) { 3 | packageStartupMessage( 4 | make_pretty(s()%N%"Hi! I see that you have some variables saved in your", 5 | s()%N%"workspace. To keep things running smoothly, I recommend you clean up", 6 | s()%N%"before starting swirl.", skip_after=TRUE), 7 | make_pretty(s()%N%"Type ls() to see a list of the variables in your workspace.", 8 | s()%N%"Then, type rm(list=ls()) to clear your workspace.", skip_after=TRUE), 9 | make_pretty(s()%N%"Type swirl() when you are ready to begin.", skip_after=TRUE) 10 | ) 11 | } else { 12 | packageStartupMessage( 13 | make_pretty(s()%N%"Hi! Type swirl() when you are ready to begin.", 14 | skip_after=TRUE) 15 | ) 16 | } 17 | invisible() 18 | } 19 | 20 | make_pretty <- function(..., skip_before=TRUE, skip_after=FALSE) { 21 | wrapped <- strwrap(str_c(..., sep = " "), 22 | width = getOption("width") - 2) 23 | mes <- str_c("| ", wrapped, collapse = "\n") 24 | if(skip_before) mes <- paste0("\n", mes) 25 | if(skip_after) mes <- paste0(mes, "\n") 26 | mes 27 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # swirl 2 | 3 | [![Build Status](https://travis-ci.org/swirldev/swirl.png?branch=master)](https://travis-ci.org/swirldev/swirl) 4 | [![CRAN version](http://www.r-pkg.org/badges/version/swirl?color=3399ff)](https://cran.r-project.org/package=swirl) 5 | [![Downloads](http://cranlogs.r-pkg.org/badges/swirl?color=3399ff)](http://cran-logs.rstudio.com/) 6 | 7 | ### [http://swirlstats.com](http://swirlstats.com) 8 | 9 | swirl is a platform for learning (and teaching) statistics and R simultaneously 10 | and interactively. It presents a choice of course lessons and interactively 11 | tutors a student through them. A student may be asked to watch a video, to answer a 12 | multiple-choice or fill-in-the-blanks question, or to enter a command in the R 13 | console precisely as if he or she were using R in practice. Emphasis is on the 14 | last, interacting with the R console. User responses are tested for correctness 15 | and hints are given if appropriate. Progress is automatically saved so that a 16 | user may quit at any time and later resume without losing work. 17 | 18 | swirl leans heavily on exercising a student's use of the R console. A callback 19 | mechanism, suggested and first demonstrated for the purpose by Hadley Wickham, 20 | is used to capture student input and to provide immediate feedback relevant to 21 | the course material at hand. 22 | 23 | [swirlify](https://github.com/swirldev/swirlify) is a separate R package that 24 | provides a comprehensive toolbox for swirl instructors. Content is authored in 25 | [YAML](http://en.wikipedia.org/wiki/YAML) using the handy tools described on 26 | the [instructors page](http://swirlstats.com/instructors.html) of our website. 27 | 28 | The program is initiated with `swirl()`. Functions which control swirl's 29 | behavior include `bye()` to quit, `skip()` to skip a question, `main()` to 30 | return to the main menu, `play()` to allow experimentation in the R console 31 | without interference from swirl, `nxt()` to resume interacting with swirl, and 32 | `info()` to display a help menu. 33 | 34 | 35 | ## Installing swirl (from CRAN) 36 | 37 | The easiest way to install and run swirl is by typing the following from the R console: 38 | 39 | ``` 40 | install.packages("swirl") 41 | library(swirl) 42 | swirl() 43 | ``` 44 | 45 | As we continue adding new features and content, we will make new versions 46 | available on CRAN as appropriate (every 1-2 months, most likely). 47 | 48 | ## Installing the latest development version (from GitHub) 49 | 50 | To access the most recent features and content, you can install and run the 51 | development version of swirl using the [devtools](https://github.com/hadley/devtools) package: 52 | 53 | ``` 54 | install.packages("devtools") 55 | devtools::install_github("swirldev/swirl", ref = "dev") 56 | library(swirl) 57 | swirl() 58 | ``` 59 | 60 | ## Contributing to swirl's development 61 | 62 | If you'd like to get involved, please fork this repository and submit a pull 63 | request with your proposed changes. We're happy to chat if you have any 64 | questions about the source code. 65 | 66 | ## Using swirl in the classroom 67 | 68 | Instructors around the world are using swirl in their classrooms. We think this 69 | is awesome. If you're an instructor, please feel free to do the same -- free of 70 | charge. While your students may be paying to take your course or attend your 71 | institution, we simply ask that you don't charge people *directly* for the use 72 | of our software or instructional content. 73 | 74 | If you are not sure about a particular use case, don't hesitate to send us an 75 | email at info@swirlstats.com. 76 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Release summary 2 | 3 | This is the first attempted CRAN release of swirl 2.4.5. 4 | 5 | ## Test environments 6 | 7 | * local macOS Sierra install, R 3.6.1 8 | * Ubuntu 16.04 (on travis-ci), R 3.6.1, R 3.5.3, R-devel. 9 | * win-builder (release) 10 | 11 | ## R CMD check results 12 | 13 | There were no ERRORs, WARNINGs or NOTEs. -------------------------------------------------------------------------------- /inst/Courses/suggested_courses.yaml: -------------------------------------------------------------------------------- 1 | - Course: R Programming 2 | Description: The basics of programming in R 3 | Install: install_course('R_Programming') 4 | 5 | - Course: Regression Models 6 | Description: The basics of regression modeling in R 7 | Install: install_course('Regression_Models') 8 | 9 | - Course: Statistical Inference 10 | Description: The basics of statistical inference in R 11 | Install: install_course('Statistical_Inference') 12 | 13 | - Course: Exploratory Data Analysis 14 | Description: The basics of exploring data in R 15 | Install: install_course('Exploratory_Data_Analysis') 16 | 17 | -------------------------------------------------------------------------------- /inst/test/test-encoding.yaml: -------------------------------------------------------------------------------- 1 | - Class: meta 2 | Course: MyCourse 3 | Lesson: MyLesson 4 | Author: your name goes here 5 | Type: Standard 6 | Organization: your organization's name goes here 7 | Version: 2.3.0 8 | 9 | - Class: text 10 | Output: put your text output here 11 | 12 | - Class: text 13 | Output: 中文測試 14 | 15 | - Class: mult_question 16 | Output: ask the multiple choice question here 17 | AnswerChoices: ANS;2;3 18 | CorrectAnswer: ANS 19 | AnswerTests: omnitest(correctVal= 'ANS') 20 | Hint: hint 21 | 22 | - Class: script 23 | Output: explain what the user must do here 24 | AnswerTests: custom_test_name() 25 | Hint: hint 26 | Script: script-name.R 27 | 28 | - Class: exact_question 29 | Output: explain the question here 30 | CorrectAnswer: n 31 | AnswerTests: omnitest(correctVal=n) 32 | Hint: hint 33 | 34 | - Class: text_question 35 | Output: explain the question here 36 | CorrectAnswer: answer 37 | AnswerTests: omnitest(correctVal='answer') 38 | Hint: hint 39 | 40 | - Class: figure 41 | Output: explain the figure here 42 | Figure: sourcefile.R 43 | FigureType: new or add -------------------------------------------------------------------------------- /man/AnswerTests.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{AnswerTests} 4 | \alias{AnswerTests} 5 | \title{Answer Tests} 6 | \description{ 7 | Answer tests are how swirl determines whether a user has answered 8 | a question correctly or not. Each question has one or more answer 9 | tests associated with it, all of which must be satisfied in order for 10 | a user's response to be considered correct. As the instructor, you 11 | can specify any combination of our predefined answer tests or create your 12 | own custom answer tests to suit your specific needs. This document will 13 | explain your options. 14 | } 15 | \details{ 16 | For each question that you author as part of a swirl lesson, you 17 | must specify exactly one \emph{correct answer}. This is separate and 18 | distinct from the answer tests. This does not have to be 19 | the only correct answer, but it must answer the question correctly. 20 | If a user \code{\link{skip}}s your question, this is the answer that will be 21 | entered on his or her behalf. 22 | 23 | If you're using the \href{https://github.com/swirldev/swirlify}{swirlify} 24 | authoring tool, the correct answer will 25 | be automatically translated into the appropriate answer test for most 26 | question types. Questions that require the user to enter a valid 27 | command at the R prompt (which we'll refer to as \emph{command questions}) 28 | are the only exception. Since there are often many possible ways to 29 | answer a command question, you must determine how you'd like swirl to 30 | assess the correctness of a user's response. This is where answer 31 | tests come in. 32 | 33 | You can specify any number of answer tests. If you use more than one, you 34 | must separate them with semicolons. If you do not specify any answer tests 35 | for a command question, then the default test will be used. The default 36 | test is \code{omnitest(correctExpr='')}, which will 37 | simply check that the user's expression matches the expression that you 38 | provided as a correct answer. 39 | 40 | In many cases, the default answer test will provide sufficient vetting of 41 | a user's response to a command question. While it is somewhat restrictive 42 | in the sense that it requires an exact match of expressions (ignoring 43 | whitespace), it is liberating to the course author for two reasons. 44 | \enumerate{ 45 | \item It allows for fast prototyping of content. As you're developing 46 | content, you may find that determining how to test for correctness 47 | distracts you from the message you're trying to communicate. 48 | \item You don't have to worry about what happens if the user enters 49 | an incorrect response, but is allowed to proceed because of an oversight 50 | in the answer tests. Since swirl sessions are continuous, accepting 51 | an incorrect answer early in a lesson can cause problems later on. By 52 | using the default answer test, you eliminate this burden by requiring an 53 | exact match of expressions and hence not allowing the user to advance 54 | until you are certain they've entered the correct response. 55 | } 56 | 57 | It's important to keep in mind that as your content matures, you can always 58 | go back and make your answer testing strategy more elaborate. The main 59 | benefit of using tests other than the default is that the user will not be 60 | required to enter an expression exactly the way you've specified it. He or 61 | she will have more freedom in terms of how they respond to a question, as 62 | long as they satisfy the conditions that you see as being most important. 63 | } 64 | \section{Predefined Answer Tests}{ 65 | 66 | Each of the predefined answer tests listed below has 67 | its own help file, where you'll find more detailed explanations and 68 | examples. 69 | 70 | \code{\link{any_of_exprs}}: Test that the user's expression matches any of several possible expressions. 71 | 72 | \code{\link{calculates_same_value}}: Test that the user's expression evaluates to a certain value. 73 | 74 | \code{\link{expr_creates_var}}: Test that a new variable has been created. 75 | 76 | \code{\link{expr_identical_to}}: Test that the user has entered a particular expression. 77 | 78 | \code{\link{expr_is_a}}: Test that the expression itself is of a specific \code{\link{class}}. 79 | 80 | \code{\link{expr_uses_func}}: Test that a particular function has been used. 81 | 82 | \code{\link{func_of_newvar_equals}}: Test the result of a computation such as \code{mean(newVar)} applied to a specific (user-named) variable created in a previous question. 83 | 84 | \code{\link{omnitest}}: Test for a correct expression, a correct value, or both. 85 | 86 | \code{\link{val_has_length}}: Test that the value of the expression has a particular \code{\link{length}}. 87 | 88 | \code{\link{val_matches}}: Test that the user's expression matches a regular expression (\code{\link{regex}}). 89 | 90 | \code{\link{var_is_a}}: Test that the \emph{value} of the expression is of a specific \code{\link{class}}. 91 | } 92 | 93 | \section{Custom Answer Tests}{ 94 | 95 | Occasionally, you may want to test something that is outside the scope of 96 | our predefined answer tests. Fortunately, this is very easy to do. If you 97 | are using the swirlify authoring tool, then a file called 98 | \code{customTests.R} (case-sensitive) is automatically created in the lesson 99 | directory. If it's not there already, you can create the file manually. 100 | 101 | In this file, you can write your own answer tests. These answer tests are 102 | then available to you just the same as any of the standard tests. However, 103 | the scope of a custom answer test is limited to the lesson within which 104 | you've defined it. 105 | 106 | Each custom answer test is simply an R function that follows a few 107 | basic rules: 108 | \enumerate{ 109 | \item Give the function a distinct name that will help you remember what 110 | is does (e.g. \code{creates_matrix_with_n_rows}). 111 | \item The first line of the function body is 112 | \code{e <- get("e", parent.frame())}, which gives you access to the 113 | environment \code{e}. Any important information, such as the expression 114 | typed by the user, will be available to you through \code{e}. 115 | \item Access the expression entered by the user with \code{e$expr} and 116 | the value of the expression with \code{e$val}. 117 | Note that \code{e$expr} comes in 118 | the form of an unevaluated R \code{\link{expression}}. 119 | \item The function returns \code{TRUE} if the test is passed and 120 | \code{FALSE} otherwise. You should be careful that no other 121 | value could be returned (e.g. \code{NA}, \code{NULL}, etc.) 122 | } 123 | } 124 | 125 | \seealso{ 126 | Other AnswerTests: 127 | \code{\link{any_of_exprs}()}, 128 | \code{\link{calculates_same_value}()}, 129 | \code{\link{expr_creates_var}()}, 130 | \code{\link{expr_identical_to}()}, 131 | \code{\link{expr_is_a}()}, 132 | \code{\link{expr_uses_func}()}, 133 | \code{\link{func_of_newvar_equals}()}, 134 | \code{\link{omnitest}()}, 135 | \code{\link{val_has_length}()}, 136 | \code{\link{val_matches}()}, 137 | \code{\link{var_is_a}()} 138 | } 139 | \concept{AnswerTests} 140 | -------------------------------------------------------------------------------- /man/InstallCourses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{InstallCourses} 4 | \alias{InstallCourses} 5 | \title{Installing Courses} 6 | \description{ 7 | swirl is designed so that anyone can create interactive content 8 | and share it with the world or with just a few people. Users can 9 | install courses from a variety of sources using the 10 | functions listed here. Each of these functions has its own help 11 | file, which you can consult for more details. 12 | } 13 | \details{ 14 | If you're just getting started, we recommend using 15 | \code{\link{install_course}} to install courses 16 | from our official \href{https://github.com/swirldev/swirl_courses}{course repository}. Otherwise, check out the 17 | help file for the relevant install function below. 18 | 19 | You can uninstall a course from swirl at any time with 20 | \code{\link{uninstall_course}}. 21 | 22 | Uninstall all courses with 23 | \code{\link{uninstall_all_courses}}. 24 | } 25 | \seealso{ 26 | Other InstallCourses: 27 | \code{\link{install_course_directory}()}, 28 | \code{\link{install_course_dropbox}()}, 29 | \code{\link{install_course_github}()}, 30 | \code{\link{install_course_google_drive}()}, 31 | \code{\link{install_course_url}()}, 32 | \code{\link{install_course_zip}()}, 33 | \code{\link{install_course}()}, 34 | \code{\link{install_from_swirl}()}, 35 | \code{\link{uninstall_all_courses}()}, 36 | \code{\link{uninstall_course}()}, 37 | \code{\link{zip_course}()} 38 | } 39 | \concept{InstallCourses} 40 | -------------------------------------------------------------------------------- /man/any_of_exprs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{any_of_exprs} 4 | \alias{any_of_exprs} 5 | \title{Test that the user has entered one of several possible expressions.} 6 | \usage{ 7 | any_of_exprs(...) 8 | } 9 | \arguments{ 10 | \item{...}{any number of expressions, as character strings} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Returns \code{TRUE} if the expression the user has entered 17 | matches any of the expressions given (as character strings) in 18 | the argument. 19 | } 20 | \examples{ 21 | \dontrun{ 22 | 23 | # Test that a user has entered either cor(x, y) or cor(y, x) 24 | any_of_exprs('cor(x, y)', 'cor(y, x)') 25 | } 26 | } 27 | \seealso{ 28 | Other AnswerTests: 29 | \code{\link{AnswerTests}}, 30 | \code{\link{calculates_same_value}()}, 31 | \code{\link{expr_creates_var}()}, 32 | \code{\link{expr_identical_to}()}, 33 | \code{\link{expr_is_a}()}, 34 | \code{\link{expr_uses_func}()}, 35 | \code{\link{func_of_newvar_equals}()}, 36 | \code{\link{omnitest}()}, 37 | \code{\link{val_has_length}()}, 38 | \code{\link{val_matches}()}, 39 | \code{\link{var_is_a}()} 40 | } 41 | \concept{AnswerTests} 42 | -------------------------------------------------------------------------------- /man/bye.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{bye} 4 | \alias{bye} 5 | \title{Exit swirl.} 6 | \usage{ 7 | bye() 8 | } 9 | \description{ 10 | swirl operates by installing a callback function which responds 11 | to commands entered in the R console. This is how it captures 12 | and tests answers given by the user in the R console. swirl will 13 | remain in operation until this callback is removed, which is 14 | what \code{bye()} does. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | 19 | | Create a new variable called `x` that contains the number 3. 20 | 21 | > bye() 22 | 23 | | Leaving swirl now. Type swirl() to resume. 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /man/calculates_same_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{calculates_same_value} 4 | \alias{calculates_same_value} 5 | \title{Test that the user's expression evaluates to a certain value.} 6 | \usage{ 7 | calculates_same_value(expression) 8 | } 9 | \arguments{ 10 | \item{expression}{An expression whose value will be compared to the value 11 | of the user's expression.} 12 | } 13 | \value{ 14 | \code{TRUE} or \code{FALSE} 15 | } 16 | \description{ 17 | Test that the value calculated by the user's expression is the same as the 18 | value calculated by the given expression. 19 | } 20 | \examples{ 21 | \dontrun{ 22 | # Test that a user's expression evaluates to a certain value 23 | # 24 | calculates_same_value('matrix(1:20, nrow=4, ncol=5)') 25 | } 26 | } 27 | \seealso{ 28 | Other AnswerTests: 29 | \code{\link{AnswerTests}}, 30 | \code{\link{any_of_exprs}()}, 31 | \code{\link{expr_creates_var}()}, 32 | \code{\link{expr_identical_to}()}, 33 | \code{\link{expr_is_a}()}, 34 | \code{\link{expr_uses_func}()}, 35 | \code{\link{func_of_newvar_equals}()}, 36 | \code{\link{omnitest}()}, 37 | \code{\link{val_has_length}()}, 38 | \code{\link{val_matches}()}, 39 | \code{\link{var_is_a}()} 40 | } 41 | \concept{AnswerTests} 42 | -------------------------------------------------------------------------------- /man/delete_progress.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/progress.R 3 | \name{delete_progress} 4 | \alias{delete_progress} 5 | \title{Delete a user's progress} 6 | \usage{ 7 | delete_progress(user, path = NULL) 8 | } 9 | \arguments{ 10 | \item{user}{The user name whose progress will be deleted.} 11 | 12 | \item{path}{If specified, the directory where the user_data can be found} 13 | } 14 | \description{ 15 | Delete a user's progress 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | delete_progress("bill") 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /man/email_admin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/email_info.R 3 | \name{email_admin} 4 | \alias{email_admin} 5 | \title{Send diagnostic email to swirl admin} 6 | \usage{ 7 | email_admin() 8 | } 9 | \description{ 10 | Typing \code{email_admin()} at the prompt will attempt to open 11 | a new email in your default browser or email client. The email 12 | will include space for you to describe the problem you are 13 | experiencing. It will also have the output from \code{sessionInfo}, 14 | which you should not alter. 15 | } 16 | -------------------------------------------------------------------------------- /man/expr_creates_var.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{expr_creates_var} 4 | \alias{expr_creates_var} 5 | \title{Test that a new variable has been created.} 6 | \usage{ 7 | expr_creates_var(correctName = NULL) 8 | } 9 | \arguments{ 10 | \item{correctName}{expected name of the new variable or \code{NULL}} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Tests if the \code{e$expr} creates one new variable (of correct name 17 | if given.) If so, returns \code{TRUE}. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | # Test if the user has entered an expression which creates 22 | # a new variable of any name. 23 | expr_creates_var() 24 | # 25 | # Test if the user has entered an expression which creates 26 | # a variable named 'myNum' 27 | # 28 | expr_creates_var('myNum') 29 | } 30 | } 31 | \seealso{ 32 | Other AnswerTests: 33 | \code{\link{AnswerTests}}, 34 | \code{\link{any_of_exprs}()}, 35 | \code{\link{calculates_same_value}()}, 36 | \code{\link{expr_identical_to}()}, 37 | \code{\link{expr_is_a}()}, 38 | \code{\link{expr_uses_func}()}, 39 | \code{\link{func_of_newvar_equals}()}, 40 | \code{\link{omnitest}()}, 41 | \code{\link{val_has_length}()}, 42 | \code{\link{val_matches}()}, 43 | \code{\link{var_is_a}()} 44 | } 45 | \concept{AnswerTests} 46 | -------------------------------------------------------------------------------- /man/expr_identical_to.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{expr_identical_to} 4 | \alias{expr_identical_to} 5 | \title{Test that the user has entered a particular expression.} 6 | \usage{ 7 | expr_identical_to(correct_expression) 8 | } 9 | \arguments{ 10 | \item{correct_expression}{the correct or expected expression as a string} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Test that the user has entered an expression identical to that 17 | given as the first argument. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | # Test that a user has entered a particular command 22 | # 23 | expr_identical_to('myVar <- c(3, 5, 7)') 24 | } 25 | } 26 | \seealso{ 27 | Other AnswerTests: 28 | \code{\link{AnswerTests}}, 29 | \code{\link{any_of_exprs}()}, 30 | \code{\link{calculates_same_value}()}, 31 | \code{\link{expr_creates_var}()}, 32 | \code{\link{expr_is_a}()}, 33 | \code{\link{expr_uses_func}()}, 34 | \code{\link{func_of_newvar_equals}()}, 35 | \code{\link{omnitest}()}, 36 | \code{\link{val_has_length}()}, 37 | \code{\link{val_matches}()}, 38 | \code{\link{var_is_a}()} 39 | } 40 | \concept{AnswerTests} 41 | -------------------------------------------------------------------------------- /man/expr_is_a.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{expr_is_a} 4 | \alias{expr_is_a} 5 | \title{Test that the expression itself is of a specific \code{class}.} 6 | \usage{ 7 | expr_is_a(class) 8 | } 9 | \arguments{ 10 | \item{class}{expected \code{class} of the given expression} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Returns \code{TRUE} if \code{e$expr} is of the given \code{\link{class}}. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | # Test if the expression entered by a user is an assignment 21 | # 22 | expr_is_a('<-') 23 | } 24 | } 25 | \seealso{ 26 | Other AnswerTests: 27 | \code{\link{AnswerTests}}, 28 | \code{\link{any_of_exprs}()}, 29 | \code{\link{calculates_same_value}()}, 30 | \code{\link{expr_creates_var}()}, 31 | \code{\link{expr_identical_to}()}, 32 | \code{\link{expr_uses_func}()}, 33 | \code{\link{func_of_newvar_equals}()}, 34 | \code{\link{omnitest}()}, 35 | \code{\link{val_has_length}()}, 36 | \code{\link{val_matches}()}, 37 | \code{\link{var_is_a}()} 38 | } 39 | \concept{AnswerTests} 40 | -------------------------------------------------------------------------------- /man/expr_uses_func.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{expr_uses_func} 4 | \alias{expr_uses_func} 5 | \title{Test that a particular function has been used.} 6 | \usage{ 7 | expr_uses_func(func) 8 | } 9 | \arguments{ 10 | \item{func}{name of the function expected to be used} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Returns \code{TRUE} if the \code{e$expr} uses the function whose 17 | name is given as the first argument. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | # Test that the user has entered an expression using sd() 22 | # 23 | expr_uses_func('sd') 24 | } 25 | } 26 | \seealso{ 27 | Other AnswerTests: 28 | \code{\link{AnswerTests}}, 29 | \code{\link{any_of_exprs}()}, 30 | \code{\link{calculates_same_value}()}, 31 | \code{\link{expr_creates_var}()}, 32 | \code{\link{expr_identical_to}()}, 33 | \code{\link{expr_is_a}()}, 34 | \code{\link{func_of_newvar_equals}()}, 35 | \code{\link{omnitest}()}, 36 | \code{\link{val_has_length}()}, 37 | \code{\link{val_matches}()}, 38 | \code{\link{var_is_a}()} 39 | } 40 | \concept{AnswerTests} 41 | -------------------------------------------------------------------------------- /man/func_of_newvar_equals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{func_of_newvar_equals} 4 | \alias{func_of_newvar_equals} 5 | \title{Test the result of a computation applied to a specific (user-named) 6 | variable created in a previous question.} 7 | \usage{ 8 | func_of_newvar_equals(correct_expression) 9 | } 10 | \arguments{ 11 | \item{correct_expression}{expression expected to be applied} 12 | } 13 | \value{ 14 | \code{TRUE} or \code{FALSE} 15 | } 16 | \description{ 17 | Tests the result of a computation such as \code{mean(newVar)} applied 18 | to a specific variable created in a previous question and 19 | saved behind the scenes as \code{e$newVar}. 20 | } 21 | \examples{ 22 | \dontrun{ 23 | # Test if user has taken the mean of a variable created 24 | # in an earlier question. 25 | # 26 | func_of_newvar_equals('mean(newVar)') 27 | } 28 | } 29 | \seealso{ 30 | Other AnswerTests: 31 | \code{\link{AnswerTests}}, 32 | \code{\link{any_of_exprs}()}, 33 | \code{\link{calculates_same_value}()}, 34 | \code{\link{expr_creates_var}()}, 35 | \code{\link{expr_identical_to}()}, 36 | \code{\link{expr_is_a}()}, 37 | \code{\link{expr_uses_func}()}, 38 | \code{\link{omnitest}()}, 39 | \code{\link{val_has_length}()}, 40 | \code{\link{val_matches}()}, 41 | \code{\link{var_is_a}()} 42 | } 43 | \concept{AnswerTests} 44 | -------------------------------------------------------------------------------- /man/info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{info} 4 | \alias{info} 5 | \title{Display a list of special commands.} 6 | \usage{ 7 | info() 8 | } 9 | \description{ 10 | Display a list of the special commands, \code{bye()}, \code{play()}, 11 | \code{nxt()}, \code{skip()}, and \code{info()}. 12 | } 13 | -------------------------------------------------------------------------------- /man/install_course.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course} 4 | \alias{install_course} 5 | \title{Install a course from The swirl Course Network or install a course from a 6 | local .swc file.} 7 | \usage{ 8 | install_course(course_name = NULL, swc_path = NULL, force = FALSE) 9 | } 10 | \arguments{ 11 | \item{course_name}{The name of the course you wish to install.} 12 | 13 | \item{swc_path}{The path to a local \code{.swc} file. By default this 14 | argument defaults to \code{file.choose()} so the user can select the file using 15 | their mouse.} 16 | 17 | \item{force}{Should course installation be forced? The 18 | default value is \code{FALSE}.} 19 | } 20 | \description{ 21 | Version 2.4 of swirl introduces a new, simple, and fast way of installing 22 | courses in the form of \code{.swc} files. This function allows a user to grab 23 | a \code{.swc} file from The swirl Course Network which is maintained by Team 24 | swirl, or the user can use this function to install a local \code{.swc} file. 25 | When using this function please only provide an argument for either 26 | \code{course_name} or \code{swc_path}, never both. 27 | } 28 | \examples{ 29 | \dontrun{ 30 | 31 | # Install the latest version of Team swirl's R Programming course. 32 | install_course("R Programming") 33 | 34 | # Install a local .swc file by using your mouse and keyboard to select the 35 | # file. 36 | install_course() 37 | 38 | # Install a .swc file from a specific path. 39 | install_course(swc_path = file.path("~", "Downloads", "R_Programming.swc")) 40 | 41 | } 42 | } 43 | \seealso{ 44 | Other InstallCourses: 45 | \code{\link{InstallCourses}}, 46 | \code{\link{install_course_directory}()}, 47 | \code{\link{install_course_dropbox}()}, 48 | \code{\link{install_course_github}()}, 49 | \code{\link{install_course_google_drive}()}, 50 | \code{\link{install_course_url}()}, 51 | \code{\link{install_course_zip}()}, 52 | \code{\link{install_from_swirl}()}, 53 | \code{\link{uninstall_all_courses}()}, 54 | \code{\link{uninstall_course}()}, 55 | \code{\link{zip_course}()} 56 | } 57 | \concept{InstallCourses} 58 | -------------------------------------------------------------------------------- /man/install_course_directory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_directory} 4 | \alias{install_course_directory} 5 | \title{Install a course from a course directory} 6 | \usage{ 7 | install_course_directory(path) 8 | } 9 | \arguments{ 10 | \item{path}{The path to the course directory.} 11 | } 12 | \description{ 13 | Install a course from a course directory 14 | } 15 | \examples{ 16 | \dontrun{ 17 | 18 | install_course_directory("~/Desktop/my_course") 19 | } 20 | } 21 | \seealso{ 22 | Other InstallCourses: 23 | \code{\link{InstallCourses}}, 24 | \code{\link{install_course_dropbox}()}, 25 | \code{\link{install_course_github}()}, 26 | \code{\link{install_course_google_drive}()}, 27 | \code{\link{install_course_url}()}, 28 | \code{\link{install_course_zip}()}, 29 | \code{\link{install_course}()}, 30 | \code{\link{install_from_swirl}()}, 31 | \code{\link{uninstall_all_courses}()}, 32 | \code{\link{uninstall_course}()}, 33 | \code{\link{zip_course}()} 34 | } 35 | \concept{InstallCourses} 36 | -------------------------------------------------------------------------------- /man/install_course_dropbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_dropbox} 4 | \alias{install_course_dropbox} 5 | \title{Install a course from a zipped course directory shared on Dropbox} 6 | \usage{ 7 | install_course_dropbox(url, multi = FALSE) 8 | } 9 | \arguments{ 10 | \item{url}{URL of the shared file} 11 | 12 | \item{multi}{The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}.} 13 | } 14 | \description{ 15 | Install a course from a zipped course directory shared on Dropbox 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | install_course_dropbox("https://www.dropbox.com/s/xttkmuvu7hh72vu/my_course.zip") 21 | } 22 | } 23 | \seealso{ 24 | Other InstallCourses: 25 | \code{\link{InstallCourses}}, 26 | \code{\link{install_course_directory}()}, 27 | \code{\link{install_course_github}()}, 28 | \code{\link{install_course_google_drive}()}, 29 | \code{\link{install_course_url}()}, 30 | \code{\link{install_course_zip}()}, 31 | \code{\link{install_course}()}, 32 | \code{\link{install_from_swirl}()}, 33 | \code{\link{uninstall_all_courses}()}, 34 | \code{\link{uninstall_course}()}, 35 | \code{\link{zip_course}()} 36 | } 37 | \concept{InstallCourses} 38 | -------------------------------------------------------------------------------- /man/install_course_github.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_github} 4 | \alias{install_course_github} 5 | \title{Install a course from a GitHub repository} 6 | \usage{ 7 | install_course_github( 8 | github_username, 9 | course_name, 10 | branch = "master", 11 | multi = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{github_username}{The username that owns the course repository.} 16 | 17 | \item{course_name}{The name of the repository which should be the name of the course.} 18 | 19 | \item{branch}{The branch of the repository containing the course. The default branch is \code{"master"}.} 20 | 21 | \item{multi}{The user should set to \code{TRUE} if the repository contains multiple courses. The default value is \code{FALSE}.} 22 | } 23 | \description{ 24 | Install a course from a GitHub repository 25 | } 26 | \examples{ 27 | \dontrun{ 28 | 29 | install_course_github("bcaffo", "Linear_Regression") 30 | install_course_github("jtleek", "Twitter_Map", "geojson") 31 | } 32 | } 33 | \seealso{ 34 | Other InstallCourses: 35 | \code{\link{InstallCourses}}, 36 | \code{\link{install_course_directory}()}, 37 | \code{\link{install_course_dropbox}()}, 38 | \code{\link{install_course_google_drive}()}, 39 | \code{\link{install_course_url}()}, 40 | \code{\link{install_course_zip}()}, 41 | \code{\link{install_course}()}, 42 | \code{\link{install_from_swirl}()}, 43 | \code{\link{uninstall_all_courses}()}, 44 | \code{\link{uninstall_course}()}, 45 | \code{\link{zip_course}()} 46 | } 47 | \concept{InstallCourses} 48 | -------------------------------------------------------------------------------- /man/install_course_google_drive.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_google_drive} 4 | \alias{install_course_google_drive} 5 | \title{Install a course from a zipped course directory shared on Google Drive} 6 | \usage{ 7 | install_course_google_drive(url, multi = FALSE) 8 | } 9 | \arguments{ 10 | \item{url}{URL of the shared file} 11 | 12 | \item{multi}{The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}.} 13 | } 14 | \description{ 15 | Install a course from a zipped course directory shared on Google Drive 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | install_course_google_drive("https://drive.google.com/file/d/F3fveiu873hfjZZj/edit?usp=sharing") 21 | } 22 | } 23 | \seealso{ 24 | Other InstallCourses: 25 | \code{\link{InstallCourses}}, 26 | \code{\link{install_course_directory}()}, 27 | \code{\link{install_course_dropbox}()}, 28 | \code{\link{install_course_github}()}, 29 | \code{\link{install_course_url}()}, 30 | \code{\link{install_course_zip}()}, 31 | \code{\link{install_course}()}, 32 | \code{\link{install_from_swirl}()}, 33 | \code{\link{uninstall_all_courses}()}, 34 | \code{\link{uninstall_course}()}, 35 | \code{\link{zip_course}()} 36 | } 37 | \concept{InstallCourses} 38 | -------------------------------------------------------------------------------- /man/install_course_url.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_url} 4 | \alias{install_course_url} 5 | \title{Install a course from a url that points to a zip file} 6 | \usage{ 7 | install_course_url(url, multi = FALSE) 8 | } 9 | \arguments{ 10 | \item{url}{URL that points to a zipped course directory} 11 | 12 | \item{multi}{The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}.} 13 | } 14 | \description{ 15 | Install a course from a url that points to a zip file 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | install_course_url("http://www.biostat.jhsph.edu/~rpeng/File_Hash_Course.zip") 21 | } 22 | } 23 | \seealso{ 24 | Other InstallCourses: 25 | \code{\link{InstallCourses}}, 26 | \code{\link{install_course_directory}()}, 27 | \code{\link{install_course_dropbox}()}, 28 | \code{\link{install_course_github}()}, 29 | \code{\link{install_course_google_drive}()}, 30 | \code{\link{install_course_zip}()}, 31 | \code{\link{install_course}()}, 32 | \code{\link{install_from_swirl}()}, 33 | \code{\link{uninstall_all_courses}()}, 34 | \code{\link{uninstall_course}()}, 35 | \code{\link{zip_course}()} 36 | } 37 | \concept{InstallCourses} 38 | -------------------------------------------------------------------------------- /man/install_course_zip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_course_zip} 4 | \alias{install_course_zip} 5 | \title{Install a course from a zipped course folder} 6 | \usage{ 7 | install_course_zip(path, multi = FALSE, which_course = NULL) 8 | } 9 | \arguments{ 10 | \item{path}{The path to the zipped course.} 11 | 12 | \item{multi}{Set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}.} 13 | 14 | \item{which_course}{A vector of course names. Only for use when zip file contains multiple courses, but you don't want to install all of them.} 15 | } 16 | \description{ 17 | Install a course from a zipped course folder 18 | } 19 | \examples{ 20 | \dontrun{ 21 | 22 | install_course_zip("~/Desktop/my_course.zip") 23 | 24 | install_course_zip("~/Downloads/swirl_courses-master.zip", multi=TRUE, 25 | which_course=c("R Programming", "Data Analysis")) 26 | } 27 | } 28 | \seealso{ 29 | Other InstallCourses: 30 | \code{\link{InstallCourses}}, 31 | \code{\link{install_course_directory}()}, 32 | \code{\link{install_course_dropbox}()}, 33 | \code{\link{install_course_github}()}, 34 | \code{\link{install_course_google_drive}()}, 35 | \code{\link{install_course_url}()}, 36 | \code{\link{install_course}()}, 37 | \code{\link{install_from_swirl}()}, 38 | \code{\link{uninstall_all_courses}()}, 39 | \code{\link{uninstall_course}()}, 40 | \code{\link{zip_course}()} 41 | } 42 | \concept{InstallCourses} 43 | -------------------------------------------------------------------------------- /man/install_from_swirl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{install_from_swirl} 4 | \alias{install_from_swirl} 5 | \title{Install a course from the official course repository} 6 | \usage{ 7 | install_from_swirl(course_name, dev = FALSE, mirror = "github") 8 | } 9 | \arguments{ 10 | \item{course_name}{The name of the course you wish to install.} 11 | 12 | \item{dev}{Set to \code{TRUE} to install a course in development from the swirl_misc repository.} 13 | 14 | \item{mirror}{Select swirl course repository mirror. Valid arguments are \code{"github"} and \code{"bitbucket"}.} 15 | } 16 | \description{ 17 | We are currently maintaining a central repository of contributed 18 | swirl courses at \url{https://github.com/swirldev/swirl_courses}. 19 | This function provides the easiest method of installing a course 20 | form the repository. 21 | 22 | We have another repository at 23 | \url{https://github.com/swirldev/swirl_misc}, where we keep 24 | experimental features and content. The \code{dev} argument allows 25 | you to access this repository. Content in the swirl_misc repository 26 | is not guaranteed to work. 27 | 28 | The central repository of swirl courses is mirrored at 29 | \url{https://bitbucket.org/swirldevmirror/swirl_courses}. If you cannot 30 | access GitHub you can download swirl courses from bitbucket by using the 31 | \code{mirror = "bitbucket"} option (see below). 32 | } 33 | \examples{ 34 | \dontrun{ 35 | 36 | install_from_swirl("R_Programming") # Directory name 37 | 38 | ### OR ### 39 | 40 | install_from_swirl("R Programming") # Course name 41 | 42 | # To install a course in development from the swirl_misc repository 43 | install_from_swirl("Including Data", dev = TRUE) 44 | 45 | # To install a course from the Bitbucket mirror 46 | install_from_swirl("R Programming", mirror = "bitbucket") 47 | } 48 | } 49 | \seealso{ 50 | Other InstallCourses: 51 | \code{\link{InstallCourses}}, 52 | \code{\link{install_course_directory}()}, 53 | \code{\link{install_course_dropbox}()}, 54 | \code{\link{install_course_github}()}, 55 | \code{\link{install_course_google_drive}()}, 56 | \code{\link{install_course_url}()}, 57 | \code{\link{install_course_zip}()}, 58 | \code{\link{install_course}()}, 59 | \code{\link{uninstall_all_courses}()}, 60 | \code{\link{uninstall_course}()}, 61 | \code{\link{zip_course}()} 62 | } 63 | \concept{InstallCourses} 64 | -------------------------------------------------------------------------------- /man/is_robust_match.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rmatch_calls.R 3 | \name{is_robust_match} 4 | \alias{is_robust_match} 5 | \title{Recursively expand both the correct expression and the user's expression and 6 | test for a match. CAUTION: May raise errors, as in rmatch_calls.} 7 | \usage{ 8 | is_robust_match(expr1, expr2, eval_for_class, eval_env = NULL) 9 | } 10 | \arguments{ 11 | \item{expr1}{expression} 12 | 13 | \item{expr2}{expression} 14 | 15 | \item{eval_for_class}{TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE.} 16 | 17 | \item{eval_env}{parent environment for evaluations to determine class. Ignored if eval_for_class=FALSE} 18 | } 19 | \value{ 20 | TRUE or FALSE according to whether expanded expressions match. 21 | } 22 | \description{ 23 | Recursively expand both the correct expression and the user's expression and 24 | test for a match. CAUTION: May raise errors, as in rmatch_calls. 25 | } 26 | \examples{ 27 | \dontrun{ 28 | 29 | expr1 <- quote(print(paste("my_name_is", "mud"))) 30 | expr2 <- quote(print(paste("my_name_is", "mud", sep=" "))) 31 | err <- try(ans <- is_robust_match(expr1, expr2, eval_for_class=TRUE), silent=TRUE) 32 | if(is(ans, "try-error")){ 33 | ans <- isTRUE(all.equal()) 34 | } 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /man/main.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{main} 4 | \alias{main} 5 | \title{Return to swirl's main menu.} 6 | \usage{ 7 | main() 8 | } 9 | \description{ 10 | Return to swirl's main menu from a lesson in progress. 11 | } 12 | \examples{ 13 | \dontrun{ 14 | 15 | | The simplest way to create a sequence of numbers in R is by using 16 | | the `:` operator. Type 1:20 to see how it works. 17 | 18 | > main() 19 | 20 | | Returning to the main menu... 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /man/nxt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{nxt} 4 | \alias{nxt} 5 | \title{Begin the upcoming question or unit of instruction.} 6 | \usage{ 7 | nxt() 8 | } 9 | \description{ 10 | This is the way to regain swirl's attention after viewing 11 | a video or \code{play()}'ing around in the console. 12 | } 13 | \examples{ 14 | \dontrun{ 15 | 16 | | Create a new variable called `y` that contains the number 8. 17 | 18 | > play() 19 | 20 | | Entering play mode. Experiment as you please, then type nxt() 21 | | when you ready to resume the lesson. 22 | 23 | > 10/14 24 | > [1] 0.7142857 25 | > zz <- 99 26 | > zz 27 | > [1] 99 28 | > nxt() 29 | 30 | | Resuming lesson... 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/omnitest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{omnitest} 4 | \alias{omnitest} 5 | \title{Test for a correct expression, a correct value, or both.} 6 | \usage{ 7 | omnitest( 8 | correctExpr = NULL, 9 | correctVal = NULL, 10 | strict = FALSE, 11 | eval_for_class = as.logical(NA) 12 | ) 13 | } 14 | \arguments{ 15 | \item{correctExpr}{the correct or expected expression as a string} 16 | 17 | \item{correctVal}{the correct value (numeric or character)} 18 | 19 | \item{strict}{a logical value indicating that the expression should be as expected even if the value is correct. If \code{FALSE} (the default) a correct value will pass the test even if the expression is not as expected, but a notification will be issued.} 20 | 21 | \item{eval_for_class}{a logical value. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=TRUE. Global value may also be set as customTests$EVAL_FOR_CLASS.} 22 | } 23 | \description{ 24 | Omnitest can test for a correct expression, a correct value, 25 | or both. In the case of values it is limited to testing for 26 | character or numeric vectors of length 1. 27 | } 28 | \examples{ 29 | \dontrun{ 30 | 31 | # Test that a user has chosen a correct menu item 32 | # 33 | omnitest(correctVal='Men in a college dorm.') 34 | 35 | # Test that a user has entered a correct number at the 36 | # command line 37 | # 38 | omnitest(correctVal=19) 39 | 40 | # Test that a user has entered a particular command 41 | # 42 | omnitest('myVar <- c(3, 5, 7)') 43 | 44 | # Test that a user has entered a command which computes 45 | # a specific value but perhaps in a different manner 46 | # than anticipated 47 | # 48 | omnitest('sd(x)^2', 5.95) 49 | # 50 | # If the user enters sd(x)*sd(x), rather than sd(x)^2, a notification 51 | # will be issued, but the test will not fail. 52 | 53 | # Test that a user has entered a command which computes 54 | # a specific value in a particular way 55 | # 56 | omnitest('sd(x)^2', 5.95, strict=TRUE) 57 | # 58 | # In this case, if the user enters sd(x)*sd(x) the test will fail. 59 | 60 | } 61 | } 62 | \seealso{ 63 | Other AnswerTests: 64 | \code{\link{AnswerTests}}, 65 | \code{\link{any_of_exprs}()}, 66 | \code{\link{calculates_same_value}()}, 67 | \code{\link{expr_creates_var}()}, 68 | \code{\link{expr_identical_to}()}, 69 | \code{\link{expr_is_a}()}, 70 | \code{\link{expr_uses_func}()}, 71 | \code{\link{func_of_newvar_equals}()}, 72 | \code{\link{val_has_length}()}, 73 | \code{\link{val_matches}()}, 74 | \code{\link{var_is_a}()} 75 | } 76 | \concept{AnswerTests} 77 | -------------------------------------------------------------------------------- /man/play.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{play} 4 | \alias{play} 5 | \title{Tell swirl to ignore console input for a while.} 6 | \usage{ 7 | play() 8 | } 9 | \description{ 10 | It is sometimes useful to play around in the R console out of 11 | curiosity or to solidify a concept. This command will cause 12 | swirl to remain idle, allowing the user to experiment at will, 13 | until the command \code{nxt()} is entered. 14 | } 15 | \examples{ 16 | \dontrun{ 17 | 18 | | Create a new variable called `y` that contains the number 8. 19 | 20 | > play() 21 | 22 | | Entering play mode. Experiment as you please, then type nxt() 23 | | when you ready to resume the lesson. 24 | 25 | > 10/14 26 | > [1] 0.7142857 27 | > zz <- 99 28 | > zz 29 | > [1] 99 30 | > nxt() 31 | 32 | | Resuming lesson... 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/reset.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{reset} 4 | \alias{reset} 5 | \title{Start over on the current script question.} 6 | \usage{ 7 | reset() 8 | } 9 | \description{ 10 | During a script question, this will reset the script 11 | back to its original state, which can be helpful if you 12 | get stuck. 13 | } 14 | -------------------------------------------------------------------------------- /man/restart.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{restart} 4 | \alias{restart} 5 | \title{Restart the current swirl lesson.} 6 | \usage{ 7 | restart() 8 | } 9 | \description{ 10 | Restart the current swirl lesson. 11 | } 12 | -------------------------------------------------------------------------------- /man/rmatch_calls.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rmatch_calls.R 3 | \name{rmatch_calls} 4 | \alias{rmatch_calls} 5 | \title{Recursively expand match calls in an expression from the bottom up.} 6 | \usage{ 7 | rmatch_calls(expr, eval_for_class = FALSE, eval_env = NULL) 8 | } 9 | \arguments{ 10 | \item{expr}{an R expression (a.k.a. abstract syntax tree)} 11 | 12 | \item{eval_for_class}{TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE.} 13 | 14 | \item{eval_env}{environment in which to evaluate for class. Ignored if eval_for_class=FALSE} 15 | } 16 | \value{ 17 | an equivalent R expression with function or method calls in canonical form. 18 | } 19 | \description{ 20 | Given an expression, expr, traverse the syntax tree from the 21 | bottom up, expanding the call to include default values of 22 | named formals as appropriate, and applying match.call to the result. 23 | Functionality is limited to expressions containing ordinary functions 24 | or S3 methods. If parameter eval_for_class has its default value of FALSE, 25 | an error will be raised for any S3 method whose first argument (as an expression) 26 | is not atomic. If eval_for_class is TRUE, the first argument will be evaluated 27 | to determine its class. Evaluation will take place in the environment given by 28 | parameter eval_env. 29 | CAUTION: eval_for_class=TRUE is likely to result in multiple evaluations of the same code. 30 | Expressions containing S4 or reference class methods will also raise errors. 31 | } 32 | \examples{ 33 | \dontrun{ 34 | 35 | # Function 36 | rmatch_calls(quote(help("print"))) 37 | help(topic = "print", package = NULL, lib.loc = NULL, verbose = getOption("verbose"), 38 | try.all.packages = getOption("help.try.all.packages"), help_type = getOption("help_type")) 39 | 40 | # S3 method with atomic first argument 41 | rmatch_calls(quote(seq(0, 1, by=.5))) 42 | seq(from = 0, to = 1, by = 0.5, length.out = NULL, along.with = NULL) 43 | 44 | # S3 method with non-atomic first argument, eval_for_class = FALSE (default) 45 | rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) 46 | #Error in rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) : 47 | # Illegal expression, seq(as.Date(x = "2014-02-01"), as.Date(x = "2014-03-01")): 48 | # The first argument, as.Date(x = "2014-02-01"), to S3 method 'seq', is a call, 49 | # which (as an expression) is not atomic, hence its class can't be determined in an 50 | # abstract syntax tree without additional information. 51 | 52 | # S3 method with non-atomic first argument, eval_for_class = TRUE 53 | rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01"))), eval_for_class=TRUE) 54 | seq(from = as.Date(x = "2014-02-01"), to = as.Date(x = "2014-03-01"), 55 | length.out = NULL, along.with = NULL) 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /man/select_language.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/languages.R 3 | \name{select_language} 4 | \alias{select_language} 5 | \title{Select a language} 6 | \usage{ 7 | select_language(language = NULL, append_rprofile = FALSE) 8 | } 9 | \arguments{ 10 | \item{language}{The language that swirl's menus will use. 11 | This must be one of the following values: \code{"chinese_simplified"}. 12 | \code{"english"}, \code{"french"}, \code{"german"}, 13 | \code{"korean"}, \code{"spanish"}, or \code{"turkish"}. 14 | If \code{NULL} the user will be asked to choose a language 15 | interactively. The default value is \code{NULL}.} 16 | 17 | \item{append_rprofile}{If \code{TRUE} this command will append 18 | \code{options(swirl_language = [selected language])} to the end of your 19 | Rprofile. The default value is \code{FALSE}.} 20 | } 21 | \description{ 22 | Select a language for swirl's menus. 23 | } 24 | -------------------------------------------------------------------------------- /man/skip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{skip} 4 | \alias{skip} 5 | \title{Skip the current unit of instruction.} 6 | \usage{ 7 | skip() 8 | } 9 | \description{ 10 | swirl will enter the correct answer and notify the 11 | user of the names of any new variables which it may have created 12 | in doing so. These may be needed for subsequent questions. 13 | } 14 | \examples{ 15 | \dontrun{ 16 | 17 | | Create a new variable called `y` that contains the number 8. 18 | 19 | > skip() 20 | 21 | | I've entered the correct answer for you. 22 | 23 | | In doing so, I've created the variable(s) y, which you may need later. 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /man/submit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{submit} 4 | \alias{submit} 5 | \title{Submit the active R script in response to a question.} 6 | \usage{ 7 | submit() 8 | } 9 | \description{ 10 | When a swirl question requires the user to edit an R script, the 11 | \code{submit()} function allows the user to submit their response. 12 | } 13 | \examples{ 14 | \dontrun{ 15 | 16 | | Create a function called f that takes one argument, x, and 17 | | returns the value of x squared. 18 | 19 | > submit() 20 | 21 | | You are quite good my friend! 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /man/swirl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/swirl.R 3 | \name{swirl} 4 | \alias{swirl} 5 | \title{An interactive learning environment for R and statistics.} 6 | \usage{ 7 | swirl(resume.class = "default", ...) 8 | } 9 | \arguments{ 10 | \item{resume.class}{for development only; please accept the default.} 11 | 12 | \item{...}{arguments for special purposes only, such as lesson testing} 13 | } 14 | \description{ 15 | This function presents a choice of course lessons and interactively 16 | tutors a user through them. A user may be asked to watch a video, to 17 | answer a multiple-choice or fill-in-the-blanks question, or to 18 | enter a command in the R console precisely as if he or she were 19 | using R in practice. Emphasis is on the last, interacting with the 20 | R console. User responses are tested for correctness and hints are 21 | given if appropriate. Progress is automatically saved so that a user 22 | may quit at any time and later resume without losing work. 23 | } 24 | \details{ 25 | There are several ways to exit swirl: by typing \code{bye()} while in the R 26 | console, by hitting the Esc key while not in the R console, or by 27 | entering 0 from the swirl course menu. swirl will print a goodbye 28 | message whenever it exits. 29 | 30 | While swirl is in operation, it may be controlled by entering special 31 | commands in the R console. One of the special commands is \code{bye()} 32 | as discussed above. Others are \code{play()}, \code{nxt()}, \code{skip()}, 33 | and \code{info()}. The parentheses are important. 34 | 35 | Sometimes a user will want to play around in the R console without 36 | interference or commentary from swirl. This can be accomplished by 37 | using the special command \code{play()}. swirl will remain in operation, 38 | silently, until the special command \code{nxt()} is entered. 39 | 40 | The special command \code{skip()} can be used to skip a question if 41 | necessary. swirl will enter the correct answer and notify the 42 | user of the names of any new variables which it may have created 43 | in doing so. These may be needed for subsequent questions. 44 | 45 | Finally, \code{info()} may be used to display a list of the special commands 46 | themselves with brief explanations of what they do. 47 | } 48 | \examples{ 49 | \dontrun{ 50 | 51 | swirl() 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /man/swirl_options.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/options.R 3 | \name{swirl_options} 4 | \alias{swirl_options} 5 | \title{Get swirl options} 6 | \usage{ 7 | swirl_options(...) 8 | } 9 | \arguments{ 10 | \item{...}{any options can be defined, using name = value.} 11 | } 12 | \description{ 13 | This function is a wrapper for \code{options()} that allows the user to 14 | see the state of how certain options for swirl are set up. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | # See current current swirl options 19 | swirl_options() 20 | 21 | # Set an option 22 | swirl_options(swirl_logging = TRUE) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /man/uninstall_all_courses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{uninstall_all_courses} 4 | \alias{uninstall_all_courses} 5 | \title{Uninstall all courses} 6 | \usage{ 7 | uninstall_all_courses(force = FALSE) 8 | } 9 | \arguments{ 10 | \item{force}{If \code{TRUE} the user will not be asked if they're sure they 11 | want to delete the contents of the directory where courses are stored. The 12 | default value is \code{FALSE}} 13 | } 14 | \description{ 15 | Uninstall all courses 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | uninstall_all_courses() 21 | } 22 | } 23 | \seealso{ 24 | Other InstallCourses: 25 | \code{\link{InstallCourses}}, 26 | \code{\link{install_course_directory}()}, 27 | \code{\link{install_course_dropbox}()}, 28 | \code{\link{install_course_github}()}, 29 | \code{\link{install_course_google_drive}()}, 30 | \code{\link{install_course_url}()}, 31 | \code{\link{install_course_zip}()}, 32 | \code{\link{install_course}()}, 33 | \code{\link{install_from_swirl}()}, 34 | \code{\link{uninstall_course}()}, 35 | \code{\link{zip_course}()} 36 | } 37 | \concept{InstallCourses} 38 | -------------------------------------------------------------------------------- /man/uninstall_course.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{uninstall_course} 4 | \alias{uninstall_course} 5 | \title{Uninstall a course} 6 | \usage{ 7 | uninstall_course(course_name) 8 | } 9 | \arguments{ 10 | \item{course_name}{Name of course to be uninstalled} 11 | } 12 | \description{ 13 | Uninstall a course 14 | } 15 | \examples{ 16 | \dontrun{ 17 | 18 | uninstall_course("Linear Regression") 19 | } 20 | } 21 | \seealso{ 22 | Other InstallCourses: 23 | \code{\link{InstallCourses}}, 24 | \code{\link{install_course_directory}()}, 25 | \code{\link{install_course_dropbox}()}, 26 | \code{\link{install_course_github}()}, 27 | \code{\link{install_course_google_drive}()}, 28 | \code{\link{install_course_url}()}, 29 | \code{\link{install_course_zip}()}, 30 | \code{\link{install_course}()}, 31 | \code{\link{install_from_swirl}()}, 32 | \code{\link{uninstall_all_courses}()}, 33 | \code{\link{zip_course}()} 34 | } 35 | \concept{InstallCourses} 36 | -------------------------------------------------------------------------------- /man/val_has_length.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{val_has_length} 4 | \alias{val_has_length} 5 | \title{Test that the value of the expression has a particular \code{length}.} 6 | \usage{ 7 | val_has_length(len) 8 | } 9 | \arguments{ 10 | \item{len}{expected length of the variable created by a user} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Test the the \code{\link{length}} of \code{e$val} is that given by the 17 | first argument. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | # Test that the user has created a varible of length 10 22 | # 23 | val_has_length(10) 24 | } 25 | } 26 | \seealso{ 27 | Other AnswerTests: 28 | \code{\link{AnswerTests}}, 29 | \code{\link{any_of_exprs}()}, 30 | \code{\link{calculates_same_value}()}, 31 | \code{\link{expr_creates_var}()}, 32 | \code{\link{expr_identical_to}()}, 33 | \code{\link{expr_is_a}()}, 34 | \code{\link{expr_uses_func}()}, 35 | \code{\link{func_of_newvar_equals}()}, 36 | \code{\link{omnitest}()}, 37 | \code{\link{val_matches}()}, 38 | \code{\link{var_is_a}()} 39 | } 40 | \concept{AnswerTests} 41 | -------------------------------------------------------------------------------- /man/val_matches.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{val_matches} 4 | \alias{val_matches} 5 | \title{Test that the user's expression matches a regular expression.} 6 | \usage{ 7 | val_matches(regular_expression) 8 | } 9 | \arguments{ 10 | \item{regular_expression}{a regular expression which user value should match} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Returns \code{TRUE} if \code{as.character(e$val)} matches the regular 17 | expression given as the first argument. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | # Test that a user has entered a value matching 22 | # '[Cc]ollege [Ss]tudents' or has selected it 23 | # in a multiple choice question. 24 | # 25 | val_matches('[Cc]ollege [Ss]tudents') 26 | } 27 | } 28 | \seealso{ 29 | Other AnswerTests: 30 | \code{\link{AnswerTests}}, 31 | \code{\link{any_of_exprs}()}, 32 | \code{\link{calculates_same_value}()}, 33 | \code{\link{expr_creates_var}()}, 34 | \code{\link{expr_identical_to}()}, 35 | \code{\link{expr_is_a}()}, 36 | \code{\link{expr_uses_func}()}, 37 | \code{\link{func_of_newvar_equals}()}, 38 | \code{\link{omnitest}()}, 39 | \code{\link{val_has_length}()}, 40 | \code{\link{var_is_a}()} 41 | } 42 | \concept{AnswerTests} 43 | -------------------------------------------------------------------------------- /man/var_is_a.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/answerTests2.R 3 | \name{var_is_a} 4 | \alias{var_is_a} 5 | \title{Test that the value of the expression is of a specific class.} 6 | \usage{ 7 | var_is_a(class, var_name) 8 | } 9 | \arguments{ 10 | \item{class}{expected class which the given variable} 11 | 12 | \item{var_name}{name of the variable} 13 | } 14 | \value{ 15 | \code{TRUE} or \code{FALSE} 16 | } 17 | \description{ 18 | Returns \code{TRUE} if a variable of the given name exists 19 | in the global environment and is of the given class. 20 | } 21 | \examples{ 22 | \dontrun{ 23 | # Test that a variable named "x" in the global environmentis numeric. 24 | var_is_a('numeric', 'x') 25 | } 26 | } 27 | \seealso{ 28 | Other AnswerTests: 29 | \code{\link{AnswerTests}}, 30 | \code{\link{any_of_exprs}()}, 31 | \code{\link{calculates_same_value}()}, 32 | \code{\link{expr_creates_var}()}, 33 | \code{\link{expr_identical_to}()}, 34 | \code{\link{expr_is_a}()}, 35 | \code{\link{expr_uses_func}()}, 36 | \code{\link{func_of_newvar_equals}()}, 37 | \code{\link{omnitest}()}, 38 | \code{\link{val_has_length}()}, 39 | \code{\link{val_matches}()} 40 | } 41 | \concept{AnswerTests} 42 | -------------------------------------------------------------------------------- /man/zip_course.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_course.R 3 | \name{zip_course} 4 | \alias{zip_course} 5 | \title{Zip a course directory} 6 | \usage{ 7 | zip_course(path, dest = NULL) 8 | } 9 | \arguments{ 10 | \item{path}{Path to the course directory to be zipped.} 11 | 12 | \item{dest}{Path to directory in which the \code{.zip} should be saved. The 13 | default value is \code{NULL}, which will cause the \code{.zip} to be 14 | created one level above the directory specified in \code{path}.} 15 | } 16 | \description{ 17 | \strong{Warning:} This function will be deprecated after swirl version 2.4. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | 22 | zip_course("~/Desktop/LOESS_Modeling") 23 | zip_course("~/Desktop/SNA_Tutorial", "~/tutorials") 24 | } 25 | } 26 | \seealso{ 27 | Other InstallCourses: 28 | \code{\link{InstallCourses}}, 29 | \code{\link{install_course_directory}()}, 30 | \code{\link{install_course_dropbox}()}, 31 | \code{\link{install_course_github}()}, 32 | \code{\link{install_course_google_drive}()}, 33 | \code{\link{install_course_url}()}, 34 | \code{\link{install_course_zip}()}, 35 | \code{\link{install_course}()}, 36 | \code{\link{install_from_swirl}()}, 37 | \code{\link{uninstall_all_courses}()}, 38 | \code{\link{uninstall_course}()} 39 | } 40 | \concept{InstallCourses} 41 | -------------------------------------------------------------------------------- /revdep/check.R: -------------------------------------------------------------------------------- 1 | library("devtools") 2 | 3 | res <- revdep_check() 4 | revdep_check_save_summary() 5 | -------------------------------------------------------------------------------- /revdep/checks.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/swirldev/swirl/25938d2ba2f1d00c50c1a1dece19623648f796cf/revdep/checks.rds -------------------------------------------------------------------------------- /swirl.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageRoxygenize: rd,namespace 19 | -------------------------------------------------------------------------------- /tests/test-all.R: -------------------------------------------------------------------------------- 1 | if (packageVersion("testthat") >= "0.7.1.99") { 2 | library(testthat) 3 | test_check("swirl") 4 | } -------------------------------------------------------------------------------- /tests/testthat/test-encoding.R: -------------------------------------------------------------------------------- 1 | context("encoding") 2 | 3 | library(stringi) 4 | 5 | test_that("Trying to parse the test-encoding.yaml", { 6 | locale <- Sys.getlocale() 7 | if(grepl("[L|l]atin", locale)){ 8 | testthat::skip("Locale is Latin") 9 | } 10 | skip_on_os("windows") 11 | 12 | test_parse <- function(file) { 13 | class(file) <- get_content_class(file) 14 | parse_content(file) 15 | } 16 | environment(test_parse) <- environment(swirl:::parse_content) 17 | test_path <- system.file(file.path("test", "test-encoding.yaml"), package = "swirl") 18 | suppressWarnings(result <- test_parse(test_path)) 19 | console <- capture.output(result) 20 | test_phrase <- strsplit(console[3], "\\s+")[[1]][3] 21 | 22 | #if(.Platform$OS.type == "windows"){ 23 | expect_true( 24 | identical(stri_escape_unicode(test_phrase), "") || 25 | identical(stri_escape_unicode(test_phrase), stri_escape_unicode("中文測試")) 26 | ) 27 | #} else { 28 | # expect_equal(stri_escape_unicode(test_phrase), stri_escape_unicode("中文測試")) 29 | #} 30 | }) 31 | -------------------------------------------------------------------------------- /tests/testthat/test-rmatch_calls.R: -------------------------------------------------------------------------------- 1 | context("rmatch_calls") 2 | 3 | test_that("Omitted leading or trailing zeros don't cause mismatch.", { 4 | testv <- parse(text="seq(1, 10, by=0.5); seq(1, 10, by=.5); seq(1, 10, by=.50)") 5 | iscorrect <- is_identical_to(rmatch_calls(testv[[1]])) 6 | for(v in testv){ 7 | expect_that(rmatch_calls(v), iscorrect) 8 | } 9 | invisible() 10 | }) 11 | 12 | test_that("Omission, inclusion, or order of named arguments doesn't cause mismatch.", { 13 | testv <- parse(text="seq(1, 10, by=0.5); seq(to=10, from=1, by=0.5); seq(1, 10, 0.50, length.out=NULL)") 14 | iscorrect <- is_identical_to(rmatch_calls(testv[[1]])) 15 | for(v in testv){ 16 | expect_that(rmatch_calls(v), iscorrect) 17 | } 18 | invisible() 19 | }) 20 | 21 | test_that("S4 methods and reference classes raise errors",{ 22 | # For testing reference classes; example from Hadley Wickham, Advanced R 23 | Person <- setRefClass("Person", methods = list( 24 | say_hello = function() message("Hi!") 25 | )) 26 | person <- Person$new() 27 | # For testing S4 functions. (logLik(object) in stats4 is distributed with R.) 28 | library(stats4) 29 | testv <- parse(text="peep <- Person$new(); person$say_hello(); logLik(obj)") 30 | for(v in testv){ 31 | expect_that(try(rmatch_calls(v), silent=TRUE), is_a("try-error")) 32 | } 33 | }) 34 | 35 | test_that("With default settings, S3 methods with calls as first arguments raise errors.",{ 36 | expr <- quote(print(paste("hi", 5))) 37 | expect_that(try(rmatch_calls(expr), silent=TRUE), is_a("try-error")) 38 | expr <- quote(summary(lm(child ~ parent, galton))) 39 | expect_that(try(rmatch_calls(expr), silent=TRUE), is_a("try-error")) 40 | }) 41 | 42 | test_that("With eval_for_class=TRUE, S3 methods with calls as first arguments raise errors.",{ 43 | expr <- quote(print(paste("hi", 5))) 44 | expect_false(is(try(rmatch_calls(expr, eval_for_class=TRUE), silent=TRUE), "try-error")) 45 | }) 46 | -------------------------------------------------------------------------------- /tests/testthat/test-uses_func.R: -------------------------------------------------------------------------------- 1 | context("uses_func") 2 | 3 | test_that("uses_func works with the current version of testthat", { 4 | expect_true(swirl:::uses_func("info")(parse(text="info()"))[[1]]) 5 | }) --------------------------------------------------------------------------------