From 282e47463662afbfc318500804ae6f0890177a94 Mon Sep 17 00:00:00 2001 From: davidcleve Date: Sun, 24 May 2026 23:05:42 +0200 Subject: [PATCH 1/2] Add Shiny app, tests, vignette, and CI I added: Shiny app code, unit tests for Shiny app, vignette with step-by-step instructions of how to play the game, and Continuous Integration --- .Rbuildignore | 3 + .github/.gitignore | 1 + .github/workflows/R-CMD-check.yaml | 30 ++ .gitignore | 5 + DESCRIPTION | 7 +- NAMESPACE | 4 +- R/app.R | 303 ++++++++++-------- R/game_logic.R | 43 +-- README.md | 4 + man/create_manual_sequence.Rd | 27 -- man/generate_sequence.Rd | 2 +- man/get_card_states.Rd | 8 +- man/get_current_number.Rd | 28 -- man/run_app.Rd | 13 +- man/validate_manual_sequence.Rd | 28 ++ tests/testthat/test-app.R | 68 ++++ tests/testthat/test-generate_sequence.R | 18 ++ tests/testthat/test-get_card_states.R | 24 ++ tests/testthat/test-is_winner.R | 15 + tests/testthat/test-my-function.R | 75 ----- .../testthat/test-validate_manual_sequence.R | 24 ++ vignettes/.gitignore | 2 + vignettes/how-to-use-the-googol-game-app.Rmd | 74 +++++ 23 files changed, 500 insertions(+), 306 deletions(-) create mode 100644 .Rbuildignore create mode 100644 .github/.gitignore create mode 100644 .github/workflows/R-CMD-check.yaml create mode 100644 .gitignore delete mode 100644 man/create_manual_sequence.Rd delete mode 100644 man/get_current_number.Rd create mode 100644 man/validate_manual_sequence.Rd create mode 100644 tests/testthat/test-app.R create mode 100644 tests/testthat/test-generate_sequence.R create mode 100644 tests/testthat/test-get_card_states.R create mode 100644 tests/testthat/test-is_winner.R delete mode 100644 tests/testthat/test-my-function.R create mode 100644 tests/testthat/test-validate_manual_sequence.R create mode 100644 vignettes/.gitignore create mode 100644 vignettes/how-to-use-the-googol-game-app.Rmd diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..3912071 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,3 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^\.github$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..1a85d0f --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,30 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + pull_request: + +name: R-CMD-check.yaml + +permissions: read-all + +jobs: + R-CMD-check: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + steps: + - uses: actions/checkout@v6 + + - uses: r-lib/actions/setup-r@v2 + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c833a2c --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 42d09a2..6742181 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,12 @@ Encoding: UTF-8 LazyData: true RoxygenNote: 7.3.3 Imports: - checkmate (>= 2.3.4) + checkmate (>= 2.3.4), + shiny (>= 1.13.0) Suggests: + knitr, + rmarkdown, + shinytest2, testthat (>= 3.0.0) Config/testthat/edition: 3 +VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index bf377be..1dae0e7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,9 @@ # Generated by roxygen2: do not edit by hand -export(create_manual_sequence) export(generate_sequence) export(get_card_states) -export(get_current_number) export(is_winner) export(run_app) +export(validate_manual_sequence) +import(shiny) importFrom(checkmate,assert_numeric) diff --git a/R/app.R b/R/app.R index 2c709f3..951afff 100644 --- a/R/app.R +++ b/R/app.R @@ -1,175 +1,198 @@ -#' Launch the Googol Game Shiny app +#' Run the Googol Game app #' +#' @details Launches an interactive Shiny app for the Googol Game. The app has +#' three stages: setup (choose a random or manual sequence), game (reveal +#' cards one at a time and pick the highest), and result (win or loss message +#' with an option to play again). +#' @examples +#' if (interactive()) run_app() +#' @import shiny #' @export run_app <- function() { + + # Calling Shiny from the library is not strictly necessary since Shiny is + # imported, but lintr is not satisfied if I don't do it so it is here for now. library(shiny) + # The entire UI is driven by a single page switcher in the server. + # output$page renders setup, game, or result depending on game state. ui <- fluidPage( - titlePanel("Googol Game"), - tags$head(tags$style(HTML(" - .card-row { - display: flex; - gap: 16px; - flex-wrap: wrap; - margin: 24px 0; - } - .card { - width: 100px; - height: 150px; - border-radius: 10px; - border: 3px solid #ccc; - display: flex; - align-items: center; - justify-content: center; - font-size: 28px; - font-weight: bold; - } - /* Face down: not yet revealed */ - .card-hidden { - background-color: #2c3e50; - color: #2c3e50; - } - /* Currently revealed card */ - .card-current { - background-color: #ffffff; - border-color: #3498db; - } - /* Cards the player chose to pass */ - .card-passed { - background-color: #ecf0f1; - color: #95a5a6; - } - /* Result: card the player picked */ - .card-picked { - background-color: #ffffff; - border-color: #3498db; - } - /* Result: highest number in the sequence */ - .card-winner { - background-color: #d5f5e3; - border-color: #27ae60; - } - /* Result: player picked the highest — win */ - .card-picked-winner { - background-color: #d5f5e3; - border-color: #27ae60; - box-shadow: 0 0 10px #27ae60; - } - "))), - # uiOutput renders different screens dynamically based on game state - # State 1: setup — choose random or manual mode, set n, enter numbers if manual - # State 2: game — shows cards face down, reveals one at a time - # State 3: result — all cards face up, picked and highest card highlighted - uiOutput("screen") + titlePanel("The Googol Game"), + uiOutput("page") ) server <- function(input, output, session) { - # reactiveValues persists game state across user interactions - state <- reactiveValues( - screen = "setup", # which screen to display: "setup", "game", or "result" - sequence = NULL, # the vector of numbers for the current game - current_index = 1, # which card has been flipped (1 = first card revealed) - picked = NULL # the value the player chose to stop at - ) - - # Switch between screens by replacing the entire UI based on state$screen - output$screen <- renderUI({ - switch(state$screen, - setup = tagList( - radioButtons("mode", "Mode", - choices = c("Random" = "random", "Manual entry" = "manual") - ), - numericInput("n", "Number of values", value = 3, min = 2, step = 1), + + # Tracks how many number rows the player has added in manual mode. + # Starts at 1 so there is always at least one row visible. + n_rows <- reactiveVal(1) + + # Holds the finalized game sequence once the player clicks Start. + # NULL until Start is clicked, which signals the game has not yet begun. + sequence <- reactiveVal(NULL) + + # Tracks which card is currently being revealed. Resets to 1 on Start. + current_index <- reactiveVal(1) + + # Stores the value the player picked, NULL until they pick + picked <- reactiveVal(NULL) + + # Switch between setup, game, and result pages based on game state. + # sequence() == NULL: setup; picked() == NULL: game; otherwise: result. + output$page <- renderUI({ + if (is.null(sequence())) { + uiOutput("setup") + } else if (is.null(picked())) { + tagList(uiOutput("cards"), uiOutput("game_buttons")) + } else { + uiOutput("result") + } + }) + + # --- Setup --- + + # Append a new row each time the player clicks "Add number" + observeEvent(input$add_row, { + n_rows(n_rows() + 1) + }) + + # Render the setup page with instructions, sequence type selector, and inputs + output$setup <- renderUI({ + tagList( + p("Choose how to generate the sequence of numbers (i.e. Random or Manual)."), + tags$ul( + tags$li("Random: the app generates a sequence of random numbers for you. + Choose how many cards you want."), + tags$li("Manual: enter your own numbers one at a time. Use the multiplier + dropdown to enter large numbers (e.g. 2 x Googol). You need at + least 2 numbers.") + ), + # Let the player choose between a randomly generated or manually entered sequence + radioButtons("mode", "Sequence type", + choices = c("Random" = "random", "Manual" = "manual") + ), + # Show number-of-cards input only when random mode is selected + conditionalPanel("input.mode == 'random'", + numericInput("n_cards", "Number of cards", value = 3, min = 2) + ), + # Show manual entry controls only when manual mode is selected. + # Each number gets its own row with a base value and multiplier dropdown. + # The player clicks "Add number" to append a new row. + conditionalPanel("input.mode == 'manual'", uiOutput("manual_inputs"), - actionButton("start", "Start Game") + actionButton("add_row", "Add number") ), - game = { - # Delegate card state logic to game_logic.R - states <- get_card_states(state$sequence, state$current_index) - tagList( - tags$div(class = "card-row", - lapply(seq_along(state$sequence), function(i) { - css_class <- paste("card", paste0("card-", states[i])) - label <- if (states[i] == "hidden") "?" else state$sequence[i] - tags$div(class = css_class, label) - }) - ), - actionButton("pick", "Pick this card"), - # Next button is hidden on the last card, forcing the player to pick - if (state$current_index < length(state$sequence)) - actionButton("next_num", "Flip next card") - ) - }, - result = { - picked <- state$picked - max_val <- max(state$sequence) - tagList( - h2(if (is_winner(picked, state$sequence)) "You win!" else "You lose!"), - # Show all cards face up; highlight the picked and highest cards - tags$div(class = "card-row", - lapply(seq_along(state$sequence), function(i) { - num <- state$sequence[i] - css_class <- paste("card", if (num == picked && num == max_val) "card-picked-winner" - else if (num == picked) "card-picked" - else if (num == max_val) "card-winner" - else "card-passed") - tags$div(class = css_class, num) - }) - ), - actionButton("play_again", "Play Again") - ) - } + actionButton("start", "Start game") ) }) - # Dynamically render one numericInput per value when in manual mode + # Render one numericInput + selectInput pair per row. + # Input IDs are indexed (e.g. number_1, multiplier_1) so each row + # can be read independently when building the sequence. + # Existing input values are read with isolate() to preserve what the + # player entered when a new row is added. output$manual_inputs <- renderUI({ - req(input$mode == "manual", input$n) - lapply(seq_len(input$n), function(i) { - numericInput(paste0("num_", i), paste("Number", i), value = NA, min = 0, max = 1e6) + lapply(seq_len(n_rows()), function(i) { + num_val <- isolate(input[[paste0("number_", i)]]) + mul_val <- isolate(input[[paste0("multiplier_", i)]]) + fluidRow( + column(6, numericInput(paste0("number_", i), paste("Number", i), + value = if (is.null(num_val)) 0 else num_val, min = 0)), + column(6, selectInput(paste0("multiplier_", i), "Multiplier", + choices = c("None" = 1, "Million" = 1e6, "Billion" = 1e9, + "Trillion" = 1e12, "Googol" = 1e100), + selected = if (is.null(mul_val)) 1 else mul_val)) + ) }) }) + # Build the sequence using game_logic functions when the player clicks Start. + # In manual mode, read each row's number and multiplier, multiply them, + # then pass the resulting vector to validate_manual_sequence() for validation. + # Resets current_index and picked so a new game always starts fresh. observeEvent(input$start, { - n <- input$n + current_index(1) + picked(NULL) if (input$mode == "random") { - state$sequence <- generate_sequence(n) - state$current_index <- 1 - state$picked <- NULL - state$screen <- "game" + sequence(generate_sequence(input$n_cards)) } else { - # Collect values from dynamically generated inputs - numbers <- sapply(seq_len(n), function(i) input[[paste0("num_", i)]]) - # create_manual_sequence validates input and throws an error if invalid - tryCatch({ - state$sequence <- create_manual_sequence(numbers) - state$current_index <- 1 - state$picked <- NULL - state$screen <- "game" - }, error = function(e) { - # Show the validation error to the player without crashing the app - showNotification(conditionMessage(e), type = "error") + vals <- sapply(seq_len(n_rows()), function(i) { + input[[paste0("number_", i)]] * + as.numeric(input[[paste0("multiplier_", i)]]) }) + # Catch validation errors from validate_manual_sequence() and show a + # notification instead of crashing the app + tryCatch( + sequence(validate_manual_sequence(vals)), + error = function(e) showNotification(conditionMessage(e), type = "error") + ) } }) + # --- Game --- + + # Render one card per number in the sequence once the game has started. + # get_card_states() assigns each card a state ("passed", "current", "hidden") + # which determines what the player sees: passed and current cards show their + # number, hidden cards show a placeholder. + output$cards <- renderUI({ + req(sequence()) + states <- get_card_states(sequence(), current_index()) + lapply(seq_along(sequence()), function(i) { + if (states[i] == "hidden") { + div("?") + } else { + div(sequence()[i]) + } + }) + }) + + # Render Pick and Next buttons once the game has started. + # Next is disabled on the last card, forcing the player to pick. + output$game_buttons <- renderUI({ + req(sequence()) + is_last <- current_index() == length(sequence()) + tagList( + actionButton("pick", "Pick this number"), + if (!is_last) actionButton("next_card", "Next") + ) + }) + + # Advance to the next card when the player clicks Next + observeEvent(input$next_card, { + current_index(current_index() + 1) + }) + + # --- Result --- + + # Record the current number as the player's pick when they click Pick observeEvent(input$pick, { - state$picked <- get_current_number(state$sequence, state$current_index) - state$screen <- "result" + picked(sequence()[current_index()]) }) - observeEvent(input$next_num, { - state$current_index <- state$current_index + 1 + # Show win or loss message after the player picks, with a restart button. + # is_winner() compares the picked value against the full sequence. + output$result <- renderUI({ + req(picked()) + tagList( + if (is_winner(picked(), sequence())) { + p("You won! That was the highest number.") + } else { + p(paste("You lost. The highest number was", max(sequence()))) + }, + actionButton("restart", "Play again") + ) }) - # Reset all state to allow a fresh game without restarting the app - observeEvent(input$play_again, { - state$screen <- "setup" - state$sequence <- NULL - state$current_index <- 1 - state$picked <- NULL + # Reset all game state when the player clicks Play again, returning to setup + observeEvent(input$restart, { + sequence(NULL) + picked(NULL) + current_index(1) + n_rows(1) }) } + # Launch the Shiny app shinyApp(ui, server) } diff --git a/R/game_logic.R b/R/game_logic.R index 8a4b880..25c6667 100644 --- a/R/game_logic.R +++ b/R/game_logic.R @@ -2,49 +2,32 @@ #' #' @param n Number of values to draw #' @return A numeric vector of length n -#' @details Samples n unique integers from 0 to 100 without replacement. +#' @details Samples n unique integers from 0 to 1000 without replacement. #' @examples #' generate_sequence() #' generate_sequence(n = 5) #' @export generate_sequence <- function(n = 3) { - sample(0:100, n) + sample(0:1000, n) } -#' Get the number at a given position in the sequence -#' -#' @param sequence A numeric vector -#' @param index Position to retrieve (1-based) -#' @return A single numeric value -#' @details Retrieves the number the player is currently shown. The index -#' advances each turn, revealing one number at a time. -#' @examples -#' seq <- c(42, 7, 198) -#' get_current_number(seq, 1) -#' get_current_number(seq, 2) -#' @export -get_current_number <- function(sequence, index) { - sequence[index] -} - -#' Create a sequence from manually entered numbers +#' Validate and return a sequence of numbers entered by +#' the player in the Shiny app #' #' @param numbers A numeric vector of at least 2 values #' @return A numeric vector #' @details Player can manually enter numbers. Validates that the input contains -#' at least 2 unique numeric values in the range 0 to 1,000,000, then returns -#' them as the game sequence. Uses checkmate package for validation and error -#' messages. +#' at least 2 unique non-negative numeric values, then returns them as the +#' game sequence. Uses checkmate package for validation and error messages. #' @examples -#' create_manual_sequence(c(100, 5000, 42)) -#' create_manual_sequence(c(0, 999999, 12345, 678)) +#' validate_manual_sequence(c(100, 5000, 42)) +#' validate_manual_sequence(c(0, 1e100, 12345, 678)) #' @importFrom checkmate assert_numeric #' @export -create_manual_sequence <- function(numbers) { +validate_manual_sequence <- function(numbers) { assert_numeric( numbers, lower = 0, - upper = 1e6, any.missing = FALSE, min.len = 2, unique = TRUE @@ -56,10 +39,14 @@ create_manual_sequence <- function(numbers) { #' #' @param sequence A numeric vector #' @param current_index The index of the card currently revealed -#' @return A character vector with one entry per card: "passed", "current", or "hidden" +#' @return A character vector with one entry per card: "passed", "current", +#' or "hidden" #' @details Determines the state of each card based on how far the player has #' progressed. Cards before the current index are "passed", the current card -#' is "current", and unrevealed cards are "hidden". +#' is "current", and unrevealed cards are "hidden". In the Shiny UI, each +#' card needs to render differently depending on its state (i.e. passed cards +#' greyed out, current card highlighted in blue, hidden cards face-down); this +#' function provides the state labels to drive that styling. #' @examples #' get_card_states(c(42, 7, 198), 1) #' get_card_states(c(42, 7, 198), 2) diff --git a/README.md b/README.md index 6f719bb..a7bbf90 100644 --- a/README.md +++ b/README.md @@ -8,3 +8,7 @@ The basic idea is simple: a set of cards (e.g. 10) each contains a random number My application will allow players to use card sets of different sizes, with values either entered manually or generated randomly. The game can be used to explore optimal stopping theory and may also have applications in research or education. + + +[![R-CMD-check](https://github.com/Programming-The-Next-Step-2026/GoogolGame/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/Programming-The-Next-Step-2026/GoogolGame/actions/workflows/R-CMD-check.yaml) + diff --git a/man/create_manual_sequence.Rd b/man/create_manual_sequence.Rd deleted file mode 100644 index 5ecab8d..0000000 --- a/man/create_manual_sequence.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/game_logic.R -\name{create_manual_sequence} -\alias{create_manual_sequence} -\title{Create a sequence from manually entered numbers} -\usage{ -create_manual_sequence(numbers) -} -\arguments{ -\item{numbers}{A numeric vector of at least 2 values} -} -\value{ -A numeric vector -} -\description{ -Create a sequence from manually entered numbers -} -\details{ -Player can manually enter numbers. Validates that the input contains - at least 2 unique numeric values in the range 0 to 1,000,000, then returns - them as the game sequence. Uses checkmate package for validation and error - messages. -} -\examples{ -create_manual_sequence(c(100, 5000, 42)) -create_manual_sequence(c(0, 999999, 12345, 678)) -} diff --git a/man/generate_sequence.Rd b/man/generate_sequence.Rd index ef47ea6..ab0d77c 100644 --- a/man/generate_sequence.Rd +++ b/man/generate_sequence.Rd @@ -16,7 +16,7 @@ A numeric vector of length n Generate a sequence of random numbers } \details{ -Samples n unique integers from 0 to 100 without replacement. +Samples n unique integers from 0 to 1000 without replacement. } \examples{ generate_sequence() diff --git a/man/get_card_states.Rd b/man/get_card_states.Rd index d1a969b..1cf651c 100644 --- a/man/get_card_states.Rd +++ b/man/get_card_states.Rd @@ -12,7 +12,8 @@ get_card_states(sequence, current_index) \item{current_index}{The index of the card currently revealed} } \value{ -A character vector with one entry per card: "passed", "current", or "hidden" +A character vector with one entry per card: "passed", "current", +or "hidden" } \description{ Get the display state of each card @@ -20,7 +21,10 @@ Get the display state of each card \details{ Determines the state of each card based on how far the player has progressed. Cards before the current index are "passed", the current card - is "current", and unrevealed cards are "hidden". + is "current", and unrevealed cards are "hidden". In the Shiny UI, each + card needs to render differently depending on its state (i.e. passed cards + greyed out, current card highlighted in blue, hidden cards face-down); this + function provides the state labels to drive that styling. } \examples{ get_card_states(c(42, 7, 198), 1) diff --git a/man/get_current_number.Rd b/man/get_current_number.Rd deleted file mode 100644 index 5de9e3e..0000000 --- a/man/get_current_number.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/game_logic.R -\name{get_current_number} -\alias{get_current_number} -\title{Get the number at a given position in the sequence} -\usage{ -get_current_number(sequence, index) -} -\arguments{ -\item{sequence}{A numeric vector} - -\item{index}{Position to retrieve (1-based)} -} -\value{ -A single numeric value -} -\description{ -Get the number at a given position in the sequence -} -\details{ -Retrieves the number the player is currently shown. The index - advances each turn, revealing one number at a time. -} -\examples{ -seq <- c(42, 7, 198) -get_current_number(seq, 1) -get_current_number(seq, 2) -} diff --git a/man/run_app.Rd b/man/run_app.Rd index 7d9ae1b..634d7b2 100644 --- a/man/run_app.Rd +++ b/man/run_app.Rd @@ -2,10 +2,19 @@ % Please edit documentation in R/app.R \name{run_app} \alias{run_app} -\title{Launch the Googol Game Shiny app} +\title{Run the Googol Game app} \usage{ run_app() } \description{ -Launch the Googol Game Shiny app +Run the Googol Game app +} +\details{ +Launches an interactive Shiny app for the Googol Game. The app has + three stages: setup (choose a random or manual sequence), game (reveal + cards one at a time and pick the highest), and result (win or loss message + with an option to play again). +} +\examples{ +if (interactive()) run_app() } diff --git a/man/validate_manual_sequence.Rd b/man/validate_manual_sequence.Rd new file mode 100644 index 0000000..1de2035 --- /dev/null +++ b/man/validate_manual_sequence.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/game_logic.R +\name{validate_manual_sequence} +\alias{validate_manual_sequence} +\title{Validate and return a sequence of numbers entered by +the player in the Shiny app} +\usage{ +validate_manual_sequence(numbers) +} +\arguments{ +\item{numbers}{A numeric vector of at least 2 values} +} +\value{ +A numeric vector +} +\description{ +Validate and return a sequence of numbers entered by +the player in the Shiny app +} +\details{ +Player can manually enter numbers. Validates that the input contains + at least 2 unique non-negative numeric values, then returns them as the + game sequence. Uses checkmate package for validation and error messages. +} +\examples{ +validate_manual_sequence(c(100, 5000, 42)) +validate_manual_sequence(c(0, 1e100, 12345, 678)) +} diff --git a/tests/testthat/test-app.R b/tests/testthat/test-app.R new file mode 100644 index 0000000..a017fde --- /dev/null +++ b/tests/testthat/test-app.R @@ -0,0 +1,68 @@ +library(shinytest2) + +# 1. App loads on setup page +test_that("app loads on setup page", { + app <- AppDriver$new(run_app()) + app$wait_for_idle() + expect_true("start" %in% names(app$get_values()$input)) + app$stop() +}) + +# 2. Random mode: Start switches to game page +test_that("random mode Start switches to game page", { + app <- AppDriver$new(run_app()) + app$set_inputs(mode = "random", n_cards = 3) + app$click("start") + app$wait_for_idle() + expect_true("pick" %in% names(app$get_values()$input)) + app$stop() +}) + +# 3. Pick switches to result page +test_that("Pick switches to result page", { + app <- AppDriver$new(run_app()) + app$set_inputs(mode = "random", n_cards = 3) + app$click("start") + app$wait_for_idle() + app$click("pick") + app$wait_for_idle() + expect_true("restart" %in% names(app$get_values()$input)) + app$stop() +}) + +# 4. Play again returns to setup +test_that("Play again returns to setup page", { + app <- AppDriver$new(run_app()) + app$set_inputs(mode = "random", n_cards = 3) + app$click("start") + app$wait_for_idle() + app$click("pick") + app$wait_for_idle() + app$click("restart") + app$wait_for_idle() + expect_true("start" %in% names(app$get_values()$input)) + app$stop() +}) + +# 5. Manual mode with valid numbers starts game +test_that("manual mode with valid numbers starts game", { + app <- AppDriver$new(run_app()) + app$set_inputs(mode = "manual", number_1 = 100, multiplier_1 = 1) + app$click("add_row") + app$wait_for_idle() + app$set_inputs(number_2 = 500, multiplier_2 = 1) + app$click("start") + app$wait_for_idle() + expect_true("pick" %in% names(app$get_values()$input)) + app$stop() +}) + +# 6. Manual mode with only 1 number shows an error and stays on setup +test_that("manual mode with 1 number shows error and stays on setup page", { + app <- AppDriver$new(run_app()) + app$set_inputs(mode = "manual", number_1 = 100, multiplier_1 = 1) + app$click("start") + app$wait_for_idle() + expect_true("start" %in% names(app$get_values()$input)) + app$stop() +}) diff --git a/tests/testthat/test-generate_sequence.R b/tests/testthat/test-generate_sequence.R new file mode 100644 index 0000000..27ee688 --- /dev/null +++ b/tests/testthat/test-generate_sequence.R @@ -0,0 +1,18 @@ +# 1. Returns a vector of the correct length +test_that("generate_sequence returns a vector of the correct length", { + expect_length(generate_sequence(3), 3) + expect_length(generate_sequence(5), 5) +}) + +# 2. Returns values within range 0 to 1000 +test_that("generate_sequence returns values within range 0 to 1000", { + result <- generate_sequence(500) + expect_true(all(result >= 0)) + expect_true(all(result <= 1000)) +}) + +# 3. Returns unique values +test_that("generate_sequence returns unique values", { + result <- generate_sequence(50) + expect_equal(length(result), length(unique(result))) +}) diff --git a/tests/testthat/test-get_card_states.R b/tests/testthat/test-get_card_states.R new file mode 100644 index 0000000..285d02a --- /dev/null +++ b/tests/testthat/test-get_card_states.R @@ -0,0 +1,24 @@ +# 1. Returns a value for each card in the sequence +test_that("get_card_states returns a value for each card in the sequence", { + expect_length(get_card_states(c(42, 7, 198), 1), 3) +}) + +# 2. Marks cards before current_index as passed +test_that("get_card_states marks cards before current_index as passed", { + states <- get_card_states(c(42, 7, 198), 3) + expect_equal(states[1], "passed") + expect_equal(states[2], "passed") +}) + +# 3. Marks the current card as current +test_that("get_card_states marks the current card as current", { + states <- get_card_states(c(42, 7, 198), 2) + expect_equal(states[2], "current") +}) + +# 4. Marks cards after current_index as hidden +test_that("get_card_states marks cards after current_index as hidden", { + states <- get_card_states(c(42, 7, 198), 1) + expect_equal(states[2], "hidden") + expect_equal(states[3], "hidden") +}) diff --git a/tests/testthat/test-is_winner.R b/tests/testthat/test-is_winner.R new file mode 100644 index 0000000..e3aeb2c --- /dev/null +++ b/tests/testthat/test-is_winner.R @@ -0,0 +1,15 @@ +# 1. Returns TRUE when pick is the highest number +test_that("is_winner returns TRUE when pick is the highest number", { + expect_true(is_winner(198, c(42, 7, 198))) +}) + +# 2. Returns FALSE when pick is not the highest number +test_that("is_winner returns FALSE when pick is not the highest number", { + expect_false(is_winner(42, c(42, 7, 198))) +}) + +# 3. Correctly distinguishes 1 googol from 2 googol +test_that("is_winner correctly distinguishes 1 googol from 2 googol", { + expect_false(is_winner(1e100, c(1e100, 2e100))) + expect_true(is_winner(2e100, c(1e100, 2e100))) +}) diff --git a/tests/testthat/test-my-function.R b/tests/testthat/test-my-function.R deleted file mode 100644 index b0a0fe9..0000000 --- a/tests/testthat/test-my-function.R +++ /dev/null @@ -1,75 +0,0 @@ -test_that("generate_sequence returns a vector of the correct length", { - expect_length(generate_sequence(3), 3) - expect_length(generate_sequence(5), 5) -}) - -test_that("generate_sequence returns values within range 0 to 100", { - result <- generate_sequence(50) - expect_true(all(result >= 0)) - expect_true(all(result <= 100)) -}) - -test_that("generate_sequence returns unique values", { - result <- generate_sequence(50) - expect_equal(length(result), length(unique(result))) -}) - -test_that("get_current_number returns the correct value at a given index", { - seq <- c(42, 7, 198) - expect_equal(get_current_number(seq, 1), 42) - expect_equal(get_current_number(seq, 2), 7) - expect_equal(get_current_number(seq, 3), 198) -}) - -test_that("is_winner returns TRUE when pick is the highest number", { - expect_true(is_winner(198, c(42, 7, 198))) -}) - -test_that("is_winner returns FALSE when pick is not the highest number", { - expect_false(is_winner(42, c(42, 7, 198))) -}) - -test_that("create_manual_sequence returns the input when valid", { - expect_equal(create_manual_sequence(c(100, 5000, 42)), c(100, 5000, 42)) -}) - -test_that("create_manual_sequence throws error for non-numeric input", { - expect_error(create_manual_sequence(c("a", "b", "c"))) -}) - -test_that("create_manual_sequence throws error for values below 0", { - expect_error(create_manual_sequence(c(-1, 500, 1000))) -}) - -test_that("create_manual_sequence throws error for values above 1000000", { - expect_error(create_manual_sequence(c(100, 5000, 1000001))) -}) - -test_that("create_manual_sequence throws error for duplicate values", { - expect_error(create_manual_sequence(c(100, 100, 42))) -}) - -test_that("create_manual_sequence throws error for fewer than 2 values", { - expect_error(create_manual_sequence(c(100))) -}) - -test_that("get_card_states returns a value for each card in the sequence", { - expect_length(get_card_states(c(42, 7, 198), 1), 3) -}) - -test_that("get_card_states marks cards before current_index as passed", { - states <- get_card_states(c(42, 7, 198), 3) - expect_equal(states[1], "passed") - expect_equal(states[2], "passed") -}) - -test_that("get_card_states marks the current card as current", { - states <- get_card_states(c(42, 7, 198), 2) - expect_equal(states[2], "current") -}) - -test_that("get_card_states marks cards after current_index as hidden", { - states <- get_card_states(c(42, 7, 198), 1) - expect_equal(states[2], "hidden") - expect_equal(states[3], "hidden") -}) diff --git a/tests/testthat/test-validate_manual_sequence.R b/tests/testthat/test-validate_manual_sequence.R new file mode 100644 index 0000000..9857c74 --- /dev/null +++ b/tests/testthat/test-validate_manual_sequence.R @@ -0,0 +1,24 @@ +# 1. Returns the input when valid +test_that("validate_manual_sequence returns the input when valid", { + expect_equal(validate_manual_sequence(c(100, 5000, 42)), c(100, 5000, 42)) +}) + +# 2. Throws error for non-numeric input +test_that("validate_manual_sequence throws error for non-numeric input", { + expect_error(validate_manual_sequence(c("a", "b", "c"))) +}) + +# 3. Throws error for values below 0 +test_that("validate_manual_sequence throws error for values below 0", { + expect_error(validate_manual_sequence(c(-1, 500, 1000))) +}) + +# 4. Throws error for duplicate values +test_that("validate_manual_sequence throws error for duplicate values", { + expect_error(validate_manual_sequence(c(100, 100, 42))) +}) + +# 5. Throws error for fewer than 2 values +test_that("validate_manual_sequence throws error for fewer than 2 values", { + expect_error(validate_manual_sequence(c(100))) +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/how-to-use-the-googol-game-app.Rmd b/vignettes/how-to-use-the-googol-game-app.Rmd new file mode 100644 index 0000000..f45f516 --- /dev/null +++ b/vignettes/how-to-use-the-googol-game-app.Rmd @@ -0,0 +1,74 @@ +--- +title: "How to use the Googol Game app" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{How to use the Googol Game app} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(GoogolGame) +``` + +## What is the Googol Game? + +The Googol Game is based on the mathematical Secretary Problem. A sequence of +numbers is revealed one at a time. Your goal is to pick the highest number in +the sequence — but once you pass a number, you cannot go back. You win only if +the number you pick turns out to be the highest in the entire sequence, +including numbers you never saw. + +## How to launch the app + +```{r, eval = FALSE} +run_app() +``` + +## Step-by-step instructions + +### Step 1: Choose a sequence type + +When the app opens, choose how to generate the sequence of numbers: + +- **Random**: the app generates a sequence of random numbers for you. Enter + how many cards you want and click **Start game**. +- **Manual**: enter your own numbers one at a time. For each number, type a + value and optionally select a multiplier (e.g. select `2` and `Googol` to + enter 2 Googol). Click **Add number** to add another number. You need at + least 2 numbers and you can add as many numbers as you want. + **Note**: manual entry requires a second person — one who enters the numbers + and one who plays the game! Hand the keyboard to a friend to enter the + numbers and don't peek at the screen ;) + +### Step 2: Play the game + +After clicking **Start game**, the cards are revealed one at a time: + +- Cards you have already seen are shown with their number. +- The current card shows its number and is the one you can pick. +- Cards not yet revealed are shown as `?`. + +At each card you have two choices: + +- Click **Pick this number** to select the current card as your answer. +- Click **Next** to pass and reveal the next card. + +On the last card, only **Pick this number** is available — you must pick. + +### Step 3: See the result + +After picking, the app shows whether you won or lost: + +- **Win**: your chosen number was the highest in the sequence. +- **Loss**: a higher number existed elsewhere in the sequence, along with what + that number was. + +Click **Play again** to return to the setup page and start a new game. From 1d8fe744a04190185cea86a724e076628a7917c6 Mon Sep 17 00:00:00 2001 From: davidcleve Date: Sun, 24 May 2026 23:29:34 +0200 Subject: [PATCH 2/2] Delete "library(shiny)" in app.R I deleted "library(shiny)" in app.R because I believe it caused the R CMD checks of the push and pull requests to fail. --- R/app.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/app.R b/R/app.R index 951afff..9437ca1 100644 --- a/R/app.R +++ b/R/app.R @@ -10,10 +10,6 @@ #' @export run_app <- function() { - # Calling Shiny from the library is not strictly necessary since Shiny is - # imported, but lintr is not satisfied if I don't do it so it is here for now. - library(shiny) - # The entire UI is driven by a single page switcher in the server. # output$page renders setup, game, or result depending on game state. ui <- fluidPage(