A Bayesian Guessing Game

You, the player, must think of some set, eg “odd numbers” or “perfect squares,” and that’ll be your little secret. Now think of some numbers that live in the intersection of your set and the integers {1, 2, … , 100} — for example, if you’ve chosen odd numbers, you might draw 3, 5 and 91 (but not 103). Below is some R code that asks for your numbers and then guesses what set you’re thinking of:

# Save as eg number_game.R and load with source("number_game.R")

# The user will think of integers belonging to some set, eg
#  "even numbers" or "multiples of 3"; the program sees only
#  the integers and guesses the set they were drawn from

# Guesses must be in 1:upper.bound
upper.bound <- 100

GetIntegersFromUser <- function() {
  prompt <- sprintf("%s (between 1 and %s): ",
                    "Please enter some space-delimited integers",
                    upper.bound)
  input.list <- strsplit(readline(prompt), split=" ")
  integers <- suppressWarnings(as.integer(c(input.list, recursive=TRUE)))
  return(integers[!is.na(integers) &
                  integers >= 1 & integers <= upper.bound])
}

integers <- GetIntegersFromUser()
while(!length(integers) > 0) {
  integers <- GetIntegersFromUser()
}
message("Your integers are: ", paste(integers, collapse=" "))

sets <- list()
AddSet <- function(numbers, description, prior=1) {
  # Sets have (un-normalized) prior probabilities
  new.set <- list(numbers=numbers, description=description, prior=prior)
  sets[[length(sets) + 1]] <<- new.set
}
AddSet(1:upper.bound, sprintf("everything from 1 to %s", upper.bound))
AddSet(which(1:upper.bound %% 2 == 0), "even numbers", 55)
AddSet(which(1:upper.bound %% 2 == 1), "odd numbers", 55)
AddSet(which(sqrt(1:upper.bound) %% 1 == 0), "perfect squares", 20)
AddSet((1:floor(upper.bound ^ (1/3))) ^ 3, "perfect cubes", 20)
for (i in 3:10) {
  AddSet(which(1:upper.bound %% i == 0),
         sprintf("multiples of %s", i), 15)
}
for (i in 1:upper.bound) {
  AddSet(i, sprintf("only the number %s", i))
}
for (i in 1:(ceiling(upper.bound / 10))) {
  range <- (10 * (i - 1)):(10 * i - 1)
  AddSet(range, sprintf("numbers from %s to %s", min(range), max(range)))
}

GetLogPosterior <- function(set) {
  return(log(set$prior) + log(all(integers %in% set$numbers)) +
         length(integers) * log(1 / length(set$numbers)))
}

unnormalized.log.posteriors <- sapply(sets, GetLogPosterior)
message("You're thinking of ",
        sets[[which.max(unnormalized.log.posteriors)]]$description)

# Could do more, eg output 2nd best guess (if it exists), or
#  output some measure of confidence along with the guess

Try copying the code into a text editor and saving it as number_game.R. You can then open up an R session and play the game:

> source("number_game.R")
Please enter some space-delimited integers (between 1 and 100): 36
Your integers are: 36
You're thinking of perfect squares

> source("number_game.R")
Please enter some space-delimited integers (between 1 and 100): 30 36
Your integers are: 30 36
You're thinking of multiples of 6

> source("number_game.R")
Please enter some space-delimited integers (between 1 and 100): 30 32 36
Your integers are: 30 32 36
You're thinking of numbers from 30 to 39

> source("number_game.R")
Please enter some space-delimited integers (between 1 and 100): 28 30 32 36
Your integers are: 28 30 32 36
You're thinking of even numbers

Have fun!

Postscript: ideally I’d like to run this game from the terminal, the way you would with a Python script or a compiled C++ program. Is there a way to do that in R without modifying my code? I’ve heard that readline only works in interactive sessions (in the R interpreter), which is unfortunate. Does anyone know a way around that?