####################################################################
#' Wordle Game Validation
#'
#' Given and input and a word, validate each letter based on Wordle's
#' rules: correct letter in correct placement (green), correct letter in wrong
#' placement (yellow), letter is not present (red).
#'
#' @param input Character. Word to validate (5-letters)
#' @param word Character. Word actually answer (5-letters).
#' @param dictionary Character vector. List of valid words. If set to NULL
#' then will use modified \code{scrabble_dictionary()} to fetch 5 letter words.
#' Use \code{lang_dic} param to set language.
#' @param lang_dic Character. Any of: "en", "es". Only used when \code{dictionary}
#' parameter is NULL. Requires internet connection the first time. Uses cache.
#' @param method Integer. 1 for \code{scrabble_dictionary()}, 3 for scrapping
#' the words taken straight from the game's source code.
#' @param print Boolean. Print validation results?
#' @return Invisible vector with results by letter.
#' @examples
#' word <- "ABBEY"
#' # Or pick a random one:
#' # word <- sample(wordle_dictionary("en"), 1)
#' wordle_check("OPENS", word)
#' wordle_check("BABES", word)
#' wordle_check("KEBAB", word, print = FALSE)
#' wordle_check("ABYSS", word)
#' wordle_check("ABBEY", word)
#' # Feel free to use scrabble_words() for hints
#' @export
#' @rdname wordle
wordle_check <- function(input, word, dictionary = NULL, lang_dic = "en", method = 3, print = TRUE) {
wordle_valid(input, dictionary, lang_dic, method)
out <- pos_check(input, word, len = 5, print = print)
return(invisible(out))
}
pos_check <- function(input, solution, len = 5, print = TRUE) {
tiles <- toupper(unlist(strsplit(solution, "")))
in_tiles <- toupper(unlist(strsplit(input, "")))
init <- rep("_", len)
init[which(!in_tiles %in% tiles)] <- "RED"
init[which(in_tiles %in% tiles)] <- "YELLOW"
init[which(in_tiles == tiles)] <- "GREEN"
out <- init
names(out) <- in_tiles
class(out) <- c("wordle_check", class(out))
print(out, print = print)
return(out)
}
#' @rdname wordle
#' @param x Object to print
#' @export
print.wordle_check <- function(x, print = TRUE, ...) {
texts <- NULL
for (i in seq_along(x)) {
texts <- c(texts, formatColoured(names(x)[i], x[i], bold = TRUE, cat = FALSE))
}
txt <- paste(texts, collapse = " ")
if (print) cat(txt) else return(txt)
}
wordle_valid <- function(input, dictionary, lang_dic = "en", method = 3) {
if (is.null(dictionary)) {
dictionary <- wordle_dictionary(lang_dic, method, quiet = TRUE)
}
if (!toupper(input) %in% toupper(dictionary)) {
stop(input, " is not a valid input word")
}
}
#' @inheritParams scrabble_dictionary
#' @export
#' @rdname wordle
wordle_dictionary <- function(lang_dic = "en", method = 3, quiet = TRUE) {
if (is.null(lang_dic)) {
return(NULL)
}
check_opts(lang_dic, c("en", "es"))
cache_name <- c(lang_dic, method)
if (cache_exists(cache_name)) {
words <- cache_read(cache_name, quiet = quiet)
if (!quiet) {
message(sprintf(
">>> Loaded %s '%s' words",
formatNum(length(words), 0), lang_dic
))
}
return(words)
}
if (method == 1) {
words <- scrabble_dictionary(lang_dic, quiet)[[1]]
}
if (method == 3) {
url <- "https://raw.githubusercontent.com/tabatkins/wordle-list/main/words"
words <- readLines(url, warn = FALSE)
}
out <- toupper(words[nchar(words) == 5])
cache_write(out, cache_name, quiet = quiet)
if (!quiet) message(sprintf(">>> Saved (%s words) into cache", formatNum(length(out), 0)))
return(out)
}
#' @inheritParams cache_write
#' @inheritParams wordle_check
#' @param seed Numeric. For reproducibility. Accepts more than one: will
#' run as many seeds there are.
#' @export
#' @examples
#'
#' x <- wordle_simulation(input = "SAINT", word = "ABBEY", seed = 1:3)
#' print(x)
#' # hist(sapply(x, function(x) x$iters))
#' @rdname wordle
wordle_simulation <- function(input, word, seed = NULL, quiet = FALSE, ...) {
tic("wordle_simulation")
output <- NULL
if (is.null(seed)) seed <- sample(1:100, 1)
# First iteration with picked word (no random stuff happens here)
iter_first <- wordle_opts(input, word, quiet = quiet, ...)
for (s in seed) {
# Print first word for nicer and more informative output
if (s != seed[1]) {
wordle_check(input, word, ...)
if (!isFALSE(list(...)[["print"]])) cat("\n")
}
set.seed(s) # s = seed[1]
seed_loop <- NULL
i <- 1
used_words <- input
iter <- iter_first
# Second iteration onwards
while (length(iter) > 1) {
random_word <- sample(iter, 1)
used_words <- c(used_words, random_word)
iter <- wordle_opts(random_word, word, iter, quiet = quiet, ...)
# If random word picked is the word
if (random_word == word) break
# If last word remaining is the one
if (length(iter) == 1 && all(iter == word)) {
iter <- wordle_opts(word, word, iter, quiet = quiet, ...)
}
i <- i + 1
}
output[[paste0("seed_", s)]] <- list(words = used_words, iters = sum(used_words != word) + 1)
if (!quiet) message(sprintf(">> Iterations (seed = %s): %s\n", s, i + 1))
}
attr(output, "input") <- input
attr(output, "word") <- word
attr(output, "iterations") <- length(seed)
attr(output, "elapsed") <- toc("wordle_simulation", quiet = quiet)$time
class(output) <- c("wordle_simulation", class(output))
return(invisible(output))
}
#' @rdname wordle
#' @param type Integer. 1 for summary and 2 for coloured results.
#' @export
print.wordle_simulation <- function(x, type = 1, ...) {
iters_n <- unlist(lapply(x, function(x) x$iters))
if (type == 1) {
print(glued(
"Seed Word: {attr(x, 'input')}
Objective Word: {attr(x, 'word')}
Iterations: {attr(x, 'iterations')}
Mean to succeed: {signif(mean(iters_n), 3)}
Max to succeed: {max(iters_n)} [seed = {which.max(iters_n)}]
"
))
}
if (type == 2) {
words <- lapply(x, function(x) x$words)
for_print <- list()
split_col <- "BLUE"
names(split_col) <- attr(x, "word")
for (i in seq_along(x)) {
# Namings: word + seed + iterations
word_split_iter <- split_col
names(word_split_iter) <- paste(attr(x, "word"), names(x)[i], "->", iters_n[i], "iterations")
class(word_split_iter) <- "wordle_check"
res <- NULL
res[[1]] <- word_split_iter
# Word by word coloring
list <- words[[i]]
## Remove the word when it's guessed when more than 1 opts
list <- list[list != attr(x, "word")]
results <- lapply(list, function(i) wordle_check(i, attr(x, "word"), print = FALSE))
res <- append(res, results)
for_print <- append(for_print, res)
}
txts <- unlist(lapply(for_print, function(x) paste(print(x, print = FALSE))))
cat(txts, sep = "\n")
}
}
# which.max(sapply(x, function(x) x$iters))
# which.min(sapply(x, function(x) x$iters))
# wordle_simulation("SAINT", "ABBEY", 9)
# SIMULATE N SOLUTIONS BY START WORD
wordle_opts <- function(input, word, dictionary = NULL, lang_dic = "en", method = 3, quiet = FALSE, ...) {
if (is.null(dictionary)) dictionary <- wordle_dictionary(lang_dic, quiet = TRUE)
if (!word %in% dictionary) dictionary <- c(dictionary, word)
n_words_init <- length(dictionary)
check <- wordle_check(input, word, dictionary, lang_dic, method, print = FALSE)
dictionary <- discard_words(input, word, dictionary, check)
input_coloured <- print(check, print = FALSE)
if (!quiet) {
message(cat(
input_coloured, "reduced from", formatNum(n_words_init, 0),
"to", formatNum(length(dictionary), 0)
))
}
attr(dictionary, "answer") <- word
attr(dictionary, "last_word") <- input
return(dictionary)
}
discard_words <- function(input, word, dictionary, check) {
if (input[1] != word[1]) {
# Prepare data.frame to filtering words that match criteria
words_lst <- lapply(dictionary, function(x) toupper(unlist(strsplit(x, ""))))
words_df <- bind_rows(lapply(words_lst, function(x) as.data.frame(t(x)))) %>% mutate(word = dictionary)
# Letters not present
these <- unique(names(check[check == "RED"]))
if (length(these) > 0) {
are_nums <- these %in% as.character(0:9)
if (any(are_nums)) {
words_df <- filter(words_df, !grepl(paste0("[", paste(these[are_nums], collapse = "-"), "]"), .data$word))
}
are_lets <- grepl("[a-zA-Z]", these)
if (any(are_lets)) {
words_df <- filter(words_df, !grepl(paste(these[are_lets], collapse = "|"), .data$word))
}
are_symbs <- !(are_nums | are_lets)
if (any(are_symbs)) {
words_df <- filter(words_df, !grepl(paste(paste0("\\", these[are_symbs]), collapse = "|"), .data$word))
}
}
# Letters present but not in position
these <- names(check[check == "YELLOW"])
words_df <- filter(words_df, grepl(paste(these, collapse = "|"), .data$word))
these_id <- which(check == "YELLOW")
for (i in seq_along(these)) words_df <- words_df[words_df[, these_id[i]] != these[i], ]
# Letters present in position
these <- names(check[check == "GREEN"])
these_id <- which(check == "GREEN")
for (i in seq_along(these)) words_df <- words_df[words_df[, these_id[i]] == these[i], ]
dictionary <- words_df$word
} else {
dictionary <- word
}
return(dictionary)
}
############ PLAY AREA ############
# # word <- sample(wordle_dictionary("en"), 1)
# word <- "ABBEY"
# wordle_check("OPENS", word)
# wordle_check("BABES", word)
# wordle_check("KEBAB", word)
# wordle_check("ABYSS", word)
# wordle_check("ABBEY", word)
#
# # Cheat using scrabble_words()
# set.seed(1) # For reproducibility
# # word <- sample(wordle_dictionary("en"), 1)
# word <- "FLESH" # Secret word
# # First iteration
# wordle_check("SAINT", word)
# scrabble_words(
# language = "en",
# force_n = 5,
# tiles = "S",
# force_exclude = "AINT"
# ) %>% pull(.data$word) %>% sample(10)
# # Second iteration
# wordle_check("fords", word)
# scrabble_words(
# language = "en",
# force_n = 5,
# tiles = "S",
# force_start = "F",
# force_exclude = "AINTORD"
# ) %>% pull(.data$word) %>% sample(10)
# # Third iteration
# wordle_check("fesse", word)
# scrabble_words(
# language = "en",
# force_n = 5,
# tiles = "ES",
# force_start = "F__S",
# force_exclude = "AINTORD"
# )
# # Fourth iteration
# wordle_check("flesh", word)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.