diff --git a/.Rbuildignore b/.Rbuildignore index 14aac9e..727851c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,6 +2,6 @@ ^\.Rproj\.user$ ^.*.html$ user_data/ -^NEWS.md$ ^\.travis\.yml$ ^cran-comments\.md$ +^revdep$ diff --git a/.travis.yml b/.travis.yml index f804ef8..ec67dcc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,21 +1,15 @@ -# Sample .travis.yml for R projects from https://github.com/craigcitro/r-travis +language: r -language: c +matrix: + include: + - r: release + - r: oldrel + - r: devel -before_install: - - curl -OL http://raw.github.com/craigcitro/r-travis/master/scripts/travis-tool.sh - - chmod 755 ./travis-tool.sh - - ./travis-tool.sh bootstrap - -install: - - ./travis-tool.sh install_deps - -script: ./travis-tool.sh run_tests - -on_failure: - - ./travis-tool.sh dump_logs +cache: packages +sudo: false notifications: email: - on_success: change - on_failure: change + on_success: always + on_failure: always \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 02935b4..b45e8fb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,26 +1,32 @@ Package: swirl -Title: Learn R, in R. -Description: swirl turns the R console into an interactive learning +Title: Learn R, in R +Description: Use the R console as an interactive learning environment. Users receive immediate feedback as they are guided through self-paced lessons in data science and R programming. URL: http://swirlstats.com -Version: 2.2.15 -License: GPL-3 +Version: 2.4.5 +License: MIT + file LICENSE Authors@R: c( - person("Nick", "Carchedi", email = "nick.carchedi@gmail.com", - role = c("aut", "cre")), + person("Sean", "Kross", email = "sean@seankross.com", role = c("aut", "cre")), + person("Nick", "Carchedi", role = "aut"), person("Bill", "Bauer", role = "aut"), person("Gina", "Grdina", role = "aut"), - person("Sean", "Kross", role = "aut") + person("Filip", "Schouwenaars", role = "ctb"), + person("Wush", "Wu", role = "ctb") ) Depends: - R (>= 3.0.2) + R (>= 3.1.0) Imports: stringr, - testthat, - httr, + testthat (>= 1.0.2), + httr (>= 1.1.0), yaml, RCurl, digest, - tools -Roxygen: list(wrap = FALSE) + tools, + methods +Suggests: + stringi +Encoding: UTF-8 +LazyData: true +RoxygenNote: 7.0.2 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..996c8c4 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +YEAR: 2017 +COPYRIGHT HOLDER: Team swirl \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 3e459d3..05ad7ba 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,10 @@ -# Generated by roxygen2 (4.0.1): do not edit by hand +# Generated by roxygen2: do not edit by hand export(bye) +export(delete_progress) export(email_admin) export(info) +export(install_course) export(install_course_directory) export(install_course_dropbox) export(install_course_github) @@ -10,13 +12,19 @@ export(install_course_google_drive) export(install_course_url) export(install_course_zip) export(install_from_swirl) +export(is_robust_match) export(main) export(nxt) export(play) export(reset) +export(restart) +export(rmatch_calls) +export(select_language) export(skip) export(submit) export(swirl) +export(swirl_options) +export(uninstall_all_courses) export(uninstall_course) export(zip_course) importFrom(RCurl,base64) @@ -25,22 +33,19 @@ importFrom(RCurl,postForm) importFrom(digest,digest) importFrom(httr,GET) importFrom(httr,content) +importFrom(httr,progress) +importFrom(methods,is) importFrom(stringr,fixed) -importFrom(stringr,perl) importFrom(stringr,str_c) importFrom(stringr,str_detect) importFrom(stringr,str_extract) importFrom(stringr,str_length) importFrom(stringr,str_locate) +importFrom(stringr,str_match) importFrom(stringr,str_split) importFrom(stringr,str_split_fixed) importFrom(stringr,str_trim) -importFrom(testthat,equals) -importFrom(testthat,expectation) -importFrom(testthat,is_a) -importFrom(testthat,is_equivalent_to) -importFrom(testthat,is_identical_to) -importFrom(testthat,matches) +importFrom(testthat,compare) importFrom(tools,file_ext) importFrom(tools,file_path_sans_ext) importFrom(yaml,yaml.load) diff --git a/NEWS.md b/NEWS.md index 35c3fb8..6e53078 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,91 @@ +# swirl 2.4.5 + +* Thank you @HenrikBengtsson for fixing a warning when +`warnPartialMatchArgs=TRUE`. (#779) + +# swirl 2.4.4 + +* Fixed encoding test which was failing on CRAN (debian-clang-devel). + +# swirl 2.4.3 + +* Added "swirl_is_fun" option to `swirl_options()`. + +* Added Portuguese menu translations. + +# swirl 2.4.2 + +* Script questions behave more appropriately in RStudio. (#434, thank you @jimhester) + +# swirl 2.4.1 + +* Added new answer test: `calculates_same_value()`. + +* Now compatible with versions of testthat later than 0.11.0. + +# swirl 2.4.0 + +* Added support for multiple languages, including Spanish, French, German, +Turkish, Simplified Chinese, and Korean. The default language can be changed +using the function `select_language()`. + +* Added `install_course()` in order to install swirl courses that are +distributed in the .swc format. + +* The directories where swirl courses and where user data is stored can now be +explicitly specified. These options can be set using the function +`swirl_options()`. + +* It's now possible to log and collect a student's progression +through a swirl course. Enable logging with `swirl_options()`. + +* Improved support for displaying non-ASCII character sets +through UTF-8 encoding. + +* Now compatible with `swirlify::demo_lesson()`. + +# swirl 2.3.1 + +* Add progress bar to track download progress of a course. + +# swirl 2.3.0 + +* Add basic developer API to swirl, courtesy of @filipsch and @seankross. + +* 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. + +# swirl 2.2.21 + +* 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.) + +* Check for existence of variable in swirl.R to address issue with using `rm()` command. + +# swirl 2.2.20 + +* Fix troublesome bug in `omnitest` due to typo (thanks to @reginaastri). + +# swirl 2.2.19 + +* Add `uninstall_all_courses` function. + +# swirl 2.2.18 + +* Fix small bug in `omnitest` due to missing exclamation point (thanks to @wilcrofter). + +* Add `delete_progress` function (thanks to @seankross). + +# swirl 2.2.17 + +* Use of `partner.coursera.org` websites for Coursera submission is enabled. + +* `Omnitest` uses `rmatch_calls` (recursive `match.call`) to deal with legitimate variations of function and S3 method calls. + +# swirl 2.2.16 + +* Fix bug in `install_from_swirl()` that was causing `install_from_swirl("R Programming")` to install both `R Programming` and `R Programming Alt`. + +* Fix troublesome links to the swirl_courses repo. + # swirl 2.2.15 * Fix annoying typo in one of the "praise" messages. diff --git a/R/actions.R b/R/actions.R new file mode 100644 index 0000000..953e769 --- /dev/null +++ b/R/actions.R @@ -0,0 +1,52 @@ +do_nxt <- function(e)UseMethod("do_nxt") +do_reset <- function(e)UseMethod("do_rst") +do_submit <- function(e)UseMethod("do_submit") +do_play <- function(e)UseMethod("do_play") +do_main <- function(e)UseMethod("do_main") +do_restart <- function(e)UseMethod("do_restart") + +do_nxt.default <- function(e) { + ## Using the stored list of "official" swirl variables and values, + # assign variables of the same names in the global environment + # their "official" values, in case the user has changed them + # while playing. + if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv()) + swirl_out(s()%N%"Resuming lesson...") + e$playing <- FALSE + e$iptr <- 1 +} + +do_reset.default <- function(e) { + e$playing <- FALSE + e$reset <- TRUE + e$iptr <- 2 + 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.", + skip_after = TRUE) +} + +do_submit.default <- function(e) { + e$playing <- FALSE + # Get contents from user's submitted script + e$script_contents <- readLines(e$script_temp_path, warn = FALSE) + # Save expr to e + e$expr <- try(parse(text = e$script_contents), silent = TRUE) + swirl_out(s()%N%"Sourcing your script...", skip_after = TRUE) + try(source(e$script_temp_path, encoding = "UTF-8")) +} + +do_play.default <- function(e) { + 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) + e$playing <- TRUE +} + +do_main.default <- function(e) { + swirl_out(s()%N%"Returning to the main menu...") + # Remove the current lesson. Progress has been saved already. + if(exists("les", e, inherits=FALSE)){ + rm("les", envir=e, inherits=FALSE) + } +} + +do_restart.default <- function(e) { + swirl_out(s()%N%"This feature is not implemented yet for Swirl.") +} \ No newline at end of file diff --git a/R/answerTests.R b/R/answerTests.R index 7fff734..5bab27d 100644 --- a/R/answerTests.R +++ b/R/answerTests.R @@ -153,10 +153,10 @@ runTest.newcmd <- function(keyphrase,e){ correct.expr <- parse(text=rightside(keyphrase))[[1]] correct.ans <- eval(correct.expr) ansResults <- expectThat(e$val, - equals(correct.ans,label=correct.ans), + equals_legacy(correct.ans,label=correct.ans), label=e$val) callResults <- expectThat(as.expression(e$expr)[[1]], - is_identical_to(correct.expr,label=deparse(correct.expr)), + is_identical_to_legacy(correct.expr,label=deparse(correct.expr)), label=deparse(e$expr)) # identical(as.expression(e$expr)[[1]], as.expression(correct.expr)[[1]]) @@ -221,7 +221,7 @@ runTest.is_a <- function(keyphrase, e) { val <- e$val } label <- val - results <- expectThat(val, is_a(class), label=label) + results <- expectThat(val, is_a_legacy(class), label=label) if(is(e,"dev") && !results$passed)swirl_out(results$message) return(results$passed) } @@ -245,7 +245,7 @@ runTest.matches <- function(keyphrase, e) { correctVal <- tolower(str_trim(rightside(keyphrase))) userVal <- str_trim(as.character(e$val)) results <- expectThat(tolower(userVal), - matches(correctVal), + matches_legacy(correctVal), label=userVal) if(is(e,"dev") && !results$passed)swirl_out(results$message) return(results$passed) @@ -264,12 +264,12 @@ runTest.creates_var <- function(keyphrase, e){ } correctName <- rightside(keyphrase) if(is.na(correctName)){ - results <- expectThat(length(delta), equals(1), + results <- expectThat(length(delta), equals_legacy(1), label=paste(deparse(e$expr), "does not create a variable.")) } else { results <- expectThat(names(delta), - is_equivalent_to(correctName, label=correctName), + is_equivalent_to_legacy(correctName, label=correctName), label=paste(deparse(e$expr), "does not create a variable named", correctName)) @@ -295,7 +295,7 @@ runTest.equals <- function(keyphrase, e){ correctAns <- safeEval(parse(text=correctExpr)) if(length(correctAns) != 1)return(FALSE) results <- expectThat(e$var, - equals(correctAns[[1]], + equals_legacy(correctAns[[1]], label=correctExprLabel), label=deparse(e$expr)) if(is(e, "dev") && !results$passed)swirl_out(results$message) @@ -310,7 +310,7 @@ runTest.equivalent <- function(keyphrase,e) { correctExpr <- as.list(parse(text=rightside(keyphrase))) userExpr <- as.list(as.expression(e$expr)) results <- expectThat(userExpr, - is_equivalent_to(correctExpr,deparse(correctExpr)), + is_equivalent_to_legacy(correctExpr,deparse(correctExpr)), label=deparse(userExpr)) if(is(e,"dev") && !results$passed)swirl_out(results$message) @@ -345,7 +345,7 @@ runTest.expr_identical <- function(keyphrase, e){ expr <- e$expr if(is.expression(expr))expr <- expr[[1]] results <- expectThat(expr, - is_identical_to(correct, label=rightside(keyphrase)), + is_identical_to_legacy(correct, label=rightside(keyphrase)), label=deparse(expr)) if( is(e, "dev") && !results$passed)swirl_out(results$message) return(results$passed) @@ -359,7 +359,7 @@ runTest.val_length <- function(keyphrase, e){ stop(message=paste("BUG: right side of", keyphrase, "is not an integer.")) } - results <- expectThat(length(e$val), equals(n, label=n), + results <- expectThat(length(e$val), equals_legacy(n, label=n), label=paste0("length(c(", toString(e$val), "))")) if( is(e, "dev") && !results$passed)swirl_out(results$message) return(results$passed) @@ -435,7 +435,7 @@ uses_func <- function(expected, label = NULL, ...){ function(expr){ uses <- (is.call(expr) || is.expression(expr)) && expected %in% flatten(expr) - expectation(identical(uses, TRUE), + expectation_legacy(identical(uses, TRUE), str_c("does not use ", label)) } } @@ -446,12 +446,7 @@ in_range <- function(range, label=NULL){ isOK <- is.numeric(number) && isTRUE(number >= range[1]) && isTRUE(number <= range[2]) - expectation(identical(isOK, TRUE), + expectation_legacy(identical(isOK, TRUE), str_c("is not between ", range[1], " and ", range[2])) } } - - - - - diff --git a/R/answerTests2.R b/R/answerTests2.R index d267d33..3e69739 100644 --- a/R/answerTests2.R +++ b/R/answerTests2.R @@ -57,7 +57,7 @@ #' benefit of using tests other than the default is that the user will not be #' required to enter an expression exactly the way you've specified it. He or #' she will have more freedom in terms of how they respond to a question, as -#' long as they satify the conditions that you see as being most important. +#' long as they satisfy the conditions that you see as being most important. #' #' @section Predefined Answer Tests: #' Each of the predefined answer tests listed below has @@ -65,6 +65,8 @@ #' examples. #' #' \code{\link{any_of_exprs}}: Test that the user's expression matches any of several possible expressions. +#' +#' \code{\link{calculates_same_value}}: Test that the user's expression evaluates to a certain value. #' #' \code{\link{expr_creates_var}}: Test that a new variable has been created. #' @@ -116,7 +118,6 @@ #' #' @family AnswerTests NULL - #' Test for a correct expression, a correct value, or both. #' @@ -126,6 +127,7 @@ NULL #' @param correctExpr the correct or expected expression as a string #' @param correctVal the correct value (numeric or character) #' @param 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. +#' @param 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. #' @examples #' \dontrun{ #' @@ -159,22 +161,46 @@ NULL #' # In this case, if the user enters sd(x)*sd(x) the test will fail. #' #' } -#' @family AnswerTests -omnitest <- function(correctExpr=NULL, correctVal=NULL, strict=FALSE){ +#' @family AnswerTests +omnitest <- function(correctExpr=NULL, correctVal=NULL, strict=FALSE, eval_for_class=as.logical(NA)){ e <- get("e", parent.frame()) # Trivial case if(is.null(correctExpr) && is.null(correctVal))return(TRUE) + # If eval_for_class is not specified, default to customTests$EVAL_FOR_CLASS. + # If the latter is not set, default to TRUE. + if(is.na(eval_for_class)){ + if(exists("EVAL_FOR_CLASS", customTests)){ + eval_for_class <- isTRUE(customTests$EVAL_FOR_CLASS) + } else { + eval_for_class <- TRUE + } + } + # If eval_for_class is TRUE, create a parent environment for that in + # in which evaluations for class are to be made. + eval_env <- if(eval_for_class){ + cleanEnv(e$snapshot) + } else { + NULL + } # Testing for correct expression only if(!is.null(correctExpr) && is.null(correctVal)){ - return(expr_identical_to(correctExpr)) + err <- try({ + good_expr <- parse(text=correctExpr)[[1]] + ans <- is_robust_match(good_expr, e$expr, eval_for_class, eval_env) + }, silent=TRUE) + if (is(err, "try-error")) { + return(expr_identical_to(correctExpr)) + } else { + return(ans) + } } # Testing for both correct expression and correct value # Value must be character or single number - valGood <- NULL + valGood <- as.logical(NA) if(!is.null(correctVal)){ if(is.character(e$val)){ valResults <- expectThat(e$val, - is_equivalent_to(correctVal, label=correctVal), + is_equivalent_to_legacy(correctVal, label=correctVal), label=(e$val)) if(is(e, "dev") && !valResults$passed)swirl_out(valResults$message) valGood <- valResults$passed @@ -182,18 +208,26 @@ omnitest <- function(correctExpr=NULL, correctVal=NULL, strict=FALSE){ } else if(!is.na(e$val) && is.numeric(e$val) && length(e$val) == 1){ cval <- try(as.numeric(correctVal), silent=TRUE) valResults <- expectThat(e$val, - equals(cval, label=correctVal), + equals_legacy(cval, label=correctVal), label=toString(e$val)) if(is(e, "dev") && !valResults$passed)swirl_out(valResults$message) valGood <- valResults$passed } } - exprGood <- ifelse(is.null(correctExpr), TRUE, expr_identical_to(correctExpr)) - if(valGood && exprGood){ + # If a correct expression is given attempt a robust match with user's expression. + exprGood <- TRUE + if(!is.null(correctExpr)){ + err <- try({ + good_expr <- parse(text=correctExpr)[[1]] + ans <- is_robust_match(good_expr, e$expr, eval_for_class, eval_env) + }, silent=TRUE) + exprGood <- ifelse(is(err, "try-error"), expr_identical_to(correctExpr), ans) + } + if((isTRUE(valGood) || is.na(valGood)) && exprGood){ return(TRUE) - } else if (valGood && !exprGood && !strict){ - swirl_out("That's not the expression I expected but it works.") - swirl_out("I've executed the correct expression in case the result is needed in an upcoming question.") + } else if (isTRUE(valGood) && !exprGood && !strict){ + swirl_out(s()%N%"That's not the expression I expected but it works.") + swirl_out(s()%N%"I've executed the correct expression in case the result is needed in an upcoming question.") eval(parse(text=correctExpr),globalenv()) return(TRUE) } else { @@ -220,12 +254,36 @@ expr_identical_to <- function(correct_expression){ if(is.expression(expr))expr <- expr[[1]] correct <- parse(text=correct_expression)[[1]] results <- expectThat(expr, - is_identical_to(correct, label=correct_expression), + is_identical_to_legacy(correct, label=correct_expression), label=deparse(expr)) if( is(e, "dev") && !results$passed)swirl_out(results$message) return(results$passed) } +#' Test that the user's expression evaluates to a certain value. +#' +#' Test that the value calculated by the user's expression is the same as the +#' value calculated by the given expression. +#' @param expression An expression whose value will be compared to the value +#' of the user's expression. +#' @return \code{TRUE} or \code{FALSE} +#' @examples +#' \dontrun{ +#' # Test that a user's expression evaluates to a certain value +#' # +#' calculates_same_value('matrix(1:20, nrow=4, ncol=5)') +#' } +#' @family AnswerTests +calculates_same_value <- function(expression){ + e <- get("e", parent.frame()) + # Calculate what the user should have done. + eSnap <- cleanEnv(e$snapshot) + val <- eval(parse(text=expression), eSnap) + passed <- isTRUE(all.equal(val, e$val)) + if(!passed)e$delta <- list() + return(passed) +} + #' Test that the user's expression matches a regular expression. #' #' Returns \code{TRUE} if \code{as.character(e$val)} matches the regular @@ -245,7 +303,7 @@ val_matches <- function(regular_expression) { e <- get("e", parent.frame()) userVal <- str_trim(as.character(e$val)) results <- expectThat(userVal, - matches(regular_expression), + matches_legacy(regular_expression), label=userVal) if(is(e,"dev") && !results$passed)swirl_out(results$message) return(results$passed) @@ -290,7 +348,7 @@ var_is_a <- function(class, var_name) { if(exists(var_name, globalenv())){ val <- get(var_name, globalenv()) label <- val - results <- expectThat(val, is_a(class), label=label) + results <- expectThat(val, is_a_legacy(class), label=label) if(is(e,"dev") && !results$passed)swirl_out(results$message) return(results$passed) } else { @@ -316,7 +374,7 @@ expr_is_a <- function(class) { class <- str_trim(class) expr <- e$expr label <- deparse(e$expr) - results <- expectThat(expr, is_a(class), label=label) + results <- expectThat(expr, is_a_legacy(class), label=label) if(is(e,"dev") && !results$passed)swirl_out(results$message) return(results$passed) } @@ -372,12 +430,12 @@ expr_creates_var <- function(correctName=NULL){ e$delta } if(is.null(correctName)){ - results <- expectThat(length(delta), equals(1), + results <- expectThat(length(delta), equals_legacy(1), label=paste(deparse(e$expr), "does not create a variable.")) } else { results <- expectThat(names(delta), - is_equivalent_to(correctName, label=correctName), + is_equivalent_to_legacy(correctName, label=correctName), label=paste(deparse(e$expr), "does not create a variable named", correctName)) @@ -412,7 +470,7 @@ val_has_length <- function(len){ stop(message=paste("BUG: specified length", len, "is not an integer.")) } - results <- expectThat(length(e$val), equals(n, label=n), + results <- expectThat(length(e$val), equals_legacy(n, label=n), label=paste0("length(c(", toString(e$val), "))")) if( is(e, "dev") && !results$passed)swirl_out(results$message) return(results$passed) @@ -441,7 +499,7 @@ func_of_newvar_equals <- function(correct_expression){ correctExpr <- gsub("newVar", e$newVarName, correct_expression) ans <- eval(parse(text=correctExpr), e1) results <- expectThat(e$val, - equals(ans, + equals_legacy(ans, label=correctExpr), label=deparse(e$expr)) if(is(e, "dev") && !results$passed)swirl_out(results$message) diff --git a/R/args_specification.R b/R/args_specification.R new file mode 100644 index 0000000..95a9465 --- /dev/null +++ b/R/args_specification.R @@ -0,0 +1,34 @@ +args_specification <- function(e, ...)UseMethod("args_specification") + +args_specification.default <- function(e, ...) { + # in normal, interactive mode, do nothing +} + +args_specification.test <- function(e, ...) { + # Capture ... args + targs <- list(...) + # Check if appropriately named args exist + if(is.null(targs$test_course) || is.null(targs$test_lesson)) { + stop(s()%N%"Must specify 'test_course' and 'test_lesson' to run in 'test' mode!") + } else { + # Make available for use in menu functions + e$test_lesson <- targs$test_lesson + e$test_course <- targs$test_course + } + # Check that 'from' is less than 'to' if they are both provided + if(!is.null(targs$from) && !is.null(targs$to)) { + if(targs$from >= targs$to) { + stop(s()%N%"Argument 'to' must be strictly greater than argument 'from'!") + } + } + if(is.null(targs$from)) { + e$test_from <- 1 + } else { + e$test_from <- targs$from + } + if(is.null(targs$to)) { + e$test_to <- 999 # Lesson will end naturally before this + } else { + e$test_to <- targs$to + } +} \ No newline at end of file diff --git a/R/courseraCheck.R b/R/courseraCheck.R index 04a90d9..59f1c08 100644 --- a/R/courseraCheck.R +++ b/R/courseraCheck.R @@ -3,14 +3,20 @@ courseraCheck <- function(e){ modtype <- attr(e$les, "type") lesson_name <- gsub(" ", "_", attr(e$les, "lesson_name")) if(is.null(modtype) || modtype != "Coursera")return() + + # allow use of Coursera partner sites (school.coursera.org) + partner <- attr(e$les, "partner") + partner <- ifelse(is.null(partner), "class", partner) + baseurl <- paste0("http://", partner, ".coursera.org/") + tt <- c(rep(letters, 3), seq(100)) - swirl_out("Are you currently enrolled in the Coursera course associated with this lesson?") + swirl_out(s()%N%"Are you currently enrolled in the Coursera course associated with this lesson?") yn <- select.list(c("Yes","No"), graphics=FALSE) if(yn=="No")return() ss <- lapply(1:2, function(i) { paste0(sample(tt, sample(seq(400), 1), replace=TRUE), collapse="") }) - swirl_out("Would you like me to notify Coursera that you've completed this lesson?", + swirl_out(s()%N%"Would you like me to notify Coursera that you've completed this lesson?", "If so, I'll need to get some more info from you.") choice <- select.list(c("Yes","No","Maybe later"), graphics=FALSE) if(choice=="No") return() @@ -32,10 +38,10 @@ courseraCheck <- function(e){ if(choice=="Maybe later") ok <- TRUE # If doing automatic submission, then give it a try. if(choice=="Yes"){ - swirl_out("I'll try to tell Coursera you've completed this lesson now.") - challenge.url <- paste("http://class.coursera.org", course_name, + swirl_out(s()%N%"I'll try to tell Coursera you've completed this lesson now.") + challenge.url <- paste(baseurl, course_name, "assignment/challenge", sep = "/") - submit.url <- paste("http://class.coursera.org", course_name, + submit.url <- paste(baseurl, course_name, "assignment/submit", sep = "/") ch <- try(getChallenge(email, challenge.url), silent=TRUE) # Check if url is valid, i.e. challenge received @@ -50,9 +56,9 @@ courseraCheck <- function(e){ signature=ch$state) # If incorrect, empty string will be returned if(!length(results)) { - swirl_out("You skipped too many questions! You'll need to complete", - "this lesson again if you'd like to receive credit. Please", - "don't skip more than one question next time.") + swirl_out(s()%N%"You skipped too many questions! You'll need to complete", + s()%N%"this lesson again if you'd like to receive credit. Please", + s()%N%"don't skip more than one question next time.") return() } if(!is(results, "try-error")){ @@ -66,34 +72,34 @@ courseraCheck <- function(e){ # to be set up eventually. swirl_out(results) if(!str_detect(results, "[Ee]xception")){ - swirl_out(paste0("I've notified Coursera that you have completed ", + swirl_out(paste0(s()%N%"I've notified Coursera that you have completed ", course_name, ", ", lesson_name,".")) # Remove manual submission text file unlink(output_filename) # Exit loop since submission successful return() } - swirl_out("I'm sorry, something went wrong with automatic submission.") + swirl_out(s()%N%"I'm sorry, something went wrong with automatic submission.") # Exit loop if user doesn't want to retry auto submission ok <- !retry() } else { - swirl_out("I'm sorry, something went wrong with automatic submission.") + swirl_out(s()%N%"I'm sorry, something went wrong with automatic submission.") # Exit loop if user doesn't want to retry auto submission ok <- !retry() } } else { - swirl_out("I'm sorry, something went wrong with establishing connection.") + swirl_out(s()%N%"I'm sorry, something went wrong with establishing connection.") # Exit loop if user doesn't want to retry auto submission ok <- !retry() } } # end of yes branch } # end of while loop - swirl_out("To notify Coursera that you have completed this lesson,", - "please upload", sQuote(output_filename), - "to Coursera manually. You may do so by visiting the Programming", - "Assignments page on your course website and selecting the Submit", - "button next to the appropriate swirl lesson.", - "I've placed the file in the following directory:", + swirl_out(s()%N%"To notify Coursera that you have completed this lesson,", + s()%N%"please upload", sQuote(output_filename), + s()%N%"to Coursera manually. You may do so by visiting the Programming", + s()%N%"Assignments page on your course website and selecting the Submit", + s()%N%"button next to the appropriate swirl lesson.", + s()%N%"I've placed the file in the following directory:", skip_after=TRUE) message(getwd(), "\n") readline("...") @@ -101,17 +107,17 @@ courseraCheck <- function(e){ # Returns TRUE if user would like to retry, FALSE if not retry <- function() { - swirl_out("Would you like to retry automatic submission or just submit manually?") + swirl_out(s()%N%"Would you like to retry automatic submission or just submit manually?") ans <- select.list(c("Retry automatic submission", "Submit manually"), graphics=FALSE) # Return TRUE if user would like to retry return(ans == "Retry automatic submission") } get_courseid <- function() { - swirl_out("The first item I need is your Course ID. For example, if the", - "homepage for your Coursera course was", - "'https://class.coursera.org/rprog-001',", - "then your course ID would be 'rprog-001' (without the quotes).", + swirl_out(s()%N%"The first item I need is your Course ID. For example, if the", + s()%N%"homepage for your Coursera course was", + s()%N%"'https://class.coursera.org/rprog-001',", + s()%N%"then your course ID would be 'rprog-001' (without the quotes).", skip_after=TRUE) repeat { courseid <- readline("Course ID: ") @@ -129,25 +135,25 @@ get_courseid <- function() { } else { # Check if courseid is a url if(is_url) { - swirl_out("It looks like you entered a web address, which is not what I'm", - "looking for.") + swirl_out(s()%N%"It looks like you entered a web address, which is not what I'm", + s()%N%"looking for.") } # Check if courseid is all numbers if(is_numbers) { - swirl_out("It looks like you entered a numeric ID, which is not what I'm", - "looking for.") + swirl_out(s()%N%"It looks like you entered a numeric ID, which is not what I'm", + s()%N%"looking for.") } # Check if the user stole the example courseid if(is_example) { - swirl_out("It looks like you entered the Course ID that I used as an", - "example, which is not what I'm looking for.") + swirl_out(s()%N%"It looks like you entered the Course ID that I used as an", + s()%N%"example, which is not what I'm looking for.") } } - swirl_out("Instead, I need your Course ID, which is the last", - "part of the web address for your Coursera course.", - "For example, if the homepage for your Coursera course was", - "'https://class.coursera.org/rprog-001',", - "then your course ID would be 'rprog-001' (without the quotes).", + swirl_out(s()%N%"Instead, I need your Course ID, which is the last", + s()%N%"part of the web address for your Coursera course.", + s()%N%"For example, if the homepage for your Coursera course was", + s()%N%"'https://class.coursera.org/rprog-001',", + s()%N%"then your course ID would be 'rprog-001' (without the quotes).", skip_after=TRUE) } courseid @@ -173,7 +179,7 @@ getCreds <- function(e) { r <- readLines(credfile, warn=FALSE) names(r) <- c("courseid", "email", "passwd") } - swirl_out("Is the following information correct?", skip_after=TRUE) + swirl_out(s()%N%"Is the following information correct?", skip_after=TRUE) message("Course ID: ", r['courseid'], "\nSubmission login (email): ", r['email'], "\nSubmission password: ", r['passwd']) diff --git a/R/global.R b/R/global.R new file mode 100644 index 0000000..b94782e --- /dev/null +++ b/R/global.R @@ -0,0 +1,5 @@ +utils::globalVariables(c("URLencode", "browseURL", "capture.output", + "file.edit", "getS3method", "head", "install.packages", + "packageVersion", "read.csv", "select.list", "sessionInfo", + "setTxtProgressBar", "tail", "txtProgressBar", "unzip", + "zip")) \ No newline at end of file diff --git a/R/install_course.R b/R/install_course.R index 2c00693..7235b87 100644 --- a/R/install_course.R +++ b/R/install_course.R @@ -7,17 +7,82 @@ #' file, which you can consult for more details. #' #' If you're just getting started, we recommend using -#' \code{\link{install_from_swirl}} to install courses +#' \code{\link{install_course}} to install courses #' from our official \href{https://github.com/swirldev/swirl_courses}{course repository}. Otherwise, check out the #' help file for the relevant install function below. #' #' You can uninstall a course from swirl at any time with #' \code{\link{uninstall_course}}. #' +#' Uninstall all courses with +#' \code{\link{uninstall_all_courses}}. +#' #' @name InstallCourses #' @family InstallCourses NULL +#' Install a course from The swirl Course Network or install a course from a +#' local .swc file. +#' +#' @description +#' Version 2.4 of swirl introduces a new, simple, and fast way of installing +#' courses in the form of \code{.swc} files. This function allows a user to grab +#' a \code{.swc} file from The swirl Course Network which is maintained by Team +#' swirl, or the user can use this function to install a local \code{.swc} file. +#' When using this function please only provide an argument for either +#' \code{course_name} or \code{swc_path}, never both. +#' +#' @param course_name The name of the course you wish to install. +#' @param swc_path The path to a local \code{.swc} file. By default this +#' argument defaults to \code{file.choose()} so the user can select the file using +#' their mouse. +#' @param force Should course installation be forced? The +#' default value is \code{FALSE}. +#' @importFrom httr GET progress content +#' @export +#' @family InstallCourses +#' @examples +#' \dontrun{ +#' +#' # Install the latest version of Team swirl's R Programming course. +#' install_course("R Programming") +#' +#' # Install a local .swc file by using your mouse and keyboard to select the +#' # file. +#' install_course() +#' +#' # Install a .swc file from a specific path. +#' install_course(swc_path = file.path("~", "Downloads", "R_Programming.swc")) +#' +#' } +install_course <- function(course_name = NULL, swc_path = NULL, force = FALSE){ + if(is.null(course_name) && is.null(swc_path)){ + swc_path <- file.choose() + } + + if(!is.null(course_name) && !is.null(swc_path)){ + stop(s()%N%"Please specify a value for either course_name or swc_path but not both.") + } else if(!is.null(swc_path)){ + unpack_course(swc_path, swirl_courses_dir()) + } else { # install from swirl course network + course_name <- make_pathname(course_name) + url <- paste0("http://swirlstats.com/scn/", course_name, ".swc") + + # Send GET request + response <- suppressWarnings(GET(url, progress())) + + if(response$status_code != 200){ + swirl_out(s()%N%"It looks like your internet connection is not working.", + s()%N%"Go to http://swirlstats.com/scn/ and download the .swc file that corresponds to the course you wish to install.", + s()%N%"After downloading the .swc run install_course() and choose the file you downloaded.") + stop(s()%N%"Could not connect to course file.") + } + + temp_swc <- tempfile() + writeBin(content(response, "raw"), temp_swc) + unpack_course(temp_swc, swirl_courses_dir(), force = force) + } +} #' Install a course from the official course repository #' @@ -33,10 +98,16 @@ NULL #' you to access this repository. Content in the swirl_misc repository #' is not guaranteed to work. #' +#' The central repository of swirl courses is mirrored at +#' \url{https://bitbucket.org/swirldevmirror/swirl_courses}. If you cannot +#' access GitHub you can download swirl courses from bitbucket by using the +#' \code{mirror = "bitbucket"} option (see below). +#' #' @param course_name The name of the course you wish to install. #' @param dev Set to \code{TRUE} to install a course in development from the swirl_misc repository. +#' @param mirror Select swirl course repository mirror. Valid arguments are \code{"github"} and \code{"bitbucket"}. #' @export -#' @importFrom httr GET content +#' @importFrom httr GET content progress #' @examples #' \dontrun{ #' @@ -48,32 +119,45 @@ NULL #' #' # To install a course in development from the swirl_misc repository #' install_from_swirl("Including Data", dev = TRUE) +#' +#' # To install a course from the Bitbucket mirror +#' install_from_swirl("R Programming", mirror = "bitbucket") #' } #' @family InstallCourses -install_from_swirl <- function(course_name, dev = FALSE){ +install_from_swirl <- function(course_name, dev = FALSE, mirror = "github"){ # Validate arguments if(!is.character(course_name)) { - stop("Argument 'course_name' must be surrounded by quotes (i.e. a character string)!") + stop(s()%N%"Argument 'course_name' must be surrounded by quotes (i.e. a character string)!") } if(!is.logical(dev)) { - stop("Argument 'dev' must be either TRUE or FALSE!") + stop(s()%N%"Argument 'dev' must be either TRUE or FALSE!") } - + if(!(mirror == "github" || mirror == "bitbucket")){ + stop(s()%N%"Please enter a valid name for a mirror. ('github' or 'bitbucket')") + } + # make pathname from course_name course_name <- make_pathname(course_name) # Construct url to the appropriate zip file if(dev) { + if(mirror != "github"){ + stop(s()%N%"To access swirl courses in development on Bitbucket go to https://bitbucket.org/swirldevmirror/swirl_misc") + } url <- "http://github.com/swirldev/swirl_misc/zipball/master" } else { - url <- "http://github.com/swirldev/swirl_courses/zipball/master" + if(mirror == "bitbucket"){ + url <- "https://bitbucket.org/swirldevmirror/swirl_courses/get/HEAD.zip" + } else { + url <- "http://github.com/swirldev/swirl_courses/zipball/master" + } } # Send GET request - response <- GET(url) + response <- GET(url, progress()) # Construct path to Courses - path <- file.path(system.file("Courses", package = "swirl"), "temp.zip") + path <- file.path(swirl_courses_dir(), "temp.zip") # Write the response as a zip writeBin(content(response, "raw"), path) @@ -82,35 +166,34 @@ install_from_swirl <- function(course_name, dev = FALSE){ file_names <- unzip(path, list=TRUE)$Name # Filter list - unzip_list <- Filter(function(x){grepl(course_name, x)}, file_names) + unzip_list <- Filter(function(x) + {grepl(paste0("/", course_name, "/"), x)}, + file_names + ) # Check if course exists if(length(unzip_list) == 0) { - stop(paste0("Course '", course_name, "' not found in course repository! ", - "Make sure you've got the name exactly right, then try again.")) + stop(paste0(s()%N%"Course '", course_name, s()%N%"' not found in course repository! ", + s()%N%"Make sure you've got the name exactly right, then try again.")) } # Extract - unzip(path, exdir=file.path(system.file(package = "swirl"), "Courses"), - files=unzip_list) + unzip(path, exdir=swirl_courses_dir(), files=unzip_list) # Copy files from unzipped directory into Courses - top_dir <- file.path(system.file(package = "swirl"), "Courses", - sort(dirname(unzip_list))[1]) + top_dir <- file.path(swirl_courses_dir(), sort(dirname(unzip_list))[1]) dirs_to_copy <- list.files(top_dir, full.names=TRUE) - if(file.copy(dirs_to_copy, file.path(system.file(package = "swirl"), "Courses"), - recursive=TRUE)){ - swirl_out("Course installed successfully!", skip_after=TRUE) + if(file.copy(dirs_to_copy, swirl_courses_dir(), recursive=TRUE)){ + swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) } else { - swirl_out("Course installation failed.", skip_after=TRUE) + swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) } # Delete unzipped directory unlink(top_dir, recursive=TRUE, force=TRUE) # If __MACOSX exists, delete it. - unlink(file.path(system.file(package = "swirl"), "Courses", "__MACOSX"), - recursive=TRUE, force=TRUE) + unlink(file.path(swirl_courses_dir(), "__MACOSX"), recursive=TRUE, force=TRUE) # Delete temp.zip unlink(path, force=TRUE) @@ -121,6 +204,8 @@ install_from_swirl <- function(course_name, dev = FALSE){ #' Zip a course directory #' +#' \strong{Warning:} This function will be deprecated after swirl version 2.4. +#' #' @param path Path to the course directory to be zipped. #' @param dest Path to directory in which the \code{.zip} should be saved. The #' default value is \code{NULL}, which will cause the \code{.zip} to be @@ -134,6 +219,7 @@ install_from_swirl <- function(course_name, dev = FALSE){ #' } #' @family InstallCourses zip_course <- function(path, dest=NULL){ + .Deprecated("swirlify::pack_course") # Cleanse the path of the trailing slash path <- sub("/$", "", path) @@ -184,14 +270,62 @@ zip_course <- function(path, dest=NULL){ #' } #' @family InstallCourses uninstall_course <- function(course_name){ - path <- file.path(system.file(package = "swirl"), "Courses", - make_pathname(course_name)) + path <- file.path(swirl_courses_dir(), make_pathname(course_name)) if(file.exists(path)){ unlink(path, recursive=TRUE, force=TRUE) - message("Course uninstalled successfully!") + message(s()%N%"Course uninstalled successfully!") + } else { + stop(s()%N%"Course not found!") + } + invisible() +} + +#' Uninstall all courses +#' +#' @param force If \code{TRUE} the user will not be asked if they're sure they +#' want to delete the contents of the directory where courses are stored. The +#' default value is \code{FALSE} +#' @export +#' @examples +#' \dontrun{ +#' +#' uninstall_all_courses() +#' } +#' @family InstallCourses +uninstall_all_courses <- function(force = FALSE){ + path <- swirl_courses_dir() + yaml_exists <- file.exists(file.path(path, "suggested_courses.yaml")) + if(yaml_exists){ + temp_file <- tempfile() + file.copy(file.path(path, "suggested_courses.yaml"), temp_file) + } + if(file.exists(path)){ + if(!force){ + swirl_out(s()%N%"Are you sure you want to uninstall all swirl courses?", + s()%N%"This will delete all of the contents of your swirl course directory.") + selection <- select.list(c(s()%N%"Yes", s()%N%"No")) + if(selection == s()%N%"Yes"){ + unlink(path, recursive=TRUE, force=TRUE) + message(s()%N%"All courses uninstalled successfully!") + } else { + message("No courses were uninstalled.") + return() + } + } else { + unlink(path, recursive=TRUE, force=TRUE) + message(s()%N%"All courses uninstalled successfully!") + } } else { - stop("Course not found!") + stop(s()%N%"No courses found!") } + + dir.create(path, showWarnings = FALSE) + + if(yaml_exists){ + file.copy(temp_file, path) + file.rename(list.files(path, full.names = TRUE), file.path(path, "suggested_courses.yaml")) + } + invisible() } @@ -212,10 +346,10 @@ uninstall_course <- function(course_name){ #' @family InstallCourses install_course_zip <- function(path, multi=FALSE, which_course=NULL){ if(!is.logical(multi) || is.na(multi)) { - stop("Argument 'multi' must be either TRUE or FALSE.") + stop(s()%N%"Argument 'multi' must be either TRUE or FALSE.") } if(!multi && !is.null(which_course)) { - stop("Argument 'which_course' should only be specified when argument 'multi' is TRUE.") + stop(s()%N%"Argument 'which_course' should only be specified when argument 'multi' is TRUE.") } if(multi){ # Find list of files not in top level directory @@ -223,12 +357,10 @@ install_course_zip <- function(path, multi=FALSE, which_course=NULL){ # Filter list and extract unzip_list <- Filter(function(x){grepl("/.+/", x)}, file_names) - unzip(path, exdir=file.path(system.file(package = "swirl"), "Courses"), - files=unzip_list) + unzip(path, exdir = swirl_courses_dir(), files=unzip_list) # Copy files from unzipped directory into Courses - top_dir <- file.path(system.file(package = "swirl"), "Courses", - sort(dirname(unzip_list))[1]) + top_dir <- file.path(swirl_courses_dir(), sort(dirname(unzip_list))[1]) dirs_to_copy <- list.files(top_dir, full.names=TRUE) # Subset desired courses if specified with which_courses arg if(!is.null(which_course)) { @@ -236,15 +368,14 @@ install_course_zip <- function(path, multi=FALSE, which_course=NULL){ nomatch=-1) nomatch <- match_ind < 0 if(any(nomatch)) { - stop("Course ", sQuote(which_course[nomatch][1]), " not in specified directory. Be careful, course names are case sensitive!") + stop(s()%N%"Course ", sQuote(which_course[nomatch][1]), s()%N%" not in specified directory. Be careful, course names are case sensitive!") } dirs_to_copy <- dirs_to_copy[match_ind] } - if(file.copy(dirs_to_copy, file.path(system.file(package = "swirl"), - "Courses"), recursive=TRUE)){ - swirl_out("Course installed successfully!", skip_after=TRUE) + if(file.copy(dirs_to_copy, swirl_courses_dir(), recursive=TRUE)){ + swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) } else { - swirl_out("Course installation failed.", skip_after=TRUE) + swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) } # Delete unzipped directory @@ -252,13 +383,11 @@ install_course_zip <- function(path, multi=FALSE, which_course=NULL){ } else { # Unzip file into courses - file_list <- unzip(path, exdir=file.path(system.file(package = "swirl"), - "Courses")) + file_list <- unzip(path, exdir = swirl_courses_dir()) } # If __MACOSX exists, delete it. - unlink(file.path(system.file(package = "swirl"), "Courses", "__MACOSX"), - recursive=TRUE, force=TRUE) + unlink(file.path(swirl_courses_dir(), "__MACOSX"), recursive=TRUE, force=TRUE) invisible() } @@ -282,15 +411,14 @@ install_course_directory <- function(path){ # Check to make sure there are fewer than 1000 files in course directory if(length(garbage_result) > 1000){ - stop("Course directory is too large to install") + stop(s()%N%"Course directory is too large to install") } # Copy files - if(file.copy(path, file.path(system.file(package = "swirl"), "Courses"), - recursive=TRUE)){ - swirl_out("Course installed successfully!", skip_after=TRUE) + if(file.copy(path, swirl_courses_dir(), recursive=TRUE)){ + swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) } else { - swirl_out("Course installation failed.", skip_after=TRUE) + swirl_out(s()%N%"Course installation failed.", skip_after=TRUE) } invisible() @@ -362,8 +490,8 @@ install_course_google_drive <- function(url, multi=FALSE){ #' @param url URL that points to a zipped course directory #' @param multi The user should set to \code{TRUE} if the zipped directory contains multiple courses. The default value is \code{FALSE}. #' @export -#' @importFrom httr GET content -#' @importFrom stringr str_extract perl +#' @importFrom httr GET content progress +#' @importFrom stringr str_extract #' @examples #' \dontrun{ #' @@ -372,10 +500,10 @@ install_course_google_drive <- function(url, multi=FALSE){ #' @family InstallCourses install_course_url <- function(url, multi=FALSE){ # Send GET request - response <- GET(url) + response <- GET(url, progress()) # Construct path to Courses - path <- file.path(system.file(package = "swirl"), "Courses", "temp.zip") + path <- file.path(swirl_courses_dir(), "temp.zip") # Write the response as a zip writeBin(content(response, "raw"), path) @@ -386,20 +514,18 @@ install_course_url <- function(url, multi=FALSE){ # Clean up GitHub directory name if(grepl("github.com", url) && !multi){ # Get paths of every file in zip that will be extracted - file_names <- dirname(unzip(path, list = TRUE)$Name) + file_names <- dirname(unzip(path, list = TRUE)$Name) # Find subset of those names which is not equal to root, then get the shortest string from that subset old_name <- head( sort( file_names[which(file_names != ".")] ) , 1) # Extract course name course_name <- sub("/zipball", "", - str_extract(url, perl("[^/]+/{1}zipball")) ) + str_extract(url, "[^/]+/{1}zipball") ) # Rename unzipped directory - file.rename(file.path(system.file(package = "swirl"), - "Courses", old_name), - file.path(system.file(package = "swirl"), - "Courses", course_name)) + file.rename(file.path(swirl_courses_dir(), old_name), + file.path(swirl_courses_dir(), course_name)) } # Delete downloaded zip @@ -407,3 +533,38 @@ install_course_url <- function(url, multi=FALSE){ invisible() } + +unpack_course <- function(file_path, export_path, force = FALSE){ + # Remove trailing slash + export_path <- sub(paste0(.Platform$file.sep, "$"), replacement = "", export_path) + + pack <- readRDS(file_path) + course_path <- file.path(export_path, pack$name) + if(!force && file.exists(course_path) && interactive()){ + response <- "" + while(response != "Y"){ + response <- select.list(c("Y", "n"), title = paste("\n\n", course_path, "already exists.\nAre you sure you want to overwrite it? [Y/n]")) + if(response == "n") return(invisible(course_path)) + } + } + dir.create(course_path, showWarnings = FALSE) + for(i in 1:length(pack$files)){ + + # Make file's ultimate path + if(length(pack$files[[i]]$path) >= 2){ + 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]) + } else { + lesson_file_path <- pack$files[[i]]$path + } + file_path <- file.path(course_path, lesson_file_path) + + # If the directory the file needs to be in does not exist, create the dir + if(!file.exists(dirname(file_path))){ + dir.create(dirname(file_path), showWarnings = FALSE, recursive = TRUE) + } + + writeBin(pack$files[[i]]$raw_file, file_path, endian = pack$files[[i]]$endian) + } + swirl_out(s()%N%"Course installed successfully!", skip_after=TRUE) + invisible(course_path) +} diff --git a/R/instructionSet.R b/R/instructionSet.R index 03835eb..5b00538 100644 --- a/R/instructionSet.R +++ b/R/instructionSet.R @@ -6,10 +6,8 @@ present <- function(current.row, e)UseMethod("present") present.default <- function(current.row, e){ - # Suppress extra space if multiple choice - is_mult <- is(e$current.row, "mult_question") # Present output to user - swirl_out(current.row[, "Output"], skip_after=!is_mult) + post_exercise(e, current.row) # Initialize attempts counter, if necessary if(!exists("attempts", e)) e$attempts <- 1 # Increment pointer @@ -47,7 +45,7 @@ waitUser.text_order_question <- function(current.row, e){ waitUser.video <- function(current.row, e){ response <- readline("Yes or No? ") if(tolower(response) %in% c("y", "yes")){ - swirl_out("Type nxt() to continue") + swirl_out(s()%N%"Type nxt() to continue") e$prompt <- TRUE e$playing <- TRUE browseURL(current.row[,"VideoLink"]) @@ -79,7 +77,8 @@ waitUser.mult_question <- function(current.row, e){ # leading and trailing white space from the choices. choices <- str_trim(choices[[1]]) # Store the choice in e$val for testing - e$val <- select.list(sample(choices), graphics=FALSE) + e$val <- post_mult_question(e, choices) + e$iptr <- 1 + e$iptr } @@ -151,6 +150,13 @@ waitUser.script <- function(current.row, e){ testResponse <- function(current.row, e)UseMethod("testResponse") testResponse.default <- function(current.row, e){ + if(isTRUE(getOption("swirl_logging"))){ + e$log$question_number <- c(e$log$question_number, e$row) + e$log$attempt <- c(e$log$attempt, e$attempts) + e$log$skipped <- c(e$log$skipped, e$skipped) + e$log$datetime <- c(e$log$datetime, as.numeric(Sys.time())) + } + # Increment attempts counter e$attempts <- 1 + e$attempts # Get answer tests @@ -158,7 +164,7 @@ testResponse.default <- function(current.row, e){ if(is.na(tests) || tests == ""){ results <- is(e, "dev") if(!results){ - stop("BUG: There are no tests for this question!") + stop(s()%N%"BUG: There are no tests for this question!") } } else { tests <- str_trim(unlist(strsplit(tests,";"))) @@ -166,12 +172,21 @@ testResponse.default <- function(current.row, e){ } correct <- !(FALSE %in% unlist(results)) if(correct){ - swirl_out(praise()) + if(isTRUE(getOption("swirl_logging"))){ + e$log$correct <- c(e$log$correct, TRUE) + } + + mes <- praise() + post_result(e, passed = correct, feedback = mes, hint = NULL) e$iptr <- 1 e$row <- 1 + e$row # Reset attempts counter, since correct e$attempts <- 1 } else { + if(isTRUE(getOption("swirl_logging"))){ + e$log$correct <- c(e$log$correct, FALSE) + } + # Restore the previous global environment from the official # in case the user has garbled it, e.g., has typed x <- 3*x # instead of x <- 2*x by mistake. The hint might say to type @@ -179,21 +194,15 @@ testResponse.default <- function(current.row, e){ # of x unless the original value is restored. if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv()) mes <- tryAgain() - if(is(current.row, "cmd_question")) { - mes <- paste(mes, "Or, type info() for more options.") - } - swirl_out(mes) - temp <- current.row[,"Hint"] - # Suppress extra space if multiple choice - is_mult <- is(e$current.row, "mult_question") - # If hint is specified, print it. Otherwise, just skip a line. - if (!is.na(temp)) { - swirl_out(current.row[,"Hint"], skip_after=!is_mult) - } else { - message() + if(is(current.row, "cmd_question") && !is(e, "datacamp")) { + mes <- paste(mes, s()%N%"Or, type info() for more options.") } + hint <- current.row[,"Hint"] + post_result(e, passed = correct, feedback = mes, hint = if(is.na(hint)) NULL else hint) e$iptr <- e$iptr - 1 } + # reset skipped info + e$skipped <- FALSE } testMe <- function(keyphrase, e){ diff --git a/R/languages.R b/R/languages.R new file mode 100644 index 0000000..0394e0a --- /dev/null +++ b/R/languages.R @@ -0,0 +1,113 @@ +swirl_language <- function(){ + lang <- getOption("swirl_language") + langs <- c("chinese_simplified", "dutch", "english", + "french", "german", "german_formal", "korean", "portuguese", + "spanish", "turkish") + + if(is.null(lang) || !(lang %in% langs)){ + "english" + } else { + lang + } +} + +#' Select a language +#' +#' Select a language for swirl's menus. +#' @param language The language that swirl's menus will use. +#' This must be one of the following values: \code{"chinese_simplified"}. +#' \code{"english"}, \code{"french"}, \code{"german"}, +#' \code{"korean"}, \code{"spanish"}, or \code{"turkish"}. +#' If \code{NULL} the user will be asked to choose a language +#' interactively. The default value is \code{NULL}. +#' @param append_rprofile If \code{TRUE} this command will append +#' \code{options(swirl_language = [selected language])} to the end of your +#' Rprofile. The default value is \code{FALSE}. +#' +#' @export +select_language <- function(language = NULL, append_rprofile = FALSE){ + langs <- c("chinese_simplified", "dutch", "english", + "french", "german", "german_formal", "korean", "portuguese", + "spanish", "turkish") + if(is.null(language)){ + selection <- select.list(langs) + } else if(!(language %in% langs)){ + stop("Invalid value for 'language.'") + } else { + selection <- language + } + + options(swirl_language = selection) + + if(append_rprofile){ + opts <- paste0("options(swirl_language = '", selection, "')") + cat(opts, "\n", file = file.path("~", ".Rprofile"), append = TRUE) + } +} + +# set working directory to swirl repo before using +#' @importFrom yaml yaml.load_file +compile_languages <- function(){ + ctime <- as.integer(Sys.time()) + clone_dir <- file.path(tempdir(), ctime) + dir.create(clone_dir, showWarnings = FALSE) + git_clone <- paste("git clone https://github.com/swirldev/translations.git", clone_dir) + system(git_clone) + + menus_dir <- file.path(clone_dir, "menus") + menus <- list.files(menus_dir, pattern = "yaml$", full.names = TRUE) + + for(i in menus){ + lang_name <- sub(".yaml$", "", basename(i)) + cmd <- paste0(lang_name, " <- swirl:::wrap_encoding(yaml.load_file('", i, "'))") + eval(parse(text=cmd)) + } + + comma_sep_langs <- paste(sub(".yaml$", "", basename(menus)), collapse = ", ") + cmd <- paste0("save(", comma_sep_langs, ", file = file.path('R', 'sysdata.rda'))") + eval(parse(text=cmd)) + unlink(clone_dir, recursive = TRUE, force = TRUE) +} + +"%N%" <- function(f, y){ + result <- f(y) + if(is.null(result)){ + y + } else { + result + } +} + +s <- function(){ + s_helper +} + +s_helper <- function(x){ + cmd <- paste0(swirl_language(), "$`", x, "`") + tryCatch(eval(parse(text=cmd)), + warning = function(c) NULL + ) +} + +# set working directory to swirl repo before using +# make sure the global env is clear before using + +#' @importFrom stringr str_match +check_strings <- function(){ + load(file.path("R", "sysdata.rda")) + langs <- ls() + ##langs <- "english" + + for(i in list.files("R", pattern = "\\.R$")){ + source_code <- readLines(file.path("R", i), warn = FALSE) + strings <- grep("s\\(\\)%N%", source_code) + for(j in strings){ + for(l in langs){ + if(!(str_match(source_code[j], '"(.*?)"')[,2] %in% eval(parse(text = paste0("names(", l, ")"))))){ + message(l, " : '", str_match(source_code[j], '"(.*?)"')[,2], "' : ", i) + ##cat('"', str_match(source_code[j], '"(.*?)"')[,2], '"', ':\n "', str_match(source_code[j], '"(.*?)"')[,2], '"\n\n', sep = "") + } + } + } + } +} \ No newline at end of file diff --git a/R/lesson_constructor.R b/R/lesson_constructor.R index f18a913..b41e88d 100644 --- a/R/lesson_constructor.R +++ b/R/lesson_constructor.R @@ -1,12 +1,12 @@ # Constructor function for objects of class "lesson" lesson <- function(df, lesson_name=NULL, course_name=NULL, author=NULL, - type=NULL, organization=NULL, version=NULL) { + type=NULL, organization=NULL, version=NULL, partner=NULL) { if(!is.data.frame(df)) stop("Argument 'df' must be a data frame!") # Adding secondary class of data.frame allows lessons to retain data.frame attributes (e.g. dim()) structure(df, lesson_name=lesson_name, course_name=course_name, author=author, - type=type, organization=organization, version=version, + type=type, organization=organization, version=version, partner=partner, class=c("lesson", "data.frame")) } \ No newline at end of file diff --git a/R/log.R b/R/log.R new file mode 100644 index 0000000..363a85c --- /dev/null +++ b/R/log.R @@ -0,0 +1,7 @@ +saveLog <- function(e)UseMethod("saveLog") + +saveLog.default <- function(e){ + # save log + suppressMessages(suppressWarnings( + saveRDS(e$log, file.path(e$udat, paste0(as.integer(Sys.time()), ".swlog"))))) +} \ No newline at end of file diff --git a/R/menu.R b/R/menu.R index 3046c14..6acf560 100644 --- a/R/menu.R +++ b/R/menu.R @@ -6,6 +6,7 @@ housekeeping <- function(e, ...)UseMethod("housekeeping") inProgressMenu <- function(e, choices, ...)UseMethod("inProgressMenu") courseMenu <- function(e, courses)UseMethod("courseMenu") courseDir <- function(e)UseMethod("courseDir") +progressDir <- function(e)UseMethod("progressDir") lessonMenu <- function(e, choices)UseMethod("lessonMenu") restoreUserProgress <- function(e, selection)UseMethod("restoreUserProgress") loadLesson <- function(e, ...)UseMethod("loadLesson") @@ -26,7 +27,7 @@ mainMenu.default <- function(e){ # Welcome the user if necessary and set up progress tracking if(!exists("usr",e,inherits = FALSE)){ e$usr <- welcome(e) - udat <- file.path(find.package("swirl"), "user_data", e$usr) + udat <- file.path(progressDir(e), e$usr) if(!file.exists(udat)){ housekeeping(e) dir.create(udat, recursive=TRUE) @@ -58,15 +59,10 @@ mainMenu.default <- function(e){ # If no courses are available, offer to install one if(length(coursesU)==0){ - suggestions <- yaml.load_file(file.path(courseDir(e), "suggested_courses.yaml")) + suggestions <- yaml.load_file(file.path(find.package("swirl"), "Courses", "suggested_courses.yaml")) choices <- sapply(suggestions, function(x)paste0(x$Course, ": ", x$Description)) - swirl_out("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.)") - choices <- c(choices, "Don't install anything for me. I'll do it myself.") + 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.)") + choices <- c(choices, s()%N%"Don't install anything for me. I'll do it myself.") choice <- select.list(choices, graphics=FALSE) n <- which(choice == choices) if(length(n) == 0)return(FALSE) @@ -74,18 +70,18 @@ mainMenu.default <- function(e){ repeat { temp <- try(eval(parse(text=suggestions[[n]]$Install)), silent=TRUE) if(is(temp, "try-error")){ - swirl_out("Sorry, but I'm unable to fetch ", sQuote(choice), - "right now. Are you sure you have an internet connection?", - "If so, would you like to try again or visit", - "the course repository for instructions on how to", - "install a course manually? Type 0 to exit.") - ch <- c("Try again!", - "Send me to the course repository for manual installation.") + swirl_out(s()%N%"Sorry, but I'm unable to fetch ", sQuote(choice), + s()%N%"right now. Are you sure you have an internet connection?", + s()%N%"If so, would you like to try again or visit", + s()%N%"the course repository for instructions on how to", + s()%N%"install a course manually? Type 0 to exit.") + ch <- c(s()%N%"Try again!", + s()%N%"Send me to the course repository for manual installation.") resp <- select.list(ch, graphics=FALSE) if(resp == "") return(FALSE) if(resp == ch[2]) { - swirl_out("OK. I'm opening the swirl course respository in your browser.") - browseURL("https://github.com/swirldev/swirl_courses#install-and-run-a-course-manually") + swirl_out(s()%N%"OK. I'm opening the swirl course respository in your browser.") + browseURL("https://github.com/swirldev/swirl_courses") return(FALSE) } } else { @@ -93,13 +89,21 @@ mainMenu.default <- function(e){ } } coursesU <- dir(courseDir(e)) + if(length(coursesU) > 0){ + for(i in 1:length(coursesU)){ + coursesU[i] <- enc2utf8(coursesU[i]) + } + } + if(any(is.na(coursesU))){ + coursesU <- dir(courseDir(e)) + } # Eliminate empty directories idx <- unlist(sapply(coursesU, function(x)length(dir(file.path(courseDir(e),x)))>0)) coursesU <- coursesU[idx] } else { - swirl_out("OK. I'm opening the swirl course respository in your browser.") - browseURL("https://github.com/swirldev/swirl_courses#swirl-courses") + swirl_out(s()%N%"OK. I'm opening the swirl course respository in your browser.") + browseURL("https://github.com/swirldev/swirl_courses") return(FALSE) } } @@ -109,8 +113,8 @@ mainMenu.default <- function(e){ while(lesson == ""){ course <- courseMenu(e, coursesR) if(!is.null(names(course)) && names(course)=="repo") { - swirl_out("OK. I'm opening the swirl courses web page in your browser.") - browseURL("https://github.com/swirldev/swirl_courses#swirl-courses") + swirl_out(s()%N%"OK. I'm opening the swirl courses web page in your browser.") + browseURL("https://github.com/swirldev/swirl_courses") return(FALSE) } if(course=="")return(FALSE) @@ -119,6 +123,7 @@ mainMenu.default <- function(e){ # reverse path cosmetics courseU <- coursesU[course == coursesR] course_dir <- file.path(courseDir(e), courseU) + # Get all files/folders from course dir, excluding MANIFEST lessons <- dir(course_dir) lessons <- lessons[lessons != "MANIFEST"] @@ -129,6 +134,21 @@ mainMenu.default <- function(e){ lessons <- order_lessons(current_order=lessons, manifest_order=manifest) } + # If the manifest introduced NAs, try reading without UTF-8 + if(any(is.na(lessons))){ + manifest <- get_manifest(course_dir, utf8 = FALSE) + lessons <- order_lessons(current_order=lessons, + manifest_order=manifest) + } + # If there are still NAs, throw the manifest out + if(any(is.na(lessons))){ + lessons <- list.dirs(course_dir, full.names = FALSE, recursive = FALSE) + # Get rid of hidden folders if they exist + if(length(grep("^\\.", lessons)) > 0){ + lessons <- lessons[-grep("^\\.", lessons)] + } + } + # Clean up lesson names lessons_clean <- gsub("_", " ", lessons) # Let user choose the lesson. @@ -154,7 +174,7 @@ mainMenu.default <- function(e){ e$path <- file.path(courseDir(e), courseU, lesson) # If running in 'test' mode and starting partway through # lesson, then complete first part - if(is(e, "test") && e$test_from > 1) { + if((is(e, "test") || is(e, "datacamp")) && e$test_from > 1) { complete_part(e) } @@ -163,12 +183,14 @@ mainMenu.default <- function(e){ rm("temp_lesson_name", "temp_course_name", envir=e, inherits=FALSE) # Initialize the progress bar - e$pbar <- txtProgressBar(style=3) - e$pbar_seq <- seq(0, 1, length=nrow(e$les)) + if(!is(e,"datacamp")) { + e$pbar <- txtProgressBar(style=3) + } + e$pbar_seq <- seq(0, 1, length.out=nrow(e$les)) # expr, val, ok, and vis should have been set by the callback. # The lesson's current row - could start after 1 if in 'test' mode - if(is(e, 'test')) { + if(is(e, 'test') || is(e, 'datacamp')) { e$row <- e$test_from } else { e$row <- 1 @@ -189,8 +211,23 @@ mainMenu.default <- function(e){ e$progress <- file.path(e$udat, fname) # indicator that swirl is not reacting to console input e$playing <- FALSE + + # Create log + if(isTRUE(getOption("swirl_logging"))){ + e$log <- list(user = e$usr, + course_name = attr(e$les,"course_name"), + lesson_name = attr(e$les,"lesson_name"), + question_number = NULL, + correct = NULL, + attempt = NULL, + skipped = NULL, + datetime = NULL) + } + # create the file suppressMessages(suppressWarnings(saveRDS(e, e$progress))) + # post initialization message + post_init(e) } } return(TRUE) @@ -201,14 +238,14 @@ welcome.test <- function(e, ...){ } # Default version. +#' @importFrom stringr str_detect str_trim welcome.default <- function(e, ...){ - swirl_out("Welcome to swirl!") - swirl_out("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) - resp <- readline("What shall I call you? ") - while(str_detect(resp, '[[:punct:]]')) { - swirl_out("Please don't use any quotes or other punctuation in your name.", + 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) + resp <- readline(s()%N%"What shall I call you? ") + while(str_detect(resp, '[[:punct:]]') || nchar(str_trim(resp)) < 1) { + swirl_out(s()%N%"Please don't use any quotes or other punctuation in your name.", skip_after = TRUE) - resp <- readline("What shall I call you? ") + resp <- readline(s()%N%"What shall I call you? ") } return(resp) } @@ -218,14 +255,14 @@ welcome.default <- function(e, ...){ # @param e persistent environment used here only for its class attribute # housekeeping.default <- function(e){ - swirl_out(paste0("Thanks, ", e$usr,". Let's cover a few 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.")) - readline("\n... <-- That's your cue to press Enter to continue") - swirl_out("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.") - select.list(c("Continue.", "Proceed.", "Let's get going!"), - title="\nSelect 1, 2, or 3 and press Enter", graphics=FALSE) - swirl_out("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.") + 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.")) + readline(s()%N%"\n... <-- That's your cue to press Enter to continue") + 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.") + select.list(c(s()%N%"Continue.", s()%N%"Proceed.", s()%N%"Let's get going!"), + title=s()%N%"\nSelect 1, 2, or 3 and press Enter", graphics=FALSE) + 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.") info() - swirl_out("Let's get started!", skip_before=FALSE) + swirl_out(s()%N%"Let's get started!", skip_before=FALSE) readline("\n...") } @@ -233,8 +270,8 @@ housekeeping.test <- function(e){} # A stub. Eventually this should be a full menu inProgressMenu.default <- function(e, choices){ - nada <- "No. Let me start something new." - swirl_out("Would you like to continue with one of these lessons?") + nada <- s()%N%"No. Let me start something new." + swirl_out(s()%N%"Would you like to continue with one of these lessons?") selection <- select.list(c(choices, nada), graphics=FALSE) # return a blank if the user rejects all choices if(identical(selection, nada))selection <- "" @@ -247,9 +284,9 @@ inProgressMenu.test <- function(e, choices) { # A stub. Eventually this should be a full menu courseMenu.default <- function(e, choices){ - repo_option <- "Take me to the swirl course repository!" + repo_option <- s()%N%"Take me to the swirl course repository!" choices <- c(choices, repo = repo_option) - swirl_out("Please choose a course, or type 0 to exit swirl.") + swirl_out(s()%N%"Please choose a course, or type 0 to exit swirl.") return(select.list(choices, graphics=FALSE)) } @@ -259,7 +296,7 @@ courseMenu.test <- function(e, choices) { # A stub. Eventually this should be a full menu lessonMenu.default <- function(e, choices){ - swirl_out("Please choose a lesson, or type 0 to return to course menu.") + swirl_out(s()%N%"Please choose a lesson, or type 0 to return to course menu.") return(select.list(choices, graphics=FALSE)) } @@ -359,8 +396,12 @@ completed <- function(e){ return(pfiles) } -get_manifest <- function(course_dir) { - man <- readLines(file.path(course_dir, "MANIFEST"), warn=FALSE) +get_manifest <- function(course_dir, utf8 = TRUE) { + if(utf8){ + man <- readLines(file.path(course_dir, "MANIFEST"), warn=FALSE, encoding = "UTF-8") + } else { + man <- readLines(file.path(course_dir, "MANIFEST"), warn=FALSE) + } # Remove leading and trailing whitespace man <- str_trim(man) # Remove empty lines @@ -375,7 +416,11 @@ order_lessons <- function(current_order, manifest_order) { courseDir.default <- function(e){ # e's only role is to determine the method used - file.path(find.package("swirl"), "Courses") + swirl_courses_dir() +} + +progressDir.default <- function(e) { + swirl_data_dir() } # Default for determining the user diff --git a/R/options.R b/R/options.R new file mode 100644 index 0000000..dff930a --- /dev/null +++ b/R/options.R @@ -0,0 +1,56 @@ +# Get path to a lesson +lesson_path <- function(course_name, lesson_name){ + file.path(swirl_courses_dir(), course_name, lesson_name) +} + +# Get swirl data file path +swirl_data_dir <- function(){ + sdd <- getOption("swirl_data_dir") + + if(is.null(sdd)){ + file.path(find.package("swirl"), "user_data") + } else { + sdd + } +} + +# Get swirl courses dir +swirl_courses_dir <- function(){ + scd <- getOption("swirl_courses_dir") + + if(is.null(scd)){ + file.path(find.package("swirl"), "Courses") + } else { + scd + } +} + +#' Get swirl options +#' +#' This function is a wrapper for \code{options()} that allows the user to +#' see the state of how certain options for swirl are set up. +#' +#' @param ... any options can be defined, using name = value. +#' +#' @export +#' @examples +#' \dontrun{ +#' # See current current swirl options +#' swirl_options() +#' +#' # Set an option +#' swirl_options(swirl_logging = TRUE) +#' } +swirl_options <- function(...){ + if(length(list(...)) == 0){ + list( + swirl_courses_dir = getOption("swirl_courses_dir"), + swirl_data_dir = getOption("swirl_data_dir"), + swirl_language = getOption("swirl_language"), + swirl_logging = getOption("swirl_logging"), + swirl_is_fun = getOption("swirl_is_fun") + ) + } else { + options(...) + } +} \ No newline at end of file diff --git a/R/parse_content.R b/R/parse_content.R index e060c74..4672cd6 100644 --- a/R/parse_content.R +++ b/R/parse_content.R @@ -28,6 +28,21 @@ parse_content.rmd <- function(file, e) { rmd2df(file) } +wrap_encoding <- function(raw_yaml) { + if (class(raw_yaml) == "list") { + retval <- lapply(raw_yaml, wrap_encoding) + attributes(retval) <- attributes(raw_yaml) + retval + } else { + if (class(raw_yaml) == "character") { + if (Encoding(raw_yaml) == "unknown") { + Encoding(raw_yaml) <- "UTF-8" + } + } + raw_yaml + } +} + #' @importFrom yaml yaml.load_file parse_content.yaml <- function(file, e){ newrow <- function(element){ @@ -45,6 +60,7 @@ parse_content.yaml <- function(file, e){ temp } raw_yaml <- yaml.load_file(file) + raw_yaml <- wrap_encoding(raw_yaml) temp <- lapply(raw_yaml[-1], newrow) df <- NULL for(row in temp){ @@ -53,5 +69,5 @@ parse_content.yaml <- function(file, e){ meta <- raw_yaml[[1]] lesson(df, lesson_name=meta$Lesson, course_name=meta$Course, author=meta$Author, type=meta$Type, organization=meta$Organization, - version=meta$Version) -} \ No newline at end of file + version=meta$Version, partner=meta$Partner) +} diff --git a/R/phrases.R b/R/phrases.R index 2ba2a44..2374874 100644 --- a/R/phrases.R +++ b/R/phrases.R @@ -3,29 +3,29 @@ praise <- function() { swirl_is_fun <- getOption("swirl_is_fun") if(is.null(swirl_is_fun) || isTRUE(swirl_is_fun)) { - phrases <- c("You got it!", - "Nice work!", - "Keep up the great work!", - "You are doing so well!", - "All that hard work is paying off!", - "You nailed it! Good job!", - "You're the best!", - "You are amazing!", - "Keep working like that and you'll get there!", - "Perseverance, that's the answer.", - "Great job!", - "You are quite good my friend!", - "Your dedication is inspiring!", - "You got it right!", - "That's correct!", - "You are really on a roll!", - "Excellent job!", - "All that practice is paying off!", - "Excellent work!", - "That's a job well done!", - "That's the answer I was looking for.") + phrases <- c(s()%N%"You got it!", + s()%N%"Nice work!", + s()%N%"Keep up the great work!", + s()%N%"You are doing so well!", + s()%N%"All that hard work is paying off!", + s()%N%"You nailed it! Good job!", + s()%N%"You're the best!", + s()%N%"You are amazing!", + s()%N%"Keep working like that and you'll get there!", + s()%N%"Perseverance, that's the answer.", + s()%N%"Great job!", + s()%N%"You are quite good my friend!", + s()%N%"Your dedication is inspiring!", + s()%N%"You got it right!", + s()%N%"That's correct!", + s()%N%"You are really on a roll!", + s()%N%"Excellent job!", + s()%N%"All that practice is paying off!", + s()%N%"Excellent work!", + s()%N%"That's a job well done!", + s()%N%"That's the answer I was looking for.") } else { - phrases <- "Correct!" + phrases <- s()%N%"Correct!" } sample(phrases, 1) } @@ -35,22 +35,22 @@ tryAgain <- function() { swirl_is_fun <- getOption("swirl_is_fun") if(is.null(swirl_is_fun) || isTRUE(swirl_is_fun)) { - phrases <- c("Almost! Try again.", - "You almost had it, but not quite. Try again.", - "Give it another try.", - "Not quite! Try again.", - "Not exactly. Give it another go.", - "That's not exactly what I'm looking for. Try again.", - "Nice try, but that's not exactly what I was hoping for. Try again.", - "Keep trying!", - "That's not the answer I was looking for, but try again.", - "Not quite right, but keep trying.", - "You're close...I can feel it! Try it again.", - "One more time. You can do it!", - "Not quite, but you're learning! Try again.", - "Try again. Getting it right on the first try is boring anyway!") + phrases <- c(s()%N%"Almost! Try again.", + s()%N%"You almost had it, but not quite. Try again.", + s()%N%"Give it another try.", + s()%N%"Not quite! Try again.", + s()%N%"Not exactly. Give it another go.", + s()%N%"That's not exactly what I'm looking for. Try again.", + s()%N%"Nice try, but that's not exactly what I was hoping for. Try again.", + s()%N%"Keep trying!", + s()%N%"That's not the answer I was looking for, but try again.", + s()%N%"Not quite right, but keep trying.", + s()%N%"You're close...I can feel it! Try it again.", + s()%N%"One more time. You can do it!", + s()%N%"Not quite, but you're learning! Try again.", + s()%N%"Try again. Getting it right on the first try is boring anyway!") } else { - phrases <- "Incorrect. Please try again." + phrases <- s()%N%"Incorrect. Please try again." } sample(phrases, 1) } diff --git a/R/post.R b/R/post.R new file mode 100644 index 0000000..68d4907 --- /dev/null +++ b/R/post.R @@ -0,0 +1,44 @@ +post_init <- function(e) UseMethod("post_init") +post_exercise <- function(e, current.row) UseMethod("post_exercise") +post_mult_question <- function(e, choices) UseMethod("post_mult_question") +post_result <- function(e, passed, submission, feedback, hint) UseMethod("post_result") +post_progress <- function(e) UseMethod("post_progress") +post_finished <- function(e) UseMethod("post_finished") + +post_init.default <- function(e) { + # do nothing +} + +post_exercise.default <- function(e, current.row) { + # Suppress extra space if multiple choice + is_mult <- is(e$current.row, "mult_question") + # Present output to user + swirl_out(current.row[, "Output"], skip_after = !is_mult) +} + +post_mult_question.default <- function(e, choices) { + return(select.list(sample(choices), graphics=FALSE)) +} + +post_result.default <- function(e, passed, feedback, hint) { + swirl_out(feedback) + if(!passed) { + # If hint is specified, print it. Otherwise, just skip a line. + if(!is.null(hint)) { + # Suppress extra space if multiple choice + is_mult <- is(e$current.row, "mult_question") + swirl_out(hint, skip_after = !is_mult) + } else { + message() + } + } +} + +post_progress.default <- function(e) { + cat("\n") + setTxtProgressBar(e$pbar, e$pbar_seq[e$row]) +} + +post_finished.default <- function(e) { + swirl_out(s()%N%"Lesson complete! Exiting swirl now...", skip_after=TRUE) +} diff --git a/R/progress.R b/R/progress.R index d16e621..ee4bf3a 100644 --- a/R/progress.R +++ b/R/progress.R @@ -4,3 +4,33 @@ saveProgress.default <- function(e){ # save progress suppressMessages(suppressWarnings(saveRDS(e, e$progress))) } + +#' Delete a user's progress +#' +#' @param user The user name whose progress will be deleted. +#' @param path If specified, the directory where the user_data can be found +#' @export +#' @examples +#' \dontrun{ +#' +#' delete_progress("bill") +#' } +delete_progress <- function(user, path = NULL){ + # Make sure user entered a user name + if(nchar(user) < 1){ + stop("Please enter a valid username.") + } + + # Find path to user data + if(is.null(path)) { + path <- system.file("user_data", user, package = "swirl") + } + + # Delete all files within a user folder + if(file.exists(path)){ + invisible(file.remove(list.files(path, full.names = TRUE), recursive = TRUE)) + message(paste0(s()%N%"Deleted progress for user: ", user)) + } else { + message(paste0(s()%N%"Could not find account for user: ", user)) + } +} \ No newline at end of file diff --git a/R/rmatch_calls.R b/R/rmatch_calls.R new file mode 100644 index 0000000..1de6a23 --- /dev/null +++ b/R/rmatch_calls.R @@ -0,0 +1,144 @@ +# Reference: Creating a More Robust Version of Omnitest, https://github.com/swirldev/swirl/issues/196 + +#' Recursively expand both the correct expression and the user's expression and +#' test for a match. CAUTION: May raise errors, as in rmatch_calls. +#' +#' @export +#' @param expr1 expression +#' @param expr2 expression +#' @param eval_for_class TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE. +#' @param eval_env parent environment for evaluations to determine class. Ignored if eval_for_class=FALSE +#' @return TRUE or FALSE according to whether expanded expressions match. +#' @examples +#' \dontrun{ +#' +#' expr1 <- quote(print(paste("my_name_is", "mud"))) +#' expr2 <- quote(print(paste("my_name_is", "mud", sep=" "))) +#' err <- try(ans <- is_robust_match(expr1, expr2, eval_for_class=TRUE), silent=TRUE) +#' if(is(ans, "try-error")){ +#' ans <- isTRUE(all.equal()) +#' } +#' } +is_robust_match <- function(expr1, expr2, eval_for_class, eval_env=NULL){ + expr1 <- rmatch_calls(expr1, eval_for_class, eval_env) + expr2 <- rmatch_calls(expr2, eval_for_class, eval_env) + isTRUE(all.equal(expr1, expr2)) +} + +#' Recursively expand match calls in an expression from the bottom up. +#' +#' Given an expression, expr, traverse the syntax tree from the +#' bottom up, expanding the call to include default values of +#' named formals as appropriate, and applying match.call to the result. +#' Functionality is limited to expressions containing ordinary functions +#' or S3 methods. If parameter eval_for_class has its default value of FALSE, +#' an error will be raised for any S3 method whose first argument (as an expression) +#' is not atomic. If eval_for_class is TRUE, the first argument will be evaluated +#' to determine its class. Evaluation will take place in the environment given by +#' parameter eval_env. +#' CAUTION: eval_for_class=TRUE is likely to result in multiple evaluations of the same code. +#' Expressions containing S4 or reference class methods will also raise errors. +#' @export +#' @param expr an R expression (a.k.a. abstract syntax tree) +#' @param eval_for_class TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE. +#' @param eval_env environment in which to evaluate for class. Ignored if eval_for_class=FALSE +#' @return an equivalent R expression with function or method calls in canonical form. +#' @examples +#' \dontrun{ +#' +#' # Function +#' rmatch_calls(quote(help("print"))) +#' help(topic = "print", package = NULL, lib.loc = NULL, verbose = getOption("verbose"), +#' try.all.packages = getOption("help.try.all.packages"), help_type = getOption("help_type")) +#' +#' # S3 method with atomic first argument +#' rmatch_calls(quote(seq(0, 1, by=.5))) +#' seq(from = 0, to = 1, by = 0.5, length.out = NULL, along.with = NULL) +#' +#' # S3 method with non-atomic first argument, eval_for_class = FALSE (default) +#' rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) +#' #Error in rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) : +#' # Illegal expression, seq(as.Date(x = "2014-02-01"), as.Date(x = "2014-03-01")): +#' # The first argument, as.Date(x = "2014-02-01"), to S3 method 'seq', is a call, +#' # which (as an expression) is not atomic, hence its class can't be determined in an +#' # abstract syntax tree without additional information. +#' +#' # S3 method with non-atomic first argument, eval_for_class = TRUE +#' rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01"))), eval_for_class=TRUE) +#' seq(from = as.Date(x = "2014-02-01"), to = as.Date(x = "2014-03-01"), +#' length.out = NULL, along.with = NULL) +#' } +rmatch_calls <- function(expr, eval_for_class=FALSE, eval_env=NULL){ + # If expr is not a call, just return it. + if(!is.call(expr))return(expr) + # Replace expr's components with matched versions. + for(n in 1:length(expr)){ + expr[[n]] <- rmatch_calls(expr[[n]],eval_for_class) + } + # If match.fun(expr[[1]]) raises an exception here, the code which follows + # would be likely to give a misleading result. Catch the error merely to + # produce a better diagnostic. + tryCatch(fct <- match.fun(expr[[1]]), + error=function(e)stop(paste0("Illegal expression ", dprs(expr), + ": ", dprs(expr[[1]]), " is not a function.\n"))) + # If fct is a special function such as `$`, or builtin such as `+`, return expr. + if(is.primitive(fct)){ + return(expr) + } + # If fct is an (S4) standardGeneric, match.call is likely to give a misleading result, + # so raise an exception. (Note that builtins were handled earlier.) + if(is(fct, "standardGeneric")){ + stop(paste0("Illegal expression, ", dprs(expr), ": ", dprs(expr[[1]]), " is a standardGeneric.\n")) + } + # At this point, fct should be an ordinary function or an S3 method. + if(isS3(fct)){ + # If the S3 method's first argument, expr[[2]], is anything but atomic + # its class can't be determined here without evaluation. + if(!is.atomic(expr[[2]]) & !eval_for_class){ + stop(paste0("Illegal expression, ", dprs(expr),": The first argument, ", dprs(expr[[2]]), + ", to S3 method '", dprs(expr[[1]]), + "', is a ", class(expr[[2]]) , ", which (as an expression) is not atomic,", + " hence its class can't be determined in an abstract", + " syntax tree without additional information.\n")) + } + # Otherwise, attempt to find the appropriate method. + if(is.null(eval_env)){ + eval_env <- new.env() + } else { + eval_env <- new.env(parent=eval_env) + } + temp <- eval(expr[[2]], envir = eval_env) + classes <- try(class(temp), silent=TRUE) + for(cls in classes){ + err <- try(fct <- getS3method(as.character(expr[[1]]), cls), silent=TRUE) + if(!is(err, "try-error"))break + } + # If there was no matching method, attempt to find the default method. If that fails, + # raise an error + if(is(err, "try-error")){ + tryCatch(fct <- getS3method(as.character(expr[[1]]), "default"), + error = function(e)stop(paste0("Illegal expression ", dprs(expr), ": ", + "There is no matching S3 method or default for object, ", + dprs(expr[[2]]), ", of class, ", cls,".\n"))) + } + } + # Form preliminary match. If match.call raises an error here, the remaining code is + # likely to give a misleading result. Catch the error merely to give a better diagnostic. + tryCatch(expr <- match.call(fct, expr), + error = function(e)stop(paste0("Illegal expression ", dprs(expr), ": ", + dprs(expr[[1]]), " is not a function.\n"))) + # Append named formals with default values which are not included + # in the preliminary match + fmls <- formals(fct) + for(n in names(fmls)){ + if(!isTRUE(fmls[[n]] == quote(expr=)) && !(n %in% names(expr[-1]))){ + expr[n] <- fmls[n] + } + } + # match call again, for order + expr <- match.call(fct, expr) + return(expr) +} +# Helpers +isS3 <- function(fct)isTRUE(grep("UseMethod", body(fct)) > 0) +dprs <- function(expr)deparse(expr, width.cutoff=500) diff --git a/R/swirl.R b/R/swirl.R index d6fd3c5..7014882 100644 --- a/R/swirl.R +++ b/R/swirl.R @@ -36,8 +36,7 @@ #' @export #' @importFrom stringr str_c str_trim str_split str_length #' @importFrom stringr str_detect str_locate fixed str_split_fixed -#' @importFrom testthat expectation equals is_equivalent_to -#' @importFrom testthat is_identical_to is_a matches +#' @importFrom methods is #' @examples #' \dontrun{ #' @@ -96,7 +95,7 @@ swirl <- function(resume.class="default", ...){ #' } bye <- function(){ removeTaskCallback("mini") - swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) + swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) invisible() } @@ -214,38 +213,26 @@ play <- function(){invisible()} #' } main <- function(){invisible()} +#' Restart the current swirl lesson. +#' +#' Restart the current swirl lesson. +#' +#' @export +restart <- function(){invisible()} + #' Display a list of special commands. #' #' Display a list of the special commands, \code{bye()}, \code{play()}, #' \code{nxt()}, \code{skip()}, and \code{info()}. #' @export -#' @examples -#' \dontrun{ -#' -#' | Create a new variable called `z` that contains the number 11. -#' -#' > info() -#' -#' | When you are at the R prompt (>): -#' | -- Typing skip() allows you to skip the current question. -#' | -- Typing play() lets you experiment with R on your own; swirl will ignore what -#' | you do... -#' | -- UNTIL you type nxt() which will regain swirl's attention. -#' | -- Typing bye() causes swirl to exit. Your progress will be saved. -#' | -- Typing info() displays these options again. -#' -#' > bye() -#' -#' | Leaving swirl now. Type swirl() to resume. -#' } info <- function(){ - swirl_out("When you are at the R prompt (>):") - swirl_out("-- Typing skip() allows you to skip the current question.", skip_before=FALSE) - swirl_out("-- Typing play() lets you experiment with R on your own; swirl will ignore what you do...", skip_before=FALSE) - swirl_out("-- UNTIL you type nxt() which will regain swirl's attention.", skip_before=FALSE) - swirl_out("-- Typing bye() causes swirl to exit. Your progress will be saved.", skip_before=FALSE) - swirl_out("-- Typing main() returns you to swirl's main menu.", skip_before=FALSE) - swirl_out("-- Typing info() displays these options again.", skip_before=FALSE, skip_after=TRUE) + swirl_out(s()%N%"When you are at the R prompt (>):") + swirl_out(s()%N%"-- Typing skip() allows you to skip the current question.", skip_before=FALSE) + swirl_out(s()%N%"-- Typing play() lets you experiment with R on your own; swirl will ignore what you do...", skip_before=FALSE) + swirl_out(s()%N%"-- UNTIL you type nxt() which will regain swirl's attention.", skip_before=FALSE) + swirl_out(s()%N%"-- Typing bye() causes swirl to exit. Your progress will be saved.", skip_before=FALSE) + swirl_out(s()%N%"-- Typing main() returns you to swirl's main menu.", skip_before=FALSE) + swirl_out(s()%N%"-- Typing info() displays these options again.", skip_before=FALSE, skip_after=TRUE) invisible() } @@ -261,77 +248,33 @@ resume <- function(...)UseMethod("resume") # instruction set is thus extensible. It can be found in R/instructionSet.R. resume.default <- function(e, ...){ - # Check that if running in test mode, all necessary args are specified - if(is(e, "test")) { - # Capture ... args - targs <- list(...) - # Check if appropriately named args exist - if(is.null(targs$test_course) || is.null(targs$test_lesson)) { - stop("Must specify 'test_course' and 'test_lesson' to run in 'test' mode!") - } else { - # Make available for use in menu functions - e$test_lesson <- targs$test_lesson - e$test_course <- targs$test_course - } - # Check that 'from' is less than 'to' if they are both provided - if(!is.null(targs$from) && !is.null(targs$to)) { - if(targs$from >= targs$to) { - stop("Argument 'to' must be strictly greater than argument 'from'!") - } - } - if(is.null(targs$from)) { - e$test_from <- 1 - } else { - e$test_from <- targs$from - } - if(is.null(targs$to)) { - e$test_to <- 999 # Lesson will end naturally before this - } else { - e$test_to <- targs$to - } - } + # Specify additional arguments + args_specification(e, ...) esc_flag <- TRUE - on.exit(if(esc_flag)swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)) + on.exit(if(esc_flag)swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE)) # Trap special functions if(uses_func("info")(e$expr)[[1]]){ esc_flag <- FALSE return(TRUE) } - if(uses_func("nxt")(e$expr)[[1]]){ - ## Using the stored list of "official" swirl variables and values, - # assign variables of the same names in the global environment - # their "official" values, in case the user has changed them - # while playing. - if(length(e$snapshot)>0)xfer(as.environment(e$snapshot), globalenv()) - swirl_out("Resuming lesson...") - e$playing <- FALSE - e$iptr <- 1 + + if(uses_func("nxt")(e$expr)[[1]]){ + do_nxt(e) } # The user wants to reset their script to the original if(uses_func("reset")(e$expr)[[1]]) { - e$playing <- FALSE - e$reset <- TRUE - e$iptr <- 2 - swirl_out("I just reset the script to its original state. If it doesn't refresh immediately, you may need to click on it.", - skip_after = TRUE) + do_reset(e) } # The user wants to submit their R script if(uses_func("submit")(e$expr)[[1]]){ - e$playing <- FALSE - # Get contents from user's submitted script - e$script_contents <- readLines(e$script_temp_path, warn = FALSE) - # Save expr to e - e$expr <- try(parse(text = e$script_contents), silent = TRUE) - swirl_out("Sourcing your script...", skip_after = TRUE) - try(source(e$script_temp_path)) + do_submit(e) } if(uses_func("play")(e$expr)[[1]]){ - swirl_out("Entering play mode. Experiment as you please, then type nxt() when you are ready to resume the lesson.", skip_after=TRUE) - e$playing <- TRUE + do_play(e) } # If the user wants to skip the current question, do the bookkeeping. @@ -339,6 +282,7 @@ resume.default <- function(e, ...){ # Increment a skip count kept in e. if(!exists("skips", e)) e$skips <- 0 e$skips <- 1 + e$skips + e$skipped <- TRUE # Enter the correct answer for the user # by simulating what the user should have done correctAns <- e$current.row[,"CorrectAnswer"] @@ -355,10 +299,10 @@ resume.default <- function(e, ...){ # Source the correct script try(source(correct_script_path)) # Inform the user and open the correct script - swirl_out("I just sourced the following script, which demonstrates one possible solution.", + swirl_out(s()%N%"I just sourced the following script, which demonstrates one possible solution.", skip_after=TRUE) file.edit(correct_script_path) - readline("Press Enter when you are ready to continue...") + readline(s()%N%"Press Enter when you are ready to continue...") } # If this is not a script question... @@ -370,15 +314,23 @@ resume.default <- function(e, ...){ } e$expr <- parse(text=correctAns)[[1]] ce <- cleanEnv(e$snapshot) - e$val <- suppressMessages(suppressWarnings(eval(e$expr, ce))) + # evaluate e$expr keeping value and visibility information + # store the result in temporary object evaluation in order + # to avoid double potentially time consuming eval call + evaluation <- withVisible(eval(e$expr, ce)) + e$vis <- evaluation$visible + e$val <- suppressMessages(suppressWarnings(evaluation$value)) xfer(ce, globalenv()) ce <- as.list(ce) # Inform the user and expose the correct answer - swirl_out("Entering the following correct answer for you...", + swirl_out(s()%N%"Entering the following correct answer for you...", skip_after=TRUE) message("> ", e$current.row[, "CorrectAnswer"]) - + + if(e$vis & !is.null(e$val)) { + print(e$val) + } } # Make sure playing flag is off since user skipped @@ -393,11 +345,12 @@ resume.default <- function(e, ...){ # If the user want to return to the main menu, do the bookkeeping if(uses_func("main")(e$expr)[[1]]){ - swirl_out("Returning to the main menu...") - # Remove the current lesson. Progress has been saved already. - if(exists("les", e, inherits=FALSE)){ - rm("les", envir=e, inherits=FALSE) - } + do_main(e) + } + + # If the user want to restart the lesson, do the bookkeeping + if(uses_func("restart")(e$expr)[[1]]){ + do_restart(e) } # If user is looking up a help file, ignore their input @@ -421,7 +374,7 @@ resume.default <- function(e, ...){ temp <- mainMenu(e) # If menu returns FALSE, the user wants to exit. if(is.logical(temp) && !isTRUE(temp)){ - swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) + swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) esc_flag <- FALSE # To supress double notification return(FALSE) } @@ -435,6 +388,7 @@ resume.default <- function(e, ...){ if(!uses_func("swirl")(e$expr)[[1]] && !uses_func("swirlify")(e$expr)[[1]] && !uses_func("testit")(e$expr)[[1]] && + !uses_func("demo_lesson")(e$expr)[[1]] && !uses_func("nxt")(e$expr)[[1]] && isTRUE(customTests$AUTO_DETECT_NEWVAR)) { e$delta <- mergeLists(safeEval(e$expr, e), e$delta) @@ -445,10 +399,9 @@ resume.default <- function(e, ...){ # lesson from e, and invoke the top level menu method. # Below, min() ignores e$test_to if it is NULL (i.e. not in 'test' mode) if(e$row > min(nrow(e$les), e$test_to)) { - # If in test mode, we don't want to run another lesson - if(is(e, "test")) { - swirl_out("Lesson complete! Exiting swirl now...", - skip_after=TRUE) + # If in test or datacamp mode, we don't want to run another lesson + if(is(e, "test") || is(e, "datacamp")) { + post_finished(e) esc_flag <- FALSE # to supress double notification return(FALSE) } @@ -471,22 +424,27 @@ resume.default <- function(e, ...){ # Reset skip count if it exists if(exists("skips", e)) e$skips <- 0 clearCustomTests() + + # Save log + if(isTRUE(getOption("swirl_logging"))){ + saveLog(e) + } + # Let user know lesson is complete - swirl_out("You've reached the end of this lesson! Returning to the main menu...") + swirl_out(s()%N%"You've reached the end of this lesson! Returning to the main menu...") # let the user select another course lesson temp <- mainMenu(e) # if menu returns FALSE, user wants to quit. if(is.logical(temp) && !isTRUE(temp)){ - swirl_out("Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) + swirl_out(s()%N%"Leaving swirl now. Type swirl() to resume.", skip_after=TRUE) esc_flag <- FALSE # to supress double notification return(FALSE) } } # If we are ready for a new row, prepare it if(e$iptr == 1){ - # Increment progress bar - cat("\n") - setTxtProgressBar(e$pbar, e$pbar_seq[e$row]) + # Display progress + post_progress(e) # Any variables changed or created during the previous # question must have been correct or we would not be about @@ -509,7 +467,8 @@ resume.default <- function(e, ...){ # values of any variables in the official list. If so, add them # to the list of changed variables. for(nm in names(e$snapshot)){ - if(!identical(e$snapshot[[nm]], get(nm, globalenv()))){ + if(exists(nm, globalenv()) && + !identical(e$snapshot[[nm]], get(nm, globalenv()))){ e$delta[[nm]] <- get(nm, globalenv()) } } diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000..a7c219d Binary files /dev/null and b/R/sysdata.rda differ diff --git a/R/testthat_legacy.R b/R/testthat_legacy.R new file mode 100644 index 0000000..8018270 --- /dev/null +++ b/R/testthat_legacy.R @@ -0,0 +1,109 @@ +# The versions of the functions below have been graciously borrowed +# from version 0.11.0 of the testthat package by +# Hadley Wickham and others at RStudio. These APIs +# were broken in later versions of testthat and we know the +# old version works for our purposes. + +expectation_legacy <- function(passed, failure_msg, + success_msg = "unknown", + srcref = NULL) { + structure( + list( + passed = passed, + error = FALSE, + skipped = FALSE, + failure_msg = failure_msg, + success_msg = success_msg, + srcref = srcref + ), + class = "expectation" + ) +} + +#' @importFrom testthat compare +equals_legacy <- function(expected, label = NULL, ...) { + if (is.null(label)) { + label <- findExpr("expected") + } else if (!is.character(label) || length(label) != 1) { + label <- deparse(label) + } + + function(actual) { + same <- compare(actual, expected, ...) + + expectation_legacy( + same$equal, + paste0("not equal to ", label, "\n", same$message), + paste0("equals ", label) + ) + } +} + +is_a_legacy <- function(class) { + function(x) { + actual_s <- paste0(class(x), collapse = ", ") + class_s <- paste(class, collapse = ", ") + expectation_legacy( + inherits(x, class), + paste0("inherits from ", actual_s, " not ", class_s), + paste0("inherits from ", class_s) + ) + } +} + +is_equivalent_to_legacy <- function(expected, label = NULL) { + if (is.null(label)) { + label <- findExpr("expected") + } else if (!is.character(label) || length(label) != 1) { + label <- deparse(label) + } + function(actual) { + equals_legacy(expected, check.attributes = FALSE)(actual) + } +} + +is_identical_to_legacy <- function(expected, label = NULL) { + if (is.null(label)) { + label <- findExpr("expected") + } else if (!is.character(label) || length(label) != 1) { + label <- deparse(label) + } + + function(actual) { + if (identical(actual, expected)) { + diff <- "" + } else { + same <- all.equal(expected, actual) + if (isTRUE(same)) { + diff <- "Objects equal but not identical" + } else { + diff <- paste0(same, collapse = "\n") + } + } + + expectation_legacy( + identical(actual, expected), + paste0("is not identical to ", label, ". Differences: \n", diff), + paste0("is identical to ", label) + ) + } +} + +matches_legacy <- function(regexp, all = TRUE, ...) { + stopifnot(is.character(regexp), length(regexp) == 1) + function(char) { + matches <- grepl(regexp, char, ...) + if (length(char) > 1) { + values <- paste0("Actual values:\n", + paste0("* ", encodeString(char), collapse = "\n")) + } else { + values <- paste0("Actual value: \"", encodeString(char), "\"") + } + + expectation_legacy( + length(matches) > 0 && if (all) all(matches) else any(matches), + paste0("does not match '", encodeString(regexp), "'. ", values), + paste0("matches '", encodeString(regexp), "'") + ) + } +} \ No newline at end of file diff --git a/R/utilities.R b/R/utilities.R index 3e1fb18..078b45b 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -4,6 +4,7 @@ swirl_out <- function(..., skip_before=TRUE, skip_after=FALSE) { mes <- str_c("| ", wrapped, collapse = "\n") if(skip_before) mes <- paste0("\n", mes) if(skip_after) mes <- paste0(mes, "\n") + Encoding(mes) <- "UTF-8" message(mes) } @@ -121,28 +122,28 @@ loadDependencies <- function(lesson_dir) { packages_as_chars <- setdiff(readLines(depends, warn=FALSE), "") # If the dependson file is empty, then proceed with lesson if(length(packages_as_chars) == 0) return(TRUE) - swirl_out("Attemping to load lesson dependencies...") + swirl_out(s()%N%"Attempting to load lesson dependencies...") for(p in packages_as_chars) { p <- gsub("^\\s+|\\s+$", "", p) # trim leading and trailing whitespace if(suppressPackageStartupMessages( suppressWarnings( suppressMessages(require(p, character.only=TRUE, quietly=TRUE))))) { - swirl_out("Package", sQuote(p), "loaded correctly!") + swirl_out(s()%N%"Package", sQuote(p), s()%N%"loaded correctly!") } else { - swirl_out("This lesson requires the", sQuote(p), - "package. Would you like me to install it for you now?") - yn <- select.list(choices=c("Yes", "No"), graphics=FALSE) - if(yn == "Yes") { - swirl_out("Trying to install package", sQuote(p), "now...") + swirl_out(s()%N%"This lesson requires the", sQuote(p), + s()%N%"package. Would you like me to install it for you now?") + yn <- select.list(choices=c(s()%N%"Yes", s()%N%"No"), graphics=FALSE) + if(yn == s()%N%"Yes") { + swirl_out(s()%N%"Trying to install package", sQuote(p), s()%N%"now...") install.packages(p, quiet=TRUE) if(suppressPackageStartupMessages( suppressWarnings( suppressMessages(require(p, character.only=TRUE, quietly=TRUE))))) { - swirl_out("Package", sQuote(p), "loaded correctly!") + swirl_out(s()%N%"Package", sQuote(p), s()%N%"loaded correctly!") } else { - swirl_out("Could not install package", paste0(sQuote(p), "!")) + swirl_out(s()%N%"Could not install package", paste0(sQuote(p), "!")) return(FALSE) } } else { diff --git a/R/zzz.R b/R/zzz.R index f4b4e86..e6edc5a 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,16 +1,16 @@ .onAttach <- function(...) { if(length(ls(envir=globalenv())) > 0) { packageStartupMessage( - make_pretty("Hi! I see that you have some variables saved in your", - "workspace. To keep things running smoothly, I recommend you clean up", - "before starting swirl.", skip_after=TRUE), - make_pretty("Type ls() to see a list of the variables in your workspace.", - "Then, type rm(list=ls()) to clear your workspace.", skip_after=TRUE), - make_pretty("Type swirl() when you are ready to begin.", skip_after=TRUE) + make_pretty(s()%N%"Hi! I see that you have some variables saved in your", + s()%N%"workspace. To keep things running smoothly, I recommend you clean up", + s()%N%"before starting swirl.", skip_after=TRUE), + make_pretty(s()%N%"Type ls() to see a list of the variables in your workspace.", + s()%N%"Then, type rm(list=ls()) to clear your workspace.", skip_after=TRUE), + make_pretty(s()%N%"Type swirl() when you are ready to begin.", skip_after=TRUE) ) } else { packageStartupMessage( - make_pretty("Hi! Type swirl() when you are ready to begin.", + make_pretty(s()%N%"Hi! Type swirl() when you are ready to begin.", skip_after=TRUE) ) } diff --git a/README.md b/README.md index 5c67528..f1da172 100644 --- a/README.md +++ b/README.md @@ -1,16 +1,35 @@ # swirl [![Build Status](https://travis-ci.org/swirldev/swirl.png?branch=master)](https://travis-ci.org/swirldev/swirl) +[![CRAN version](http://www.r-pkg.org/badges/version/swirl?color=3399ff)](https://cran.r-project.org/package=swirl) +[![Downloads](http://cranlogs.r-pkg.org/badges/swirl?color=3399ff)](http://cran-logs.rstudio.com/) ### [http://swirlstats.com](http://swirlstats.com) -swirl is a platform for learning (and teaching) statistics and R simultaneously and interactively. It presents a choice of course lessons and interactively tutors a user through them. A user may be asked to watch a video, to answer a multiple-choice or fill-in-the-blanks question, or to enter a command in the R console precisely as if he or she were using R in practice. Emphasis is on the last, interacting with the R console. User responses are tested for correctness and hints are given if appropriate. Progress is automatically saved so that a user may quit at any time and later resume without losing work. +swirl is a platform for learning (and teaching) statistics and R simultaneously +and interactively. It presents a choice of course lessons and interactively +tutors a student through them. A student may be asked to watch a video, to answer a +multiple-choice or fill-in-the-blanks question, or to enter a command in the R +console precisely as if he or she were using R in practice. Emphasis is on the +last, interacting with the R console. User responses are tested for correctness +and hints are given if appropriate. Progress is automatically saved so that a +user may quit at any time and later resume without losing work. -swirl leans heavily on exercising a student's use of the R console. A callback mechanism, suggested and first demonstrated for the purpose by Hadley Wickham, is used to capture student input and to provide immediate feedback relevant to the course material at hand. +swirl leans heavily on exercising a student's use of the R console. A callback +mechanism, suggested and first demonstrated for the purpose by Hadley Wickham, +is used to capture student input and to provide immediate feedback relevant to +the course material at hand. -[swirlify](https://github.com/swirldev/swirlify) is a separate R package that provides a comprehensive toolbox for swirl instructors. Course authoring is possible in a variety of formats including [R Markdown](http://www.rstudio.com/ide/docs/r_markdown), [YAML](http://en.wikipedia.org/wiki/YAML), and [CSV](http://en.wikipedia.org/wiki/Comma-separated_values). Documentation for authoring content in R Markdown can be found on the [Instructors page](http://swirlstats.com/instructors.html) of our website. +[swirlify](https://github.com/swirldev/swirlify) is a separate R package that +provides a comprehensive toolbox for swirl instructors. Content is authored in +[YAML](http://en.wikipedia.org/wiki/YAML) using the handy tools described on +the [instructors page](http://swirlstats.com/instructors.html) of our website. -The program is initiated with `swirl()`. Functions which control swirl's behavior include `bye()` to quit, `skip()` to skip a question, `main()` to return to the main menu, `play()` to allow experimentation in the R console without interference from swirl, `nxt()` to resume interacting with swirl, and `info()` to display a help menu. +The program is initiated with `swirl()`. Functions which control swirl's +behavior include `bye()` to quit, `skip()` to skip a question, `main()` to +return to the main menu, `play()` to allow experimentation in the R console +without interference from swirl, `nxt()` to resume interacting with swirl, and +`info()` to display a help menu. ## Installing swirl (from CRAN) @@ -23,18 +42,34 @@ library(swirl) swirl() ``` -As we continue adding new features and content, we will make new versions available on CRAN as appropriate (every 1-2 months, most likely). +As we continue adding new features and content, we will make new versions +available on CRAN as appropriate (every 1-2 months, most likely). ## Installing the latest development version (from GitHub) -To access the most recent features and content, or to contribute to swirl's development, you can install and run the development version of swirl using the [devtools](https://github.com/hadley/devtools) package: +To access the most recent features and content, you can install and run the +development version of swirl using the [devtools](https://github.com/hadley/devtools) package: ``` install.packages("devtools") -library(devtools) -install_github("swirldev/swirl") +devtools::install_github("swirldev/swirl", ref = "dev") library(swirl) swirl() ``` -Note: If `install_github("swirldev/swirl")` gives you an error, try `install_github(username="swirldev", repo="swirl")` instead. +## Contributing to swirl's development + +If you'd like to get involved, please fork this repository and submit a pull +request with your proposed changes. We're happy to chat if you have any +questions about the source code. + +## Using swirl in the classroom + +Instructors around the world are using swirl in their classrooms. We think this +is awesome. If you're an instructor, please feel free to do the same -- free of +charge. While your students may be paying to take your course or attend your +institution, we simply ask that you don't charge people *directly* for the use +of our software or instructional content. + +If you are not sure about a particular use case, don't hesitate to send us an +email at info@swirlstats.com. diff --git a/cran-comments.md b/cran-comments.md index 7021ddd..3d49ce1 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1 +1,13 @@ -swirl 2.2.15 patches a bug in the previous version. Sorry for the oversight. \ No newline at end of file +## Release summary + +This is the first attempted CRAN release of swirl 2.4.5. + +## Test environments + +* local macOS Sierra install, R 3.6.1 +* Ubuntu 16.04 (on travis-ci), R 3.6.1, R 3.5.3, R-devel. +* win-builder (release) + +## R CMD check results + +There were no ERRORs, WARNINGs or NOTEs. \ No newline at end of file diff --git a/inst/Courses/suggested_courses.yaml b/inst/Courses/suggested_courses.yaml index c1164df..953838a 100644 --- a/inst/Courses/suggested_courses.yaml +++ b/inst/Courses/suggested_courses.yaml @@ -1,7 +1,16 @@ - Course: R Programming Description: The basics of programming in R - Install: install_from_swirl('R_Programming') + Install: install_course('R_Programming') - Course: Regression Models Description: The basics of regression modeling in R - Install: install_from_swirl('Regression_Models') + Install: install_course('Regression_Models') + +- Course: Statistical Inference + Description: The basics of statistical inference in R + Install: install_course('Statistical_Inference') + +- Course: Exploratory Data Analysis + Description: The basics of exploring data in R + Install: install_course('Exploratory_Data_Analysis') + diff --git a/inst/test/test-encoding.yaml b/inst/test/test-encoding.yaml new file mode 100644 index 0000000..727b585 --- /dev/null +++ b/inst/test/test-encoding.yaml @@ -0,0 +1,43 @@ +- Class: meta + Course: MyCourse + Lesson: MyLesson + Author: your name goes here + Type: Standard + Organization: your organization's name goes here + Version: 2.3.0 + +- Class: text + Output: put your text output here + +- Class: text + Output: 中文測試 + +- Class: mult_question + Output: ask the multiple choice question here + AnswerChoices: ANS;2;3 + CorrectAnswer: ANS + AnswerTests: omnitest(correctVal= 'ANS') + Hint: hint + +- Class: script + Output: explain what the user must do here + AnswerTests: custom_test_name() + Hint: hint + Script: script-name.R + +- Class: exact_question + Output: explain the question here + CorrectAnswer: n + AnswerTests: omnitest(correctVal=n) + Hint: hint + +- Class: text_question + Output: explain the question here + CorrectAnswer: answer + AnswerTests: omnitest(correctVal='answer') + Hint: hint + +- Class: figure + Output: explain the figure here + Figure: sourcefile.R + FigureType: new or add \ No newline at end of file diff --git a/man/AnswerTests.Rd b/man/AnswerTests.Rd index 2cf2283..8cb0d06 100644 --- a/man/AnswerTests.Rd +++ b/man/AnswerTests.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{AnswerTests} \alias{AnswerTests} \title{Answer Tests} @@ -6,16 +7,16 @@ Answer tests are how swirl determines whether a user has answered a question correctly or not. Each question has one or more answer tests associated with it, all of which must be satisfied in order for -a user's response to be considered correct. As the instructor, you +a user's response to be considered correct. As the instructor, you can specify any combination of our predefined answer tests or create your own custom answer tests to suit your specific needs. This document will explain your options. } \details{ -For each question that you author as part of a swirl lesson, you +For each question that you author as part of a swirl lesson, you must specify exactly one \emph{correct answer}. This is separate and distinct from the answer tests. This does not have to be -the only correct answer, but it must answer the question correctly. +the only correct answer, but it must answer the question correctly. If a user \code{\link{skip}}s your question, this is the answer that will be entered on his or her behalf. @@ -32,19 +33,19 @@ tests come in. You can specify any number of answer tests. If you use more than one, you must separate them with semicolons. If you do not specify any answer tests for a command question, then the default test will be used. The default -test is \code{omnitest(correctExpr='')}, which will -simply check that the user's expression matches the expression that you -provided as a correct answer. +test is \code{omnitest(correctExpr='')}, which will +simply check that the user's expression matches the expression that you +provided as a correct answer. In many cases, the default answer test will provide sufficient vetting of a user's response to a command question. While it is somewhat restrictive -in the sense that it requires an exact match of expressions (ignoring +in the sense that it requires an exact match of expressions (ignoring whitespace), it is liberating to the course author for two reasons. \enumerate{ \item It allows for fast prototyping of content. As you're developing content, you may find that determining how to test for correctness - distracts you from the message you're trying to communicate. - \item You don't have to worry about what happens if the user enters + distracts you from the message you're trying to communicate. + \item You don't have to worry about what happens if the user enters an incorrect response, but is allowed to proceed because of an oversight in the answer tests. Since swirl sessions are continuous, accepting an incorrect answer early in a lesson can cause problems later on. By @@ -52,13 +53,13 @@ whitespace), it is liberating to the course author for two reasons. exact match of expressions and hence not allowing the user to advance until you are certain they've entered the correct response. } - -It's important to keep in mind that as your content matures, you can always + +It's important to keep in mind that as your content matures, you can always go back and make your answer testing strategy more elaborate. The main benefit of using tests other than the default is that the user will not be required to enter an expression exactly the way you've specified it. He or she will have more freedom in terms of how they respond to a question, as -long as they satify the conditions that you see as being most important. +long as they satisfy the conditions that you see as being most important. } \section{Predefined Answer Tests}{ @@ -68,6 +69,8 @@ examples. \code{\link{any_of_exprs}}: Test that the user's expression matches any of several possible expressions. +\code{\link{calculates_same_value}}: Test that the user's expression evaluates to a certain value. + \code{\link{expr_creates_var}}: Test that a new variable has been created. \code{\link{expr_identical_to}}: Test that the user has entered a particular expression. @@ -95,22 +98,22 @@ are using the swirlify authoring tool, then a file called \code{customTests.R} (case-sensitive) is automatically created in the lesson directory. If it's not there already, you can create the file manually. -In this file, you can write your own answer tests. These answer tests are -then available to you just the same as any of the standard tests. However, -the scope of a custom answer test is limited to the lesson within which +In this file, you can write your own answer tests. These answer tests are +then available to you just the same as any of the standard tests. However, +the scope of a custom answer test is limited to the lesson within which you've defined it. -Each custom answer test is simply an R function that follows a few +Each custom answer test is simply an R function that follows a few basic rules: \enumerate{ \item Give the function a distinct name that will help you remember what is does (e.g. \code{creates_matrix_with_n_rows}). - \item The first line of the function body is - \code{e <- get("e", parent.frame())}, which gives you access to the + \item The first line of the function body is + \code{e <- get("e", parent.frame())}, which gives you access to the environment \code{e}. Any important information, such as the expression typed by the user, will be available to you through \code{e}. - \item Access the expression entered by the user with \code{e$expr} and - the value of the expression with \code{e$val}. + \item Access the expression entered by the user with \code{e$expr} and + the value of the expression with \code{e$val}. Note that \code{e$expr} comes in the form of an unevaluated R \code{\link{expression}}. \item The function returns \code{TRUE} if the test is passed and @@ -118,13 +121,19 @@ basic rules: value could be returned (e.g. \code{NA}, \code{NULL}, etc.) } } + \seealso{ -Other AnswerTests: \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/InstallCourses.Rd b/man/InstallCourses.Rd index cbaeafc..417c2ac 100644 --- a/man/InstallCourses.Rd +++ b/man/InstallCourses.Rd @@ -1,31 +1,39 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{InstallCourses} \alias{InstallCourses} \title{Installing Courses} \description{ swirl is designed so that anyone can create interactive content and share it with the world or with just a few people. Users can -install courses from a variety of sources using the +install courses from a variety of sources using the functions listed here. Each of these functions has its own help file, which you can consult for more details. } \details{ -If you're just getting started, we recommend using -\code{\link{install_from_swirl}} to install courses +If you're just getting started, we recommend using +\code{\link{install_course}} to install courses from our official \href{https://github.com/swirldev/swirl_courses}{course repository}. Otherwise, check out the help file for the relevant install function below. -You can uninstall a course from swirl at any time with +You can uninstall a course from swirl at any time with \code{\link{uninstall_course}}. + +Uninstall all courses with +\code{\link{uninstall_all_courses}}. } \seealso{ -Other InstallCourses: \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/any_of_exprs.Rd b/man/any_of_exprs.Rd index a67fe45..ce9efc8 100644 --- a/man/any_of_exprs.Rd +++ b/man/any_of_exprs.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{any_of_exprs} \alias{any_of_exprs} \title{Test that the user has entered one of several possible expressions.} @@ -13,7 +14,7 @@ any_of_exprs(...) } \description{ Returns \code{TRUE} if the expression the user has entered -matches any of the expressions given (as character strings) in +matches any of the expressions given (as character strings) in the argument. } \examples{ @@ -24,12 +25,17 @@ any_of_exprs('cor(x, y)', 'cor(y, x)') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/bye.Rd b/man/bye.Rd index aa5dfb0..0024534 100644 --- a/man/bye.Rd +++ b/man/bye.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{bye} \alias{bye} \title{Exit swirl.} @@ -22,4 +23,3 @@ what \code{bye()} does. | Leaving swirl now. Type swirl() to resume. } } - diff --git a/man/calculates_same_value.Rd b/man/calculates_same_value.Rd new file mode 100644 index 0000000..07660ba --- /dev/null +++ b/man/calculates_same_value.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R +\name{calculates_same_value} +\alias{calculates_same_value} +\title{Test that the user's expression evaluates to a certain value.} +\usage{ +calculates_same_value(expression) +} +\arguments{ +\item{expression}{An expression whose value will be compared to the value +of the user's expression.} +} +\value{ +\code{TRUE} or \code{FALSE} +} +\description{ +Test that the value calculated by the user's expression is the same as the +value calculated by the given expression. +} +\examples{ +\dontrun{ + # Test that a user's expression evaluates to a certain value + # + calculates_same_value('matrix(1:20, nrow=4, ncol=5)') +} +} +\seealso{ +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} +} +\concept{AnswerTests} diff --git a/man/delete_progress.Rd b/man/delete_progress.Rd new file mode 100644 index 0000000..10da274 --- /dev/null +++ b/man/delete_progress.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/progress.R +\name{delete_progress} +\alias{delete_progress} +\title{Delete a user's progress} +\usage{ +delete_progress(user, path = NULL) +} +\arguments{ +\item{user}{The user name whose progress will be deleted.} + +\item{path}{If specified, the directory where the user_data can be found} +} +\description{ +Delete a user's progress +} +\examples{ +\dontrun{ + +delete_progress("bill") +} +} diff --git a/man/email_admin.Rd b/man/email_admin.Rd index 76fb8a1..2dd37ab 100644 --- a/man/email_admin.Rd +++ b/man/email_admin.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/email_info.R \name{email_admin} \alias{email_admin} \title{Send diagnostic email to swirl admin} @@ -12,4 +13,3 @@ will include space for you to describe the problem you are experiencing. It will also have the output from \code{sessionInfo}, which you should not alter. } - diff --git a/man/expr_creates_var.Rd b/man/expr_creates_var.Rd index 9b96557..bc94971 100644 --- a/man/expr_creates_var.Rd +++ b/man/expr_creates_var.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{expr_creates_var} \alias{expr_creates_var} \title{Test that a new variable has been created.} @@ -28,12 +29,17 @@ expr_creates_var('myNum') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/expr_identical_to.Rd b/man/expr_identical_to.Rd index 5eaf26a..b8c9498 100644 --- a/man/expr_identical_to.Rd +++ b/man/expr_identical_to.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{expr_identical_to} \alias{expr_identical_to} \title{Test that the user has entered a particular expression.} @@ -23,12 +24,17 @@ given as the first argument. } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/expr_is_a.Rd b/man/expr_is_a.Rd index 925e723..f0a75bb 100644 --- a/man/expr_is_a.Rd +++ b/man/expr_is_a.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{expr_is_a} \alias{expr_is_a} \title{Test that the expression itself is of a specific \code{class}.} @@ -22,13 +23,17 @@ expr_is_a('<-') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/expr_uses_func.Rd b/man/expr_uses_func.Rd index bf86a1b..ed3a7aa 100644 --- a/man/expr_uses_func.Rd +++ b/man/expr_uses_func.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{expr_uses_func} \alias{expr_uses_func} \title{Test that a particular function has been used.} @@ -23,12 +24,17 @@ expr_uses_func('sd') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}}; \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/func_of_newvar_equals.Rd b/man/func_of_newvar_equals.Rd index 7af532c..a4a96ed 100644 --- a/man/func_of_newvar_equals.Rd +++ b/man/func_of_newvar_equals.Rd @@ -1,7 +1,8 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{func_of_newvar_equals} \alias{func_of_newvar_equals} -\title{Test the result of a computation applied to a specific (user-named) +\title{Test the result of a computation applied to a specific (user-named) variable created in a previous question.} \usage{ func_of_newvar_equals(correct_expression) @@ -26,12 +27,17 @@ func_of_newvar_equals('mean(newVar)') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; \code{\link{omnitest}}; - \code{\link{val_has_length}}; \code{\link{val_matches}}; - \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/info.Rd b/man/info.Rd index 5981f6d..02c359c 100644 --- a/man/info.Rd +++ b/man/info.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{info} \alias{info} \title{Display a list of special commands.} @@ -6,27 +7,6 @@ info() } \description{ -Display a list of the special commands, \code{bye()}, \code{play()}, +Display a list of the special commands, \code{bye()}, \code{play()}, \code{nxt()}, \code{skip()}, and \code{info()}. } -\examples{ -\dontrun{ - -| Create a new variable called `z` that contains the number 11. - -> info() - -| When you are at the R prompt (>): -| -- Typing skip() allows you to skip the current question. -| -- Typing play() lets you experiment with R on your own; swirl will ignore what -| you do... -| -- UNTIL you type nxt() which will regain swirl's attention. -| -- Typing bye() causes swirl to exit. Your progress will be saved. -| -- Typing info() displays these options again. - -> bye() - -| Leaving swirl now. Type swirl() to resume. -} -} - diff --git a/man/install_course.Rd b/man/install_course.Rd new file mode 100644 index 0000000..a3a2c31 --- /dev/null +++ b/man/install_course.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R +\name{install_course} +\alias{install_course} +\title{Install a course from The swirl Course Network or install a course from a +local .swc file.} +\usage{ +install_course(course_name = NULL, swc_path = NULL, force = FALSE) +} +\arguments{ +\item{course_name}{The name of the course you wish to install.} + +\item{swc_path}{The path to a local \code{.swc} file. By default this +argument defaults to \code{file.choose()} so the user can select the file using +their mouse.} + +\item{force}{Should course installation be forced? The +default value is \code{FALSE}.} +} +\description{ +Version 2.4 of swirl introduces a new, simple, and fast way of installing +courses in the form of \code{.swc} files. This function allows a user to grab +a \code{.swc} file from The swirl Course Network which is maintained by Team +swirl, or the user can use this function to install a local \code{.swc} file. +When using this function please only provide an argument for either +\code{course_name} or \code{swc_path}, never both. +} +\examples{ +\dontrun{ + +# Install the latest version of Team swirl's R Programming course. +install_course("R Programming") + +# Install a local .swc file by using your mouse and keyboard to select the +# file. +install_course() + +# Install a .swc file from a specific path. +install_course(swc_path = file.path("~", "Downloads", "R_Programming.swc")) + +} +} +\seealso{ +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} +} +\concept{InstallCourses} diff --git a/man/install_course_directory.Rd b/man/install_course_directory.Rd index 1c46638..8fa8333 100644 --- a/man/install_course_directory.Rd +++ b/man/install_course_directory.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_directory} \alias{install_course_directory} \title{Install a course from a course directory} @@ -18,13 +19,17 @@ install_course_directory("~/Desktop/my_course") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_course_dropbox.Rd b/man/install_course_dropbox.Rd index 4b0e548..05a5927 100644 --- a/man/install_course_dropbox.Rd +++ b/man/install_course_dropbox.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_dropbox} \alias{install_course_dropbox} \title{Install a course from a zipped course directory shared on Dropbox} @@ -20,13 +21,17 @@ install_course_dropbox("https://www.dropbox.com/s/xttkmuvu7hh72vu/my_course.zip" } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_course_github.Rd b/man/install_course_github.Rd index ff9d33b..b8b904d 100644 --- a/man/install_course_github.Rd +++ b/man/install_course_github.Rd @@ -1,10 +1,15 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_github} \alias{install_course_github} \title{Install a course from a GitHub repository} \usage{ -install_course_github(github_username, course_name, branch = "master", - multi = FALSE) +install_course_github( + github_username, + course_name, + branch = "master", + multi = FALSE +) } \arguments{ \item{github_username}{The username that owns the course repository.} @@ -26,13 +31,17 @@ install_course_github("jtleek", "Twitter_Map", "geojson") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_course_google_drive.Rd b/man/install_course_google_drive.Rd index 7fb54e1..de8ed00 100644 --- a/man/install_course_google_drive.Rd +++ b/man/install_course_google_drive.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_google_drive} \alias{install_course_google_drive} \title{Install a course from a zipped course directory shared on Google Drive} @@ -20,13 +21,17 @@ install_course_google_drive("https://drive.google.com/file/d/F3fveiu873hfjZZj/ed } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_course_url.Rd b/man/install_course_url.Rd index 2a1e8fd..4234af1 100644 --- a/man/install_course_url.Rd +++ b/man/install_course_url.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_url} \alias{install_course_url} \title{Install a course from a url that points to a zip file} @@ -20,13 +21,17 @@ install_course_url("http://www.biostat.jhsph.edu/~rpeng/File_Hash_Course.zip") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_course_zip.Rd b/man/install_course_zip.Rd index 8d6a4d6..a6de1d6 100644 --- a/man/install_course_zip.Rd +++ b/man/install_course_zip.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_course_zip} \alias{install_course_zip} \title{Install a course from a zipped course folder} @@ -25,13 +26,17 @@ install_course_zip("~/Downloads/swirl_courses-master.zip", multi=TRUE, } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/install_from_swirl.Rd b/man/install_from_swirl.Rd index 4afdc4a..37bfc4f 100644 --- a/man/install_from_swirl.Rd +++ b/man/install_from_swirl.Rd @@ -1,14 +1,17 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{install_from_swirl} \alias{install_from_swirl} \title{Install a course from the official course repository} \usage{ -install_from_swirl(course_name, dev = FALSE) +install_from_swirl(course_name, dev = FALSE, mirror = "github") } \arguments{ \item{course_name}{The name of the course you wish to install.} \item{dev}{Set to \code{TRUE} to install a course in development from the swirl_misc repository.} + +\item{mirror}{Select swirl course repository mirror. Valid arguments are \code{"github"} and \code{"bitbucket"}.} } \description{ We are currently maintaining a central repository of contributed @@ -16,11 +19,16 @@ swirl courses at \url{https://github.com/swirldev/swirl_courses}. This function provides the easiest method of installing a course form the repository. -We have another repository at -\url{https://github.com/swirldev/swirl_misc}, where we keep +We have another repository at +\url{https://github.com/swirldev/swirl_misc}, where we keep experimental features and content. The \code{dev} argument allows you to access this repository. Content in the swirl_misc repository is not guaranteed to work. + +The central repository of swirl courses is mirrored at +\url{https://bitbucket.org/swirldevmirror/swirl_courses}. If you cannot +access GitHub you can download swirl courses from bitbucket by using the +\code{mirror = "bitbucket"} option (see below). } \examples{ \dontrun{ @@ -33,16 +41,23 @@ install_from_swirl("R Programming") # Course name # To install a course in development from the swirl_misc repository install_from_swirl("Including Data", dev = TRUE) + +# To install a course from the Bitbucket mirror +install_from_swirl("R Programming", mirror = "bitbucket") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{uninstall_course}}; \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/is_robust_match.Rd b/man/is_robust_match.Rd new file mode 100644 index 0000000..4a03839 --- /dev/null +++ b/man/is_robust_match.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rmatch_calls.R +\name{is_robust_match} +\alias{is_robust_match} +\title{Recursively expand both the correct expression and the user's expression and +test for a match. CAUTION: May raise errors, as in rmatch_calls.} +\usage{ +is_robust_match(expr1, expr2, eval_for_class, eval_env = NULL) +} +\arguments{ +\item{expr1}{expression} + +\item{expr2}{expression} + +\item{eval_for_class}{TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE.} + +\item{eval_env}{parent environment for evaluations to determine class. Ignored if eval_for_class=FALSE} +} +\value{ +TRUE or FALSE according to whether expanded expressions match. +} +\description{ +Recursively expand both the correct expression and the user's expression and +test for a match. CAUTION: May raise errors, as in rmatch_calls. +} +\examples{ +\dontrun{ + + expr1 <- quote(print(paste("my_name_is", "mud"))) + expr2 <- quote(print(paste("my_name_is", "mud", sep=" "))) + err <- try(ans <- is_robust_match(expr1, expr2, eval_for_class=TRUE), silent=TRUE) + if(is(ans, "try-error")){ + ans <- isTRUE(all.equal()) + } +} +} diff --git a/man/main.Rd b/man/main.Rd index 4300326..8e0e9e3 100644 --- a/man/main.Rd +++ b/man/main.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{main} \alias{main} \title{Return to swirl's main menu.} @@ -19,4 +20,3 @@ Return to swirl's main menu from a lesson in progress. | Returning to the main menu... } } - diff --git a/man/nxt.Rd b/man/nxt.Rd index eb0dfcc..c012316 100644 --- a/man/nxt.Rd +++ b/man/nxt.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{nxt} \alias{nxt} \title{Begin the upcoming question or unit of instruction.} @@ -29,4 +30,3 @@ a video or \code{play()}'ing around in the console. | Resuming lesson... } } - diff --git a/man/omnitest.Rd b/man/omnitest.Rd index 8ac7080..2cd45a0 100644 --- a/man/omnitest.Rd +++ b/man/omnitest.Rd @@ -1,9 +1,15 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{omnitest} \alias{omnitest} \title{Test for a correct expression, a correct value, or both.} \usage{ -omnitest(correctExpr = NULL, correctVal = NULL, strict = FALSE) +omnitest( + correctExpr = NULL, + correctVal = NULL, + strict = FALSE, + eval_for_class = as.logical(NA) +) } \arguments{ \item{correctExpr}{the correct or expected expression as a string} @@ -11,10 +17,12 @@ omnitest(correctExpr = NULL, correctVal = NULL, strict = FALSE) \item{correctVal}{the correct value (numeric or character)} \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.} + +\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.} } \description{ Omnitest can test for a correct expression, a correct value, -or both. In the case of values it is limited to testing for +or both. In the case of values it is limited to testing for character or numeric vectors of length 1. } \examples{ @@ -23,42 +31,46 @@ character or numeric vectors of length 1. # Test that a user has chosen a correct menu item # omnitest(correctVal='Men in a college dorm.') - + # Test that a user has entered a correct number at the # command line # omnitest(correctVal=19) - + # Test that a user has entered a particular command # omnitest('myVar <- c(3, 5, 7)') - + # Test that a user has entered a command which computes - # a specific value but perhaps in a different manner + # a specific value but perhaps in a different manner # than anticipated # omnitest('sd(x)^2', 5.95) # # If the user enters sd(x)*sd(x), rather than sd(x)^2, a notification # will be issued, but the test will not fail. - + # Test that a user has entered a command which computes # a specific value in a particular way # omnitest('sd(x)^2', 5.95, strict=TRUE) # # In this case, if the user enters sd(x)*sd(x) the test will fail. - + } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{val_has_length}}; \code{\link{val_matches}}; - \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/play.Rd b/man/play.Rd index 4dac8fd..be2cc87 100644 --- a/man/play.Rd +++ b/man/play.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{play} \alias{play} \title{Tell swirl to ignore console input for a while.} @@ -31,4 +32,3 @@ until the command \code{nxt()} is entered. | Resuming lesson... } } - diff --git a/man/reset.Rd b/man/reset.Rd index 4a38e50..0815d03 100644 --- a/man/reset.Rd +++ b/man/reset.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{reset} \alias{reset} \title{Start over on the current script question.} @@ -10,4 +11,3 @@ During a script question, this will reset the script back to its original state, which can be helpful if you get stuck. } - diff --git a/man/restart.Rd b/man/restart.Rd new file mode 100644 index 0000000..f100e88 --- /dev/null +++ b/man/restart.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R +\name{restart} +\alias{restart} +\title{Restart the current swirl lesson.} +\usage{ +restart() +} +\description{ +Restart the current swirl lesson. +} diff --git a/man/rmatch_calls.Rd b/man/rmatch_calls.Rd new file mode 100644 index 0000000..c854a30 --- /dev/null +++ b/man/rmatch_calls.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rmatch_calls.R +\name{rmatch_calls} +\alias{rmatch_calls} +\title{Recursively expand match calls in an expression from the bottom up.} +\usage{ +rmatch_calls(expr, eval_for_class = FALSE, eval_env = NULL) +} +\arguments{ +\item{expr}{an R expression (a.k.a. abstract syntax tree)} + +\item{eval_for_class}{TRUE or FALSE. If TRUE, evaluate the first argument of an S3 method to determine its class. Default=FALSE.} + +\item{eval_env}{environment in which to evaluate for class. Ignored if eval_for_class=FALSE} +} +\value{ +an equivalent R expression with function or method calls in canonical form. +} +\description{ +Given an expression, expr, traverse the syntax tree from the +bottom up, expanding the call to include default values of +named formals as appropriate, and applying match.call to the result. +Functionality is limited to expressions containing ordinary functions +or S3 methods. If parameter eval_for_class has its default value of FALSE, +an error will be raised for any S3 method whose first argument (as an expression) +is not atomic. If eval_for_class is TRUE, the first argument will be evaluated +to determine its class. Evaluation will take place in the environment given by +parameter eval_env. +CAUTION: eval_for_class=TRUE is likely to result in multiple evaluations of the same code. +Expressions containing S4 or reference class methods will also raise errors. +} +\examples{ +\dontrun{ + +# Function +rmatch_calls(quote(help("print"))) +help(topic = "print", package = NULL, lib.loc = NULL, verbose = getOption("verbose"), +try.all.packages = getOption("help.try.all.packages"), help_type = getOption("help_type")) + +# S3 method with atomic first argument +rmatch_calls(quote(seq(0, 1, by=.5))) +seq(from = 0, to = 1, by = 0.5, length.out = NULL, along.with = NULL) + +# S3 method with non-atomic first argument, eval_for_class = FALSE (default) +rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) +#Error in rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01")))) : +# Illegal expression, seq(as.Date(x = "2014-02-01"), as.Date(x = "2014-03-01")): +# The first argument, as.Date(x = "2014-02-01"), to S3 method 'seq', is a call, +# which (as an expression) is not atomic, hence its class can't be determined in an +# abstract syntax tree without additional information. + +# S3 method with non-atomic first argument, eval_for_class = TRUE +rmatch_calls(quote(seq(as.Date("2014-02-01"), as.Date("2014-03-01"))), eval_for_class=TRUE) +seq(from = as.Date(x = "2014-02-01"), to = as.Date(x = "2014-03-01"), + length.out = NULL, along.with = NULL) +} +} diff --git a/man/select_language.Rd b/man/select_language.Rd new file mode 100644 index 0000000..9f7d7a4 --- /dev/null +++ b/man/select_language.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/languages.R +\name{select_language} +\alias{select_language} +\title{Select a language} +\usage{ +select_language(language = NULL, append_rprofile = FALSE) +} +\arguments{ +\item{language}{The language that swirl's menus will use. +This must be one of the following values: \code{"chinese_simplified"}. +\code{"english"}, \code{"french"}, \code{"german"}, +\code{"korean"}, \code{"spanish"}, or \code{"turkish"}. +If \code{NULL} the user will be asked to choose a language +interactively. The default value is \code{NULL}.} + +\item{append_rprofile}{If \code{TRUE} this command will append +\code{options(swirl_language = [selected language])} to the end of your +Rprofile. The default value is \code{FALSE}.} +} +\description{ +Select a language for swirl's menus. +} diff --git a/man/skip.Rd b/man/skip.Rd index dae1ff8..283b2ce 100644 --- a/man/skip.Rd +++ b/man/skip.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{skip} \alias{skip} \title{Skip the current unit of instruction.} @@ -22,4 +23,3 @@ in doing so. These may be needed for subsequent questions. | In doing so, I've created the variable(s) y, which you may need later. } } - diff --git a/man/submit.Rd b/man/submit.Rd index a1a7c42..5d112f0 100644 --- a/man/submit.Rd +++ b/man/submit.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{submit} \alias{submit} \title{Submit the active R script in response to a question.} @@ -20,4 +21,3 @@ When a swirl question requires the user to edit an R script, the | You are quite good my friend! } } - diff --git a/man/swirl.Rd b/man/swirl.Rd index d28ebd8..f0c087b 100644 --- a/man/swirl.Rd +++ b/man/swirl.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/swirl.R \name{swirl} \alias{swirl} \title{An interactive learning environment for R and statistics.} @@ -14,7 +15,7 @@ swirl(resume.class = "default", ...) This function presents a choice of course lessons and interactively tutors a user through them. A user may be asked to watch a video, to answer a multiple-choice or fill-in-the-blanks question, or to -enter a command in the R console precisely as if he or she were +enter a command in the R console precisely as if he or she were using R in practice. Emphasis is on the last, interacting with the R console. User responses are tested for correctness and hints are given if appropriate. Progress is automatically saved so that a user @@ -23,11 +24,11 @@ may quit at any time and later resume without losing work. \details{ There are several ways to exit swirl: by typing \code{bye()} while in the R console, by hitting the Esc key while not in the R console, or by -entering 0 from the swirl course menu. swirl will print a goodbye -message whenever it exits. +entering 0 from the swirl course menu. swirl will print a goodbye +message whenever it exits. While swirl is in operation, it may be controlled by entering special -commands in the R console. One of the special commands is \code{bye()} +commands in the R console. One of the special commands is \code{bye()} as discussed above. Others are \code{play()}, \code{nxt()}, \code{skip()}, and \code{info()}. The parentheses are important. @@ -36,7 +37,7 @@ interference or commentary from swirl. This can be accomplished by using the special command \code{play()}. swirl will remain in operation, silently, until the special command \code{nxt()} is entered. -The special command \code{skip()} can be used to skip a question if +The special command \code{skip()} can be used to skip a question if necessary. swirl will enter the correct answer and notify the user of the names of any new variables which it may have created in doing so. These may be needed for subsequent questions. @@ -50,4 +51,3 @@ themselves with brief explanations of what they do. swirl() } } - diff --git a/man/swirl_options.Rd b/man/swirl_options.Rd new file mode 100644 index 0000000..db430b9 --- /dev/null +++ b/man/swirl_options.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/options.R +\name{swirl_options} +\alias{swirl_options} +\title{Get swirl options} +\usage{ +swirl_options(...) +} +\arguments{ +\item{...}{any options can be defined, using name = value.} +} +\description{ +This function is a wrapper for \code{options()} that allows the user to +see the state of how certain options for swirl are set up. +} +\examples{ +\dontrun{ +# See current current swirl options +swirl_options() + +# Set an option +swirl_options(swirl_logging = TRUE) +} +} diff --git a/man/uninstall_all_courses.Rd b/man/uninstall_all_courses.Rd new file mode 100644 index 0000000..22dfd64 --- /dev/null +++ b/man/uninstall_all_courses.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R +\name{uninstall_all_courses} +\alias{uninstall_all_courses} +\title{Uninstall all courses} +\usage{ +uninstall_all_courses(force = FALSE) +} +\arguments{ +\item{force}{If \code{TRUE} the user will not be asked if they're sure they +want to delete the contents of the directory where courses are stored. The +default value is \code{FALSE}} +} +\description{ +Uninstall all courses +} +\examples{ +\dontrun{ + +uninstall_all_courses() +} +} +\seealso{ +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_course}()}, +\code{\link{zip_course}()} +} +\concept{InstallCourses} diff --git a/man/uninstall_course.Rd b/man/uninstall_course.Rd index b9fd432..70eb8fc 100644 --- a/man/uninstall_course.Rd +++ b/man/uninstall_course.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{uninstall_course} \alias{uninstall_course} \title{Uninstall a course} @@ -18,14 +19,17 @@ uninstall_course("Linear Regression") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{zip_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{zip_course}()} } - +\concept{InstallCourses} diff --git a/man/val_has_length.Rd b/man/val_has_length.Rd index b0de2b2..9735492 100644 --- a/man/val_has_length.Rd +++ b/man/val_has_length.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{val_has_length} \alias{val_has_length} \title{Test that the value of the expression has a particular \code{length}.} @@ -12,7 +13,7 @@ val_has_length(len) \code{TRUE} or \code{FALSE} } \description{ -Test the the \code{\link{length}} of \code{e$val} is that given by the +Test the the \code{\link{length}} of \code{e$val} is that given by the first argument. } \examples{ @@ -23,13 +24,17 @@ val_has_length(10) } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_matches}}; - \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_matches}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/val_matches.Rd b/man/val_matches.Rd index a9a72a2..adec342 100644 --- a/man/val_matches.Rd +++ b/man/val_matches.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{val_matches} \alias{val_matches} \title{Test that the user's expression matches a regular expression.} @@ -18,20 +19,24 @@ expression given as the first argument. \examples{ \dontrun{ # Test that a user has entered a value matching - # '[Cc]ollege [Ss]tudents' or has selected it + # '[Cc]ollege [Ss]tudents' or has selected it # in a multiple choice question. # val_matches('[Cc]ollege [Ss]tudents') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{var_is_a}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{var_is_a}()} } - +\concept{AnswerTests} diff --git a/man/var_is_a.Rd b/man/var_is_a.Rd index 1af96e1..c4ceb2c 100644 --- a/man/var_is_a.Rd +++ b/man/var_is_a.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/answerTests2.R \name{var_is_a} \alias{var_is_a} \title{Test that the value of the expression is of a specific class.} @@ -24,13 +25,17 @@ var_is_a('numeric', 'x') } } \seealso{ -Other AnswerTests: \code{\link{AnswerTests}}; - \code{\link{any_of_exprs}}; - \code{\link{expr_creates_var}}; - \code{\link{expr_identical_to}}; \code{\link{expr_is_a}}; - \code{\link{expr_uses_func}}; - \code{\link{func_of_newvar_equals}}; - \code{\link{omnitest}}; \code{\link{val_has_length}}; - \code{\link{val_matches}} +Other AnswerTests: +\code{\link{AnswerTests}}, +\code{\link{any_of_exprs}()}, +\code{\link{calculates_same_value}()}, +\code{\link{expr_creates_var}()}, +\code{\link{expr_identical_to}()}, +\code{\link{expr_is_a}()}, +\code{\link{expr_uses_func}()}, +\code{\link{func_of_newvar_equals}()}, +\code{\link{omnitest}()}, +\code{\link{val_has_length}()}, +\code{\link{val_matches}()} } - +\concept{AnswerTests} diff --git a/man/zip_course.Rd b/man/zip_course.Rd index da7c515..ac99401 100644 --- a/man/zip_course.Rd +++ b/man/zip_course.Rd @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_course.R \name{zip_course} \alias{zip_course} \title{Zip a course directory} @@ -13,7 +14,7 @@ default value is \code{NULL}, which will cause the \code{.zip} to be created one level above the directory specified in \code{path}.} } \description{ -Zip a course directory +\strong{Warning:} This function will be deprecated after swirl version 2.4. } \examples{ \dontrun{ @@ -23,14 +24,17 @@ zip_course("~/Desktop/SNA_Tutorial", "~/tutorials") } } \seealso{ -Other InstallCourses: \code{\link{InstallCourses}}; - \code{\link{install_course_directory}}; - \code{\link{install_course_dropbox}}; - \code{\link{install_course_github}}; - \code{\link{install_course_google_drive}}; - \code{\link{install_course_url}}; - \code{\link{install_course_zip}}; - \code{\link{install_from_swirl}}; - \code{\link{uninstall_course}} +Other InstallCourses: +\code{\link{InstallCourses}}, +\code{\link{install_course_directory}()}, +\code{\link{install_course_dropbox}()}, +\code{\link{install_course_github}()}, +\code{\link{install_course_google_drive}()}, +\code{\link{install_course_url}()}, +\code{\link{install_course_zip}()}, +\code{\link{install_course}()}, +\code{\link{install_from_swirl}()}, +\code{\link{uninstall_all_courses}()}, +\code{\link{uninstall_course}()} } - +\concept{InstallCourses} diff --git a/revdep/check.R b/revdep/check.R new file mode 100644 index 0000000..57b0600 --- /dev/null +++ b/revdep/check.R @@ -0,0 +1,4 @@ +library("devtools") + +res <- revdep_check() +revdep_check_save_summary() diff --git a/revdep/checks.rds b/revdep/checks.rds new file mode 100644 index 0000000..e867086 Binary files /dev/null and b/revdep/checks.rds differ diff --git a/tests/testthat/test-encoding.R b/tests/testthat/test-encoding.R new file mode 100644 index 0000000..e849c20 --- /dev/null +++ b/tests/testthat/test-encoding.R @@ -0,0 +1,30 @@ +context("encoding") + +library(stringi) + +test_that("Trying to parse the test-encoding.yaml", { + locale <- Sys.getlocale() + if(grepl("[L|l]atin", locale)){ + testthat::skip("Locale is Latin") + } + skip_on_os("windows") + + test_parse <- function(file) { + class(file) <- get_content_class(file) + parse_content(file) + } + environment(test_parse) <- environment(swirl:::parse_content) + test_path <- system.file(file.path("test", "test-encoding.yaml"), package = "swirl") + suppressWarnings(result <- test_parse(test_path)) + console <- capture.output(result) + test_phrase <- strsplit(console[3], "\\s+")[[1]][3] + + #if(.Platform$OS.type == "windows"){ + expect_true( + identical(stri_escape_unicode(test_phrase), "") || + identical(stri_escape_unicode(test_phrase), stri_escape_unicode("中文測試")) + ) + #} else { + # expect_equal(stri_escape_unicode(test_phrase), stri_escape_unicode("中文測試")) + #} +}) diff --git a/tests/testthat/test-play.R b/tests/testthat/test-play.R deleted file mode 100644 index 36e23e3..0000000 --- a/tests/testthat/test-play.R +++ /dev/null @@ -1,26 +0,0 @@ -# # Experimental tests for learning testthat -# -# # install.packages("testthat") # (if necessary) -# # install.packages("devtools") # (if necessary) -# # require(testthat) -# # require(devtools) -# # > load_all() -# # > test_dir("tests") -# -context("Learning testthat") - -test_that("runTest.newVar and runTest.result can handle random vectors.", { - # Code in curly brackets, the second argument to test_that - e <- new.env() - # Simulate that the user has entered a new variable - # consisting of 5 uniform and 5 normal random numbers. - x <- c(runif(5), rnorm(5)) - e$expr <- quote(x <- c(runif(5), rnorm(5))) - e$val <- x - e$les <- "stub" - e$delta <- list(x=x) - attr(e$les, "course_name") <- "Test Lessons" - e$snapshot <- new.env() - expect_that(testMe(keyphrase="omnitest('x <- c(runif(5), rnorm(5))')", e=e), is_true()) - invisible() -}) diff --git a/tests/testthat/test-rmatch_calls.R b/tests/testthat/test-rmatch_calls.R new file mode 100644 index 0000000..6bef7a8 --- /dev/null +++ b/tests/testthat/test-rmatch_calls.R @@ -0,0 +1,45 @@ +context("rmatch_calls") + +test_that("Omitted leading or trailing zeros don't cause mismatch.", { + testv <- parse(text="seq(1, 10, by=0.5); seq(1, 10, by=.5); seq(1, 10, by=.50)") + iscorrect <- is_identical_to(rmatch_calls(testv[[1]])) + for(v in testv){ + expect_that(rmatch_calls(v), iscorrect) + } + invisible() +}) + +test_that("Omission, inclusion, or order of named arguments doesn't cause mismatch.", { + 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)") + iscorrect <- is_identical_to(rmatch_calls(testv[[1]])) + for(v in testv){ + expect_that(rmatch_calls(v), iscorrect) + } + invisible() +}) + +test_that("S4 methods and reference classes raise errors",{ + # For testing reference classes; example from Hadley Wickham, Advanced R + Person <- setRefClass("Person", methods = list( + say_hello = function() message("Hi!") + )) + person <- Person$new() + # For testing S4 functions. (logLik(object) in stats4 is distributed with R.) + library(stats4) + testv <- parse(text="peep <- Person$new(); person$say_hello(); logLik(obj)") + for(v in testv){ + expect_that(try(rmatch_calls(v), silent=TRUE), is_a("try-error")) + } +}) + +test_that("With default settings, S3 methods with calls as first arguments raise errors.",{ + expr <- quote(print(paste("hi", 5))) + expect_that(try(rmatch_calls(expr), silent=TRUE), is_a("try-error")) + expr <- quote(summary(lm(child ~ parent, galton))) + expect_that(try(rmatch_calls(expr), silent=TRUE), is_a("try-error")) +}) + +test_that("With eval_for_class=TRUE, S3 methods with calls as first arguments raise errors.",{ + expr <- quote(print(paste("hi", 5))) + expect_false(is(try(rmatch_calls(expr, eval_for_class=TRUE), silent=TRUE), "try-error")) +}) diff --git a/tests/testthat/test-uses_func.R b/tests/testthat/test-uses_func.R new file mode 100644 index 0000000..3ae8a76 --- /dev/null +++ b/tests/testthat/test-uses_func.R @@ -0,0 +1,5 @@ +context("uses_func") + +test_that("uses_func works with the current version of testthat", { + expect_true(swirl:::uses_func("info")(parse(text="info()"))[[1]]) +}) \ No newline at end of file