Random choice

The first and obvious choice is to choose randomly from the list of candidates. First we code the game using the wordle package and the WordleGame class. We are going to modify the code from Matthew Kay to define a function that plays the game for a given word:

play_game <- function(word,first_guess,quiet=FALSE){
  helper = WordleHelper$new(nchar = nchar(word)) #initialize the game
  game = WordleGame$new(helper$words, target_word = word)
  
  #make the first guess
  if (!is.null(first_guess)) {
    helper$update(first_guess, 
                  game$try(first_guess, quiet = quiet))
  }
  
  #iterate until solved
  while (!game$is_solved()) {
    guess = score_words(helper$words)$word[[1]] #choose next guess
    helper$update(guess, game$try(guess,quiet=quiet))
  }
  game$attempts
}

As we can see in every step we score the words and return the one with maximum score. To start, we are going to select them randomly:

score_words <- function(words){
  data.frame(word=words,score=runif(length(words))) %>% arrange(score)
}

Let’s try it out for Jan 10 word

set.seed(1)
answer <- play_game(word="query",first_guess="aeros",quiet=T)

Since the unicode does not render properly in markdown, here is screenshot:

Not bad, we got the solution in 4 tries.

How good is this strategy? We need to define an performance metric to evaluate each strategy. Edited As with any algorithm, we can test its performance measuring how well does the strategy against a sample of chosen target words. We are going to take three of them

• The first one is against a random choice of target word from the dictionary of 5 letters in English. There are 12972 words to choose from.

• However, in the original game, Wardle narrowed down the list of Wordle words to about 2500. So we will evaluate how well our strategy does against this list. You can download the list of possible answers here

possible_answers <- read.csv("./data/possible_answers.txt",header=F)

• Finally, we can measure how well the strategy performs for the past wordle answers. [Caution: this contains spoilers!]. Lucky for us Matthew Kay has compiled a list of them, to which I added the last ones here

past_answers <- read.csv("./data/past_answers.csv",header=F)

Let’s evaluate each performance metric. First a random sample of words from the dictionary (only 1000).

set.seed(1)
helper = WordleHelper$new(nchar = 5)
dictionary <- helper$words
first_guess <- "aeros"
dictionary_games <- sapply(sample(dictionary,1000),
                  \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                error=function(e) NA))

now for the possible answers

possible_answers_games <- sapply(possible_answers[,1],
                  \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                error=function(e) NA))

and finally for the previous wordle answers

past_answers_games <- sapply(past_answers[,1],
                  \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                error=function(e) NA))

How well did they do? Here is the distribution of the number of tries for each case

bind_rows(tibble(selection="Dictionary",tries=dictionary_games),
          tibble(selection="Possible answers",tries=possible_answers_games),
          tibble(selection="Past answers",tries=past_answers_games)) %>%
  group_by(selection,tries) %>% 
  summarise(n=n()) %>% mutate(freq=n/sum(n)) %>% 
  ggplot(aes(x=tries,y=freq,fill=selection)) + 
    geom_bar(position="dodge",stat="identity") +
    labs(x="Tries",fill="",y="Frequency",title="Using random words") +
    scale_fill_tableau() +
    geom_vline(xintercept = 6.5,linetype=2)

Not bad! Most of the time, we solved the game in 6 or fewer tries. Actually, we get

list("Dictionary"=dictionary_games,
     "Possible answers"=possible_answers_games,
     "Past answers"=past_answers_games) %>%
  map_dfr(\(answers) tibble("Average number of tries"=round(mean(answers),2),
                            "Probability of winning (%)"=round(mean(answers<7)*100,2)),
          .id="Selection") %>% 
  kableExtra::kbl() %>%
  kableExtra::kable_paper(bootstrap_options = "striped", full_width = F)

As we can see random guessing is already a good strategy, solving it in less than 6 tries 82% of the times (for random words in the dictionary) and around 89% for the list of possible and past answers. But let’s see if we can do better.

Using the frequency of words

(Edited) One of the most interesting findings about the game (rediscovered by Matthew Kay) is that the answers each day are not chosen randomly from the list of possible 5 letter words in the English dictionary. The very Wardle said in an interview in the New York Times that he narrowed down the list of Wordle words to about 2,500 which are most likely to be known by his partner (the first recipient of the game). That means that there are some words that have more probability to be the target word each day than others. To see that, we will plot the distributions of the rank of the past answers in the corpus of words of English. We are going to use two sources: the corpus of commonly-used words from the Google Web Trillion Word Corpus and the BNC word frequency list and put them together:

helper = WordleHelper$new(nchar = 5)
freq = tibble(word = helper$words) %>%
  left_join(read.csv("./data/unigram_freq.csv"), by = "word") %>%
  left_join(
    read.csv("./data/bnc_freq.csv") %>%
      group_by(word) %>%
      summarise(count = sum(count)),
    by = "word"
  ) %>%
  mutate(
    count.x = ifelse(is.na(count.x), 0, count.x),
    count.y = ifelse(is.na(count.y), 0, count.y),
    count = count.x/sum(count.x) + count.y/sum(count.y),
    # need a nonzero count for all words, so just assume words that don't
    # appear at all are half as frequent as the least frequent appearing word
    count = ifelse(count == 0, min(count[count != 0])/2, count),
    # rough log of the count shifted above 0
    # (we'll want this later)
    log_count = log(count) - log(min(count)/2),
    rank = rank(-count,ties.method = "random",)
  ) 

The following graph compares the distribution of ranks of randomly selected words in the wordle dictionary (flat) with the one of the past answers.

ggplot() + geom_density(data=freq,aes(x=rank,col="All words"),bw=10) +
  geom_density(data=freq %>% filter(word %in% past_answers[,1]),
               aes(x=rank,col="Past answers"),bw=10)+
  scale_color_tableau() + labs(col="")

Most of the target words in the past answers are chosen from the most frequent words in English. The distribution decays slowly, which means that some unusual (rank > 10000) words are likely. As Matthew suggests, “this is probably a sensible word selection strategy for making a good game, since it makes the puzzle not just a bunch of very common words (but also not just a bunch of rare words).”

But this information is quite useful since it tells us that the game is designed with a bias that we can exploit to design a better strategy. Specifically, we will choose the next guess as the most frequent word of the candidates in each step. Let’s modify the score function:

score_words <- function(words){
  ff <- freq %>% filter(word %in% words)
  ff %>% arrange(rank)
}

and play again the word for Jan 10

answer <- play_game(word="query",first_guess="aeros",quiet=)

##  a  e  r  o  s  
##  t  h  e  r  e  
##  q  u  e  r  y 

This time we solve the puzzle in 3 tries. How good is this strategy? We analyzed it using the same metrics as before. For the random choice of target word we get

set.seed(1)
helper = WordleHelper$new(nchar = 5)
dictionary <- helper$words
first_guess <- "aeros"
dictionary_games <- sapply(sample(dictionary,1000),
                    \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                  error=function(e) NA))

now for the possible answers

possible_answers_games <- sapply(possible_answers[,1],
                    \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                  error=function(e) NA))

and finally for the previous wordle answers

past_answers_games <- sapply(past_answers[,1],
                    \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                  error=function(e) NA))

Here is the distribution of the number of tries for each

bind_rows(tibble(selection="Dictionary",tries=dictionary_games),
          tibble(selection="Possible answers",tries=possible_answers_games),
          tibble(selection="Past answers",tries=past_answers_games)) %>%
  group_by(selection,tries) %>% 
  summarise(n=n()) %>% mutate(freq=n/sum(n)) %>% 
  ggplot(aes(x=tries,y=freq,fill=selection)) + 
    geom_bar(position="dodge",stat="identity") +
    labs(x="Tries",fill="",y="",title="Using word frequency") +
    scale_fill_tableau() +
    geom_vline(xintercept = 6.5,linetype=2)

As we can see, the strategy is much better for past answers and it solves it less tries. Actually we get that:

list("Dictionary"=dictionary_games,
     "Possible answers"=possible_answers_games,
     "Past answers"=past_answers_games) %>%
  map_dfr(\(answers) tibble("Average number of tries"=round(mean(answers),2),
                            "Probability of winning (%)"=round(mean(answers<7)*100,2)),
          .id="Selection") %>% 
  kableExtra::kbl() %>%
  kableExtra::kable_paper(bootstrap_options = "striped", full_width = F)

This means that we could have solved the game 97% of the time using this strategy. On average, using this strategy we will lose once a month only. Not bad for this simple strategy!

Of course, more complicated strategies can be implemented. For example, occasionally, our next guess could be a word that does not contain the letters found so far. That helps in situations where only a letter remains to be identified but many words are compatible with the ones found so far.

Edited Another possibility is to simulate the game forward. Given our final guess (e.g aeros) we could choose the next guess by simulate the game forward using all possible candidates and getting the one that maximizes some kind of entropy or probability. This is actually the idea behind some strategies that can reach even 100% winning probability. However, they are computationally expensive.

Choosing the best initial guess

Without modifying our strategy for our guess in each round, the only free choice we have is the initial guess we start with. In the examples above, we chose aeros, and it was intended. If we want to maximize the number of found letters from the beginning, our initial guess could be a word that contains the most frequent letters in English dictionary or in the past answers.

We can calculate these frequencies

dist_letters_dictionary <- unlist(strsplit(dictionary,"")) %>% 
  table() %>% data.frame() %>% rename(letter=1) %>% 
  mutate(dens=Freq/sum(Freq),corpus="Dictionary")
dist_letters_possible <- unlist(strsplit(possible_answers[,1],"")) %>% 
  table() %>% data.frame() %>% rename(letter=1) %>% 
  mutate(dens=Freq/sum(Freq),corpus="Possible answers")
dist_letters_past <- unlist(strsplit(past_answers[,1],"")) %>% 
  table() %>% data.frame() %>% rename(letter=1) %>% 
  mutate(dens=Freq/sum(Freq),corpus="Past answers")
dists <- rbind(dist_letters_dictionary,
               dist_letters_possible,
               dist_letters_past)
ggplot(dists) + 
  geom_bar(aes(x=reorder(letter,-dens),y=dens,fill=corpus),
                         position="dodge",stat="identity")+
  scale_fill_tableau() + labs(x="Letter",y="Frequency") +
  scale_y_continuous(labels=scales::percent)

Most frequent letters are vowels (e, o, a) and usual consonants like s and r. In the dictionary, these are the top 5 most frequent letters

dist_letters_dictionary %>% arrange(-dens) %>% head(5) %>% 
  kableExtra::kbl() %>%
  kableExtra::kable_paper(bootstrap_options = "striped", full_width = F)

This is why I chose aeros as the initial guess. However, we know the words are not chosen randomly from the dictionary. In fact for the possible answers the top 5 letters are

dist_letters_possible %>% arrange(-dens) %>% head(5) %>% 
  kableExtra::kbl() %>%
  kableExtra::kable_paper(bootstrap_options = "striped", full_width = F)

See, no s, but a t instead. These are the words that contain these 5 letters:

dictionary[grepl("e",dictionary) & grepl("r",dictionary) & 
             grepl("a",dictionary) & grepl("o",dictionary) & 
             grepl("t",dictionary)]

## [1] "oater" "orate" "roate"

Let’s see how good is the strategy we tried before with orate

set.seed(1)
helper = WordleHelper$new(nchar = 5)
dictionary <- helper$words
first_guess <- "orate"
dictionary_games <- sapply(sample(dictionary,1000),
                     \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                   error=function(e) NA))

now for the possible answers

possible_answers_games <- sapply(possible_answers[,1],
                     \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                   error=function(e) NA))

and finally for the previous wordle answers

past_answers_games <- sapply(past_answers[,1],
                     \(w) tryCatch(length(play_game(w,first_guess,quiet=T)),
                                   error=function(e) NA))

which gives the following metrics

list("Dictionary"=dictionary_games,
     "Possible answers"=possible_answers_games,
     "Past answers"=past_answers_games) %>%
  map_dfr(\(answers) tibble("Average number of tries"=round(mean(answers),2),
                            "Probability of winning (%)"=round(mean(answers<7)*100,2)),
          .id="Selection") %>% 
  kableExtra::kbl() %>%
  kableExtra::kable_paper(bootstrap_options = "striped", full_width = F)

Wow! 99% with this initial guess for the past and 97% for all the possible solutions. This is around 2% increase from aeros just by choosing a different word. It means (roughly) losing once every 100 games. Be aware that it could be an statistical fluke. More data (more games) are needed to assess if that increase is significant.

Here we have assumed that each letter has independent frequencies of appearance in a word, but in reality there could be patterns (two or three letters) which are more frequent that could be exploited to get better initial guess.