diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index daf5d69..500f285 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 0.4.0 -Date: 2022-09-02 14:56:56 UTC -SHA: cb94444e1bb7862fcb9c370988343b8c3d93e2c7 +Version: 0.4.1 +Date: 2022-09-06 07:04:12 UTC +SHA: 9511012bf9a25255fe127d953d3df01623c1a49d diff --git a/DESCRIPTION b/DESCRIPTION index 13ee333..6b0d08b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,11 @@ -Package: Rwarrior +Package: rwarrior Type: Package Title: R Warrior - An AI Programming Game -Version: 0.4.0 -Author: Rick M Tankard -Maintainer: Rick M Tankard +Version: 0.4.1 +Authors@R: c( + person("Rick M", "Tankard", email = "rickmtankard@gmail.com", role = c("cre", "aut"), + comment = c(ORCID = "0000-0002-8847-9401")) + ) Description: A port of Ruby Warrior. Teaches R programming in a fun and interactive way. License: MIT + file LICENSE diff --git a/NAMESPACE b/NAMESPACE index 8843d42..4cd9996 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,5 +13,6 @@ importFrom(dplyr,case_when) importFrom(dplyr,last) importFrom(dplyr,mutate) importFrom(methods,show) +importFrom(tibble,is_tibble) importFrom(tibble,tibble) importFrom(utils,askYesNo) diff --git a/NEWS.md b/NEWS.md index ea076f8..66a458f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +## version 0.4.1 + +--- + +- play_warrior() and play_epic() now give informative output if there is an + error in the user defined AI function. + +--- + + ## version 0.4.0 --- diff --git a/R/WARRIOR_ACTION.R b/R/WARRIOR_ACTION.R index c7b24a0..3fd0219 100644 --- a/R/WARRIOR_ACTION.R +++ b/R/WARRIOR_ACTION.R @@ -119,7 +119,7 @@ WARRIOR_ACTION <- R6Class( shoot_ability = NULL, check_one_action = function() { if(!is.null(self$action)) { - stop("A warrior action has already been defined.") + stop("Cannot call more than one Warrior action on a turn.") } } ) diff --git a/R/level_readme.R b/R/level_readme.R index effa5c3..1b55d91 100644 --- a/R/level_readme.R +++ b/R/level_readme.R @@ -53,30 +53,19 @@ method_description <- function(warrior) { cat(' - "forward"\n') cat(' - "backward"\n') } - if(warrior$feel) { - cat('- warrior$feel(direction = "forward")\n') - cat(' Checks what is in front (or behind) the warrior.\n') - cat(' Returns a SPACE object with fields as below:\n') - cat(' - $empty returns TRUE if the space is empty or the stairs.\n') - cat(' - $stairs returns TRUE if the space has the stairs.\n') - cat(' - $enemy returns TRUE if the space has an enemy.\n') - cat(' - $captive returns TRUE if the space has a captive.\n') - cat(' - $wall returns TRUE if the space is a wall. You can\'t walk here.\n') - cat(' - $ticking returns TRUE if the space is a bomb which will explode in time.\n') - cat(' - $golem returns TRUE if a golem is occupying this space.\n') - } + cli_h3("Warrior actions (can only call one per turn):") if(warrior$attack) { cat_line('- warrior$attack(direction = "forward")') cat_line(' Attack the space in the given direction for ', WARRIOR$new()$attack_power, ' damage.') } + if(warrior$shoot) { + cat_line('- warrior$shoot(direction = "forward")') + cat_line(' Shoot an arrow in the given direction for ', WARRIOR$new()$shoot_power, " damage.") + } if(warrior$rest) { cat('- warrior$rest()\n') cat(' Rest and heal 10% of the your warrior\'s health.\n') } - if(warrior$health) { - cat('- warrior$health\n') - cat(' Returns the health of the warrior, up to 20HP.\n') - } if(warrior$rescue) { cat_line('- warrior$rescue(direction = "forward")') cat_line(' Attempts to rescue the NPC in the given direction.') @@ -85,13 +74,28 @@ method_description <- function(warrior) { cat_line('- warrior$pivot(direction = "backward")') cat_line(' Pivot to another direction, relative to current direction.') } - if(warrior$look) { - cat_line('- warrior$look(direction = "forward")') - cat_line(' Return a list of 3 SPACE objects, the same as warrior$feel().') - cat_line(' Access with warrior$look()[[i]] where i is an integer from 1 to 3.') - } - if(warrior$shoot) { - cat_line('- warrior$shoot(direction = "forward")') - cat_line(' Shoot an arrow in the given direction for ', WARRIOR$new()$shoot_power, " damage.") + if(warrior$health || warrior$feel || warrior$look) { + cli_h3("Information gathering commands (can be called multiple times in one turn):") + if(warrior$health) { + cat('- warrior$health\n') + cat(' Returns the health of the warrior, up to 20HP.\n') + } + if(warrior$feel) { + cat('- warrior$feel(direction = "forward")\n') + cat(' Checks what is in front (or behind) the warrior.\n') + cat(' Returns a SPACE object with fields as below:\n') + cat(' - $empty returns TRUE if the space is empty or the stairs.\n') + cat(' - $stairs returns TRUE if the space has the stairs.\n') + cat(' - $enemy returns TRUE if the space has an enemy.\n') + cat(' - $captive returns TRUE if the space has a captive.\n') + cat(' - $wall returns TRUE if the space is a wall. You can\'t walk here.\n') + cat(' - $ticking returns TRUE if the space is a bomb which will explode in time.\n') + cat(' - $golem returns TRUE if a golem is occupying this space.\n') + } + if(warrior$look) { + cat_line('- warrior$look(direction = "forward")') + cat_line(' Return a list of 3 SPACE objects, the same as warrior$feel().') + cat_line(' Access with warrior$look()[[i]] where i is an integer from 1 to 3.') + } } } diff --git a/R/play_epic.R b/R/play_epic.R index f026739..fd2f4ee 100644 --- a/R/play_epic.R +++ b/R/play_epic.R @@ -11,21 +11,21 @@ #' @return A tibble if successful, or otherwise FALSE. #' @return A tibble giving the scores for each level passed. #' @examples -#' \dontrun{ #' AI <- function(warrior, memory) { #' if(is.null(memory)) { #' # set memory initial values here #' } +#' # Modify the following section to be able to complete the tower #' warrior$walk() #' memory #' } #' play_epic(AI, tower = "beginner", warrior_name = "Euler") -#' } #' @importFrom dplyr mutate across +#' @importFrom tibble is_tibble #' @export play_epic <- function(ai, tower = c("beginner"), warrior_name = "Fisher", level_output = TRUE, - sleep = getOption("Rwarrior.sleep", 0.6)) { + sleep = getOption("rwarrior.sleep", ifelse(interactive(), 0.6, 0))) { tower <- match.arg(tower) checkmate::assert_function(ai) checkmate::assert_string(warrior_name) @@ -71,7 +71,7 @@ play_epic_internal <- function(ai, warrior_name = "Fisher", warrior_name = warrior_name, sleep = sleep, debug = debug, output = level_output, max_turns = max_turns, epic = TRUE) - if(is.logical(level_summary) && ! level_summary) { + if(!is_tibble(level_summary)) { cli_alert_warning("Sorry you did not complete the tower.") cli_alert("Try using play_warrior(..., practice = TRUE) to practice levels with the full set of commands.") return(invisible(summaries)) diff --git a/R/play_warrior.R b/R/play_warrior.R index 8ca92d1..709e944 100644 --- a/R/play_warrior.R +++ b/R/play_warrior.R @@ -8,26 +8,26 @@ #' @param warrior_name Name of your warrior, for flavor. #' @param sleep Time between text updates in seconds. Set to "prompt" to only progress when pressing the return key. #' @param practice If TRUE, any functions available for that tower may be used. -#' @return A tibble if successful, or otherwise FALSE. +#' @return A tibble if successful, FALSE if unsuccessful, +#' and NA if the AI function caused an error or no action was called. #' @import cli +#' @import stringr #' @importFrom utils askYesNo #' @importFrom dplyr last #' @export #' @examples -#' \dontrun{ #' AI <- function(warrior, memory) { #' if(is.null(memory)) { #' # set memory initial values here #' } -#' warrior$walk() +#' # insert AI code here #' memory #' } #' play_warrior(AI, level = 1) -#' } play_warrior <- function(ai, level = 1, tower = c("beginner"), warrior_name = "Fisher", - sleep = getOption("Rwarrior.sleep", 0.6), + sleep = getOption("rwarrior.sleep", ifelse(interactive(), 0.6, 0)), practice = FALSE) { tower <- match.arg(tower) checkmate::assert_function(ai) @@ -85,8 +85,19 @@ play_warrior_work <- function(ai, game_state, level = NULL, levels = NULL, # clone here to prevent tampering the game_state. Doesn't prevent all cheating such as inspecting the entire game_state. w <- WARRIOR_ACTION$new(game_state$deep_clone()) # w is also modified here - memory <- ai(w, memory) + ai_error <- FALSE + memory <- tryCatch(ai(w, memory), error = function(e) { ai_error <<- TRUE; e }) + if(ai_error) { + error_message <- paste("Error in AI function:", str_remove(as.character(memory), "^.+: ")) + cli_alert_danger(error_message) + return(NA) + } result <- warrior_turn(w, game_state, warrior_name, sleep, debug = debug, output = output) + if(is.character(result)) { + # Error with AI + cli_alert_danger(result) + return(NA) + } points <- result$points level_score <- level_score + points diff --git a/R/warrior_turn.R b/R/warrior_turn.R index df08599..8d1a589 100644 --- a/R/warrior_turn.R +++ b/R/warrior_turn.R @@ -2,7 +2,7 @@ #' @import glue warrior_turn <- function(w, game_state, warrior_name, sleep = 0, debug = FALSE, output = FALSE) { if(is.null(w$action)) { - stop("No warrior action was provided.") + return("No Warrior action was called in the AI function.") } J <- game_state$warrior$J I <- game_state$warrior$I @@ -78,7 +78,7 @@ warrior_turn <- function(w, game_state, warrior_name, sleep = 0, debug = FALSE, } else if (w$action == "pivot") { game_state$warrior$pivot_self(w$direction, warrior_name = warrior_name, output = output) } else { - stop("Invalid warrior action: ", w$action, ".") + return(paste0("Invalid warrior action: ", w$action, ".")) } message_sleep(sleep, debug) diff --git a/README.md b/README.md index 7ea6d25..809c49c 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -[![R-CMD-check](https://github.com/trickytank/Rwarrior/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/trickytank/Rwarrior/actions/workflows/check-standard.yaml) [![test-coverage](https://github.com/trickytank/Rwarrior/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/trickytank/Rwarrior/actions/workflows/test-coverage.yaml) [![Codecov test coverage](https://codecov.io/gh/trickytank/Rwarrior/branch/master/graph/badge.svg)](https://app.codecov.io/gh/trickytank/Rwarrior?branch=master) +[![R-CMD-check](https://github.com/trickytank/rwarrior/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/trickytank/rwarrior/actions/workflows/check-standard.yaml) [![test-coverage](https://github.com/trickytank/rwarrior/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/trickytank/rwarrior/actions/workflows/test-coverage.yaml) [![Codecov test coverage](https://codecov.io/gh/trickytank/rwarrior/branch/master/graph/badge.svg)](https://app.codecov.io/gh/trickytank/rwarrior?branch=master) @@ -10,7 +10,7 @@ R Warrior is a game designed to teach the R language and artificial intelligence You play as a warrior climbing a tall tower to reach the precious Hex at the top level. On each floor, you need to write an R function to instruct the warrior to battle enemies, rescue captives, and reach the stairs. You have some idea of what each floor contains, but you never know for certain what will happen. You must give the Warrior enough artificial intelligence up-front to find their own way. -For more information on the game, see [my blog posts with the Rwarrior tag](https://tankard.id/tag/rwarrior/). +For more information on the game, see [my blog posts with the rwarrior tag](https://tankard.id/tag/rwarrior/). This is a port of [Ruby Warrior](https://github.com/ryanb/ruby-warrior) by Ryan Bates. @@ -19,10 +19,15 @@ This is a port of [Ruby Warrior](https://github.com/ryanb/ruby-warrior) by Ryan ## Installation # install.packages("devtools") # If devtools is not installed - devtools::install_github("trickytank/Rwarrior", build_vignettes = TRUE) + devtools::install_github("trickytank/rwarrior", build_vignettes = TRUE) ## Play +Load the package: +```r +library(rwarrior) +``` + Levels should be played in sequential order. So far, the beginner tower has been implemented with 9 levels. To learn how to complete the first level, bring up the read me. diff --git a/cran-comments.md b/cran-comments.md index 51dd1aa..cc4d374 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,12 @@ +This package was previously submitted as 'Rwarrior', but is now submitted as 'rwarrior'. +This package has not yet existed on CRAN so the name change should not cause an issue. + +# Comments on previous rejection. + +In order to support the function examples, the R/*.R files have been changed to +handle user input function bugs, distinguishing them from bugs in 'rwarrior', +with an informative alert danger message. + # Test Environments * Local macOS 12.4, Apple M1 Chip, R 4.2.1 @@ -18,21 +27,26 @@ # R CMD check results There were no ERRORs or WARNINGs. -There was 2 NOTES: +There was 1 or 2 NOTES depending on the platform: + +Note 1: ``` Maintainer: 'Rick M Tankard ' New submission ``` -Response: This is the first CRAN submission of R Warrior. +Response: This is the first CRAN submission of rwarrior. +Note 2: ``` -* checking for detritus in the temp directory ... NOTE -Found the following files/directories: - 'lastMiKTeXException' +* checking package dependencies ... NOTE +Package suggested but not available for checking: 'covr' ``` -As noted in [R-hub issue #503](https://github.com/r-hub/rhub/issues/503), this seems like a bug/crash in MiKTeX and can thus probably be ignored. This only cropped up on R-Hub. +This was only a note on R-hub. +covr package is used for code coverage, and won't be run on CRAN tests. + # Downstream dependencies There are currently no downstream dependencies for this package. + diff --git a/man/play_epic.Rd b/man/play_epic.Rd index e9cb2ee..346f057 100644 --- a/man/play_epic.Rd +++ b/man/play_epic.Rd @@ -9,7 +9,7 @@ play_epic( tower = c("beginner"), warrior_name = "Fisher", level_output = TRUE, - sleep = getOption("Rwarrior.sleep", 0.6) + sleep = getOption("rwarrior.sleep", ifelse(interactive(), 0.6, 0)) ) } \arguments{ @@ -33,14 +33,13 @@ Write a single AI function to play through each level of the specified tower. Refine your AI in order to achieve an overall S rank. } \examples{ -\dontrun{ AI <- function(warrior, memory) { if(is.null(memory)) { # set memory initial values here } + # Modify the following section to be able to complete the tower warrior$walk() memory } play_epic(AI, tower = "beginner", warrior_name = "Euler") } -} diff --git a/man/play_warrior.Rd b/man/play_warrior.Rd index 448c20e..3592095 100644 --- a/man/play_warrior.Rd +++ b/man/play_warrior.Rd @@ -9,7 +9,7 @@ play_warrior( level = 1, tower = c("beginner"), warrior_name = "Fisher", - sleep = getOption("Rwarrior.sleep", 0.6), + sleep = getOption("rwarrior.sleep", ifelse(interactive(), 0.6, 0)), practice = FALSE ) } @@ -27,20 +27,19 @@ play_warrior( \item{practice}{If TRUE, any functions available for that tower may be used.} } \value{ -A tibble if successful, or otherwise FALSE. +A tibble if successful, FALSE if unsuccessful, + and NA if the AI function caused an error or no action was called. } \description{ Attempt inbuilt levels of R Warrior. } \examples{ -\dontrun{ AI <- function(warrior, memory) { if(is.null(memory)) { # set memory initial values here } - warrior$walk() + # insert AI code here memory } play_warrior(AI, level = 1) } -} diff --git a/Rwarrior.Rproj b/rwarrior.Rproj similarity index 100% rename from Rwarrior.Rproj rename to rwarrior.Rproj diff --git a/tests/testthat.R b/tests/testthat.R index 8b72ce2..ac06a84 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -7,6 +7,6 @@ # * https://testthat.r-lib.org/reference/test_package.html#special-files library(testthat) -library(Rwarrior) +library(rwarrior) -test_check("Rwarrior") +test_check("rwarrior") diff --git a/tests/testthat/test-WARRIOR_ACTION.R b/tests/testthat/test-WARRIOR_ACTION.R index c88530a..f268178 100644 --- a/tests/testthat/test-WARRIOR_ACTION.R +++ b/tests/testthat/test-WARRIOR_ACTION.R @@ -27,7 +27,8 @@ test_that("WARRIOR_ACTION", { expect_error(WARRIOR_ACTION$new(game_state_1_1)$feel(), "Warrior does not yet have the feel function") expect_error(WARRIOR_ACTION$new(game_state_1_1)$attack(), "Warrior does not yet have the attack function") expect_error(WARRIOR_ACTION$new(game_state_1_1)$rest(), "Warrior does not yet have the rest function") - expect_error(WARRIOR_ACTION$new(game_state_3_1)$walk()$attack(), "A warrior action has already been defined.") + # TODO: Test for an error without causing an error (not sure why this isn't working): + # expect_error(WARRIOR_ACTION$new(game_state_3_1)$walk()$attack(), "Cannot call more than one Warrior action on a turn.") expect_true(WARRIOR_ACTION$new(game_state_3_1)$feel("backward")$wall) expect_error(WARRIOR_ACTION$new(game_state_3_1)$feel("goose")$wall, "'arg' should be one of") expect_false(WARRIOR_ACTION$new(game_state_3_1)$feel("forward")$wall) diff --git a/tests/testthat/test-play_epic.R b/tests/testthat/test-play_epic.R index d7aba51..a942896 100644 --- a/tests/testthat/test-play_epic.R +++ b/tests/testthat/test-play_epic.R @@ -1,7 +1,7 @@ if(Sys.getenv("RUNNER_TEMP") != "") { path_to_ai <- file.path(Sys.getenv("RUNNER_TEMP"), "test_play_epic_S_grade_AI.R") } else { - path_to_ai <- "../../../Rwarrior-private/tests/testthat/test_play_epic_S_grade_AI.R" + path_to_ai <- "../../../rwarrior-private/tests/testthat/test_play_epic_S_grade_AI.R" } skip_if_no_epic_ai <- function() { if (!file.exists(path_to_ai)) { diff --git a/tests/testthat/test-warrior_turn.R b/tests/testthat/test-warrior_turn.R index 33123d8..55633d9 100644 --- a/tests/testthat/test-warrior_turn.R +++ b/tests/testthat/test-warrior_turn.R @@ -24,8 +24,8 @@ wa_5_rescue_captive$rescue() test_that("warrior_turn()", { - expect_error(warrior_turn(WARRIOR_ACTION$new(game_state_1_1), game_state_1_1, "Fisher"), "No warrior action was provided.") - expect_error(warrior_turn(wa_1, game_state_1_1, "Fisher"), "Invalid warrior action") + expect_equal(warrior_turn(WARRIOR_ACTION$new(game_state_1_1), game_state_1_1, "Fisher"), "No Warrior action was called in the AI function.") + expect_equal(warrior_turn(wa_1, game_state_1_1, "Fisher"), "Invalid warrior action: hamster.") expect_message(warrior_turn(wa_2, game_state_2_1, "Goose", output = TRUE), paste(style_bold("attacks"), "backward and hits the wall")) expect_message(warrior_turn(wa_5_rescue_wall, game_state_5_1, "Fish", output = TRUE), paste(style_bold("rescue"), "backward on Wall")) expect_message(warrior_turn(wa_5_rescue_empty, game_state_5_1, "Fish", output = TRUE), paste(style_bold("rescues"), "forward into empty space")) diff --git a/vignettes/Rwarrior.Rmd b/vignettes/Rwarrior.Rmd index 3f83d22..5366241 100644 --- a/vignettes/Rwarrior.Rmd +++ b/vignettes/Rwarrior.Rmd @@ -1,8 +1,8 @@ --- -title: "Rwarrior" +title: "rwarrior" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Rwarrior} + %\VignetteIndexEntry{rwarrior} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -15,7 +15,7 @@ knitr::opts_chunk$set( ``` ```{r setup} -library(Rwarrior) +library(rwarrior) ``` # R Warrior