Guess the Password Shiny App

For this week’s TidyTuesday, instead of creating a visualization, I decided to create a Shiny App. The data this week provided by Information is Beautiful is a set of 500 of the most common passwords. My Shiny App allows you to try to guess which passwords appear in the top 500, keeping score of every password you correctly guess.

You can view the app here: https://rbjanis.shinyapps.io/GuessThePassword/
and the complete code for the app here: https://github.com/rbjanis/GuessThePassword

I had to figure out few new things to make this app work the way I planned, which I’ll illustrate below.

Incrementing the score counter

In order to keep a running score that increments every time, I had to create a reactive value that only incremented if the guess was correct.

# Create initial score of 0
counter <- reactiveValues(scorevalue = 0)

# Increment score value if the guess is correct
observeEvent(input$submit, {
    if (guess() %in% passwords$password & !guess() %in% correct_guesses$correct) {
        counter$scorevalue <- counter$scorevalue + 1
    }
})

# Print the score
output$score <- renderUI({
    HTML(glue::glue("<font size = 14px> Score: {counter$scorevalue} </font>"))
})

Only counting correct answers once

After I initially made the app, I realized that I could continue to submit the same correct answer over and over again to increase my score. Since guessing the password is very serious business and we can’t have cheating, I had to figure out how to not allow this. I solved this by keeping a list of correctly guessed answers, with new correct answers appended each time they were guessed. Each new guess would then be checked not only against the list of all correct passwords, but also against the list of previous correct answers.

# Create the initial empty list of correct guesses
correct_guesses <- reactiveValues(correct = c())

# Print the result of the guess
guess_result <- eventReactive(input$submit, {
        if (guess() %in% passwords$password & !guess() %in% correct_guesses$correct) {
            HTML("<font color='green'; size = 16px> Yes!</font>")
        } else if (!guess() %in% passwords$password) {
            HTML("<font color='red'; size = 16px> Nope, try again.</font>")
        } else if (guess() %in% passwords$password & guess() %in% correct_guesses$correct) {
            HTML("<font color='red'; size = 16px> Password already guessed.</font>")
        }
    }, ignoreNULL = T, ignoreInit = T)

output$result <- renderUI({
    guess_result()
})
  
# Add additional correct guesses to the list  
observeEvent(input$submit, {
  if (guess() %in% passwords$password & !guess() %in% correct_guesses$correct) {
      correct_guesses$correct <- c(correct_guesses$correct, guess())
  }
})