Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Correcciones en fin de lecciones y funciones en 14 porciento
- Loading branch information
Showing
15 changed files
with
110 additions
and
265 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,197 +1,112 @@ | ||
| # So swirl does not repeat execution of commands | ||
| # AUTO_DETECT_NEWVAR <- FALSE | ||
|
|
||
| expr_creates_var <- function(correctName=NULL){ | ||
| e <- get("e", parent.frame()) | ||
| # TODO: Eventually make auto-detection of new variables an option. | ||
| # Currently it can be set in customTests.R | ||
| delta <- if(!customTests$AUTO_DETECT_NEWVAR){ | ||
| safeEval(e$expr, e) | ||
| } else { | ||
| e$delta | ||
| } | ||
| if(is.null(correctName)){ | ||
| results <- expectThat(length(delta) >= 1, | ||
| testthat::is_true(), | ||
| label=paste(deparse(e$expr), | ||
| "does not create a variable.")) | ||
| } else { | ||
| results <- expectThat(correctName %in% names(delta), | ||
| testthat::is_true(), | ||
| label=paste(deparse(e$expr), | ||
| "does not create a variable named", | ||
| correctName)) | ||
| } | ||
| if(results$passed){ | ||
| e$newVar <- e$val | ||
| e$newVarName <- names(delta)[1] | ||
| e$delta <- mergeLists(delta, e$delta) | ||
| } else { | ||
| e$delta <- list() | ||
| } | ||
| return(results$passed) | ||
| test_func1 <- function() { | ||
| try({ | ||
| func <- get('boring_function', globalenv()) | ||
| t1 <- identical(func(9), 9) | ||
| t2 <- identical(func(4), 4) | ||
| t3 <- identical(func(0), 0) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| # Returns TRUE if the user has calculated a value equal to that calculated by the given expression. | ||
| calculates_same_value <- function(expr){ | ||
| e <- get("e", parent.frame()) | ||
| # Calculate what the user should have done. | ||
| eSnap <- cleanEnv(e$snapshot) | ||
| val <- eval(parse(text=expr), eSnap) | ||
| passed <- isTRUE(all.equal(val, e$val)) | ||
| if(!passed)e$delta <- list() | ||
| return(passed) | ||
| test_func2 <- function() { | ||
| try({ | ||
| func <- get('my_mean', globalenv()) | ||
| t1 <- identical(func(9), mean(9)) | ||
| t2 <- identical(func(1:10), mean(1:10)) | ||
| t3 <- identical(func(c(-5, -2, 4, 10)), mean(c(-5, -2, 4, 10))) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| omnitest <- function(correctExpr=NULL, correctVal=NULL, strict=FALSE){ | ||
| e <- get("e", parent.frame()) | ||
| # Trivial case | ||
| if(is.null(correctExpr) && is.null(correctVal))return(TRUE) | ||
| # Testing for correct expression only | ||
| if(!is.null(correctExpr) && is.null(correctVal)){ | ||
| passed <- expr_identical_to(correctExpr) | ||
| if(!passed)e$delta <- list() | ||
| return(passed) | ||
| } | ||
| # Testing for both correct expression and correct value | ||
| # Value must be character or single number | ||
| valGood <- NULL | ||
| if(!is.null(correctVal)){ | ||
| if(is.character(e$val)){ | ||
| valResults <- expectThat(e$val, | ||
| is_equivalent_to(correctVal, label=correctVal), | ||
| label=(e$val)) | ||
| if(is(e, "dev") && !valResults$passed)swirl_out(valResults$message) | ||
| valGood <- valResults$passed | ||
| # valGood <- val_matches(correctVal) | ||
| } 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), | ||
| 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){ | ||
| 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.") | ||
| eval(parse(text=correctExpr),globalenv()) | ||
| return(TRUE) | ||
| } else { | ||
| e$delta <- list() | ||
| return(FALSE) | ||
| } | ||
| test_func3 <- function() { | ||
| try({ | ||
| func <- get('remainder', globalenv()) | ||
| t1 <- identical(func(9, 4), 9 %% 4) | ||
| t2 <- identical(func(divisor = 5, num = 2), 2 %% 5) | ||
| t3 <- identical(func(5), 5 %% 2) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| match_call <- function(correct_call = NULL) { | ||
| e <- get("e", parent.frame()) | ||
| # Trivial case | ||
| if(is.null(correct_call)) return(TRUE) | ||
| # Get full correct call | ||
| full_correct_call <- expand_call(correct_call) | ||
| # Expand user's expression | ||
| expr <- deparse(e$expr) | ||
| full_user_expr <- expand_call(expr) | ||
| # Compare function calls with full arg names | ||
| identical(full_correct_call, full_user_expr) | ||
| test_func4 <- function() { | ||
| try({ | ||
| func <- get('evaluate', globalenv()) | ||
| t1 <- identical(func(sum, c(2, 4, 7)), 13) | ||
| t2 <- identical(func(median, c(9, 200, 100)), 100) | ||
| t3 <- identical(func(floor, 12.1), 12) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| # Utility function for match_call answer test | ||
| # Fills out a function call with full argument names | ||
| expand_call <- function(call_string) { | ||
| # Quote expression | ||
| qcall <- parse(text=call_string)[[1]] | ||
| # If expression is not greater than length 1... | ||
| if(length(qcall) <= 1) return(qcall) | ||
| # See if it's an assignment | ||
| is_assign <- is(qcall, "<-") | ||
| # If assignment, process righthandside | ||
| if(is_assign) { | ||
| # Get righthand side | ||
| rhs <- qcall[[3]] | ||
| # If righthand side is not a call, can't use match.fun() | ||
| if(!is.call(rhs)) return(qcall) | ||
| # Get function from function name | ||
| fun <- match.fun(rhs[[1]]) | ||
| # match.call() does not support primitive functions | ||
| if(is.primitive(fun)) return(qcall) | ||
| # Get expanded call | ||
| full_rhs <- match.call(fun, rhs) | ||
| # Full call | ||
| qcall[[3]] <- full_rhs | ||
| } else { # If not assignment, process whole thing | ||
| # Get function from function name | ||
| fun <- match.fun(qcall[[1]]) | ||
| # match.call() does not support primitive functions | ||
| if(is.primitive(fun)) return(qcall) | ||
| # Full call | ||
| qcall <- match.call(fun, qcall) | ||
| } | ||
| # Return expanded function call | ||
| qcall | ||
| test_func5 <- function() { | ||
| try({ | ||
| func <- get('telegram', globalenv()) | ||
| t1 <- identical(func("Good", "morning"), "START Good morning STOP") | ||
| t2 <- identical(func("hello", "there", "sir"), "START hello there sir STOP") | ||
| t3 <- identical(func(), "START STOP") | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| # Returns TRUE if e$expr matches any of the expressions given | ||
| # (as characters) in the argument. | ||
| ANY_of_exprs <- function(...){ | ||
| e <- get("e", parent.frame()) | ||
| any(sapply(c(...), function(expr)omnitest(expr))) | ||
| test_func6 <- function() { | ||
| try({ | ||
| func <- get('mad_libs', globalenv()) | ||
| t1 <- identical(func(place = "Baltimore", adjective = "smelly", noun = "Roger Peng statue"), "News from Baltimore today where smelly students took to the streets in protest of the new Roger Peng statue being installed on campus.") | ||
| t2 <- identical(func(place = "Washington", adjective = "angry", noun = "Shake Shack"), "News from Washington today where angry students took to the streets in protest of the new Shake Shack being installed on campus.") | ||
| ok <- all(t1, t2) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
|
|
||
|
|
||
| notify <- function() { | ||
| e <- get("e", parent.frame()) | ||
| if(e$val == "No") return(TRUE) | ||
|
|
||
| good <- FALSE | ||
| while(!good) { | ||
| # Get info | ||
| name <- readline_clean("What is your full name? ") | ||
| address <- readline_clean("What is the email address of the person you'd like to notify? ") | ||
|
|
||
| # Repeat back to them | ||
| message("\nDoes everything look good?\n") | ||
| message("Your name: ", name, "\n", "Send to: ", address) | ||
|
|
||
| yn <- select.list(c("Yes", "No"), graphics = FALSE) | ||
| if(yn == "Yes") good <- TRUE | ||
| } | ||
|
|
||
| # Get course and lesson names | ||
| course_name <- attr(e$les, "course_name") | ||
| lesson_name <- attr(e$les, "lesson_name") | ||
|
|
||
| subject <- paste(name, "just completed", course_name, "-", lesson_name) | ||
| body = "" | ||
|
|
||
| # Send email | ||
| swirl:::email(address, subject, body) | ||
|
|
||
| hrule() | ||
| message("I just tried to create a new email with the following info:\n") | ||
| message("To: ", address) | ||
| message("Subject: ", subject) | ||
| message("Body: <empty>") | ||
|
|
||
| message("\nIf it didn't work, you can send the same email manually.") | ||
| hrule() | ||
|
|
||
| # Return TRUE to satisfy swirl and return to course menu | ||
| TRUE | ||
| test_func7 <- function() { | ||
| try({ | ||
| func <- get('%p%', globalenv()) | ||
| t1 <- identical(func("Good", "job!"), "Good job!") | ||
| t2 <- identical(func("one", func("two", "three")), "one two three") | ||
| ok <- all(t1, t2) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| readline_clean <- function(prompt = "") { | ||
| wrapped <- strwrap(prompt, width = getOption("width") - 2) | ||
| mes <- stringr::str_c("| ", wrapped, collapse = "\n") | ||
| message(mes) | ||
| readline() | ||
| test_eval1 <- function(){ | ||
| try({ | ||
| e <- get("e", parent.frame()) | ||
| expr <- e$expr | ||
| t1 <- identical(expr[[3]], 6) | ||
| expr[[3]] <- 7 | ||
| t2 <- identical(eval(expr), 8) | ||
| ok <- all(t1, t2) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| hrule <- function() { | ||
| message("\n", paste0(rep("#", getOption("width") - 2), collapse = ""), "\n") | ||
| test_eval2 <- function(){ | ||
| try({ | ||
| e <- get("e", parent.frame()) | ||
| expr <- e$expr | ||
| t1 <- identical(expr[[3]], quote(c(8, 4, 0))) | ||
| t2 <- identical(expr[[1]], quote(evaluate)) | ||
| expr[[3]] <- c(5, 6) | ||
| t3 <- identical(eval(expr), 5) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } | ||
|
|
||
| test_eval3 <- function(){ | ||
| try({ | ||
| e <- get("e", parent.frame()) | ||
| expr <- e$expr | ||
| t1 <- identical(expr[[3]], quote(c(8, 4, 0))) | ||
| t2 <- identical(expr[[1]], quote(evaluate)) | ||
| expr[[3]] <- c(5, 6) | ||
| t3 <- identical(eval(expr), 6) | ||
| ok <- all(t1, t2, t3) | ||
| }, silent = TRUE) | ||
| exists('ok') && isTRUE(ok) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.