Hangman in R: A learning experience

I love when people take a sophisticated tool and use it to play video games. Take R for example. I first saw someone create a game for R at talk.stats.com. My friend Dason inspired me to more efficiently waste time in R with his version of minesweeper. The other day I had an immense amount of work to do and decided it was the perfect time to make a hangman game.

Now some of the skills to create hangman were outside my typical uses and skills for R. It caused me to stretch and grow a bit. The purpose of this post is two fold:

  1. To share the hangman game with people who have nothing better to do than waste time on a childhood game
  2. To share the learning experiences I had in creating the game

First the hangman game

I have the code for the function posted here but I have saved the code and data set (word list) for the function at github.  You can download the package that contains the hangman game and data set by either downloading the zip ball or tar ball, decompress and run R CMD INSTALL on it, or use the devtools package to install the development version:

# install.packages("devtools")
library(devtools)
install_github("hangman", "trinker")

To play type hangman() into the console and hit enter.

Here’s a screenshot of the game

hangman game
Now for the learning

Here’s the code for the hangman function:

hangman <- function(reset.score = FALSE) {
    opar <- par()$mar
    on.exit(par(mar = opar))
    par(mar = rep(0, 4))
    x1 <- DICTIONARY[sample(1:nrow(DICTIONARY), 1), 1]
    x <- unlist(strsplit(x1, NULL))
    len <- length(x)
    x2 <- rep("_", len)
    chance <- 0
    if(!exists("wins", mode="numeric", envir = .GlobalEnv)  | reset.score){
        assign("wins", 0, envir = .GlobalEnv)
    }
    if(!exists("losses", mode="numeric", envir = .GlobalEnv) | reset.score){
        assign("losses", 0, envir = .GlobalEnv)
    }
    win1 <- 0
    win <- win1/len
    wrong <- character()
    right <- character()
    print(x2, quote = FALSE)
    circle <- function(x, y, radius, units=c("cm", "in"), segments=100,  
        lwd = NULL){ 
        units <- match.arg(units) 
        if (units == "cm") radius <- radius/2.54 
        plot.size <- par("pin") 
        plot.units <- par("usr") 
        units.x <- plot.units[2] - plot.units[1] 
        units.y <- plot.units[4] - plot.units[3] 
        ratio <- (units.x/plot.size[1])/(units.y/plot.size[2]) 
        size <- radius*units.x/plot.size[1] 
        angles <- (0:segments)*2*pi/segments 
        unit.circle <- cbind(cos(angles), sin(angles)) 
        shape <- matrix(c(1, 0, 0, 1/(ratio^2)), 2, 2) 
        ellipse <- t(c(x, y) + size*t(unit.circle %*% chol(shape))) 
        lines(ellipse, lwd = lwd) 
    } #taken from John Fox: http://tolstoy.newcastle.edu.au/R/help/06/04/25821.html
    hang.plot <- function(){ #plotting function
        plot.new()
        parts <- seq_len(length(wrong))
        if (identical(wrong, character(0))) {
            parts <- 0
        }
        text(.5, .9, "HANGMAN", col = "blue", cex=2)   
        if (!6 %in% parts) { 
            text(.5, .1, paste(x2, collapse = " "), cex=1.5) 
        }
        text(.05, .86, "wrong", cex=1.5, col = "red") 
        text(.94, .86,"correct", cex=1.5, col = "red")
        text(.05, .83, paste(wrong, collapse = "\n"), offset=.3, cex=1.5, 
            adj=c(0,1))
        text(.94, .83, paste(right, collapse = "\n"), offset=.3, cex=1.5, 
            adj=c(0,1))
        segments(.365, .77, .365, .83, lwd=2)
        segments(.365, .83, .625, .83, lwd=2)
        segments(.625, .83, .625, .25, lwd=2)
        segments(.58, .25, .675, .25, lwd=2)
        if (1 %in% parts) {
            circle(.365, .73, .7, lwd=4)
            if (!6 %in% parts) { 
                text(.365, .745, "o o", cex=1)
            }
            if (!5 %in% parts) { 
                text(.365, .71, "__", cex = 1)
            }
        text(.36, .73, "<", cex=1)
        }
        if (2 %in% parts) {
            segments(.365, .685, .365, .4245, lwd=7)
        }
        if (3 %in% parts) {
            segments(.365, .57, .45, .63, lwd=7)
        }
        if (4 %in% parts) {
            segments(.365, .57, .29, .63, lwd=7)
        }
        if (5 %in% parts) {
            segments(.365, .426, .43, .3, lwd=7)
            text(.365, .71, "O", cex = 1.25, col = "red")
        }
        if (6 %in% parts) {
            segments(.365, .426, .31, .3, lwd = 7)
            text(.365, .745, "x  x", cex=1)
            text(.5, .5, "You Lose", cex=8, col = "darkgreen") 
            text(.5, .1, paste(x, collapse = " "), cex=1.5) 
        }
        if (win1 == len) {
            text(.5, .5, "WINNER!", cex=8, col = "green")
            text(.505, .505, "WINNER!", cex=8, col = "darkgreen")
        }
    } #end of hang.plot
    guess <- function(){#start of guess function
        cat("\n","Choose a letter:","\n") 
        y <- scan(n=1,what = character(0),quiet=T)
        if (y %in% c(right, wrong)) {
            stop(paste0("You've already guessed ", y))
        }
        if (!y %in% letters) {
            stop(paste0(y, " is not a letter"))
        }
        if (y %in% x) {
            right <<- c(right, y)
            win1 <<- sum(win1, sum(x %in% y)) 
            win <<- win1/len 
            message(paste0("Correct!","\n"))
        } else {
            wrong  <<- c(wrong, y)
            chance  <<- length(wrong)
            message(paste0("The word does not contain ", y, "\n"))
        }
        x2[x %in% right] <<- x[x %in% right]
        print(x2, quote = FALSE)
        hang.plot()
    }#end of guess function
    hang.plot()
    while(all(win1 != len & chance < 6)){ 
        try(guess())
    } 
    if (win == 1) {
        outcome <- "\nCongratulations! You Win!\n"
        assign("wins", wins + 1, envir = .GlobalEnv)
    } else {
        outcome <- paste("\nSorry. You lose. The word is:", x1, "\n")
        assign("losses", losses + 1, envir = .GlobalEnv)
    }
    cat(outcome)
    cat(paste0("\nwins: ", wins, " | losses: ", losses, "\n"))
    text(.5, .2, paste0("wins: ", wins, "  |  losses: ", 
        losses), cex = 3, col = "violetred")
}

Things I tried and learned:

  1. Translating simple game rules into systematic logic
  2. try
  3. plotting dynamically (text vs. mtext)
  4. while loop
  5. assign

I used try one other time in a web scraping function. If you don’t know anything about this function it allows you to try to do something and if an error occurs move onto the next step. This allows the game user to input wrong information yet the function doesn’t stop but instead recovers and prints a message.

I first tried plotting the symbols and text with mtext. Thanks to some help at stack.overflow I found out the text function is a more controllable choice. I also grabbed a circle plotting function from John Fox to avoid calling a package that plots circles.

This was my first need for a while loop (generally I use the apply functions but in this case the game logic demanded I repeat something until one of two circumstances were met (win or loss of the game)

assign is a nice function and I generally don’t use it as I can get away with <<- (cringe if you want but if you think it through the <<- operator can be handy.

So I encourage you to write your own R game as you’ll likely learn a bit, while effectively wasting time and will provide enjoyment to others. 

Warning: not tested on a Linux or Mac machine

About these ads

About tylerrinker

I am Literacy PhD student with a bent for the quantitative and a passion for R.
This entry was posted in games and tagged , , , , , , . Bookmark the permalink.

3 Responses to Hangman in R: A learning experience

  1. Karsten W. says:

    Cool — make it a CRAN package! It fits to the sudoku, minesweeper and rpoker packages…

  2. efrique says:

    Cutting and pasting the code would only work if it knew what DICTIONARY was.

    • efrique says:

      To clarify – I can find out what it looks like by loading your data set… but then I don’t need to. It’s kind of an ‘you can only find out how to make your own data set if you no longer need one” ironic situation. :)

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s