Little useless-useful R functions – Mastermind board game for R

Playing a simple guessing game with R. It’s called Mastermind game! This game was originally created for two people, but R version will be for single-player mode, when an R developer or R data scientists need a break.

The gameplay is simple and so are the rules. The board contains 10 rows (or more) with possibilities of four colours and code pegs (white or black). R engine stores a secret colour combination and user selects a random combination.

Based on selection, the R engine returns the black or white pegs. Black peg represents that one colour is at the right place, white that the colour matches, but not the position. No pegs would mean that none of selected colours matches the secret colour combination.

Using x11() function, this game becomes so much fun with R. And the outlooks is:

The game code consists of board function, adding colours on the board, checking for the code pegs function and gameplay function.


##########################################
# 
# Mastermind board game for R Language
# 
# Game for single-player R developers/Data scientists for
# killing time, playing game while waiting for the ML
# model to finish training or just to play.
#
# Series:
# Little Useless-useful R functions #31
# Created: January 06, 2022
# Author: Tomaz Kastrun
# Blog: tomaztsql.wordpress.com
# V.1.0

# Changelog: 
###########################################

numberOfColors <- 4
numberOfTries <- 10

get_board <- function(nof_col, nof_try=10){
  plot.new()
  op <- par(bg = "white")
  grid(nx = 6, ny = 12, col = "gray", lty = "dotted",lwd = par("lwd"), equilogs = TRUE)
  
  # adding boarders 
  par(new = TRUE)
  plot(c(100,500), c(100,500), xlab = "", ylab = "", xaxt = 'n', yaxt = 'n',main = "Mastermind board game")
  nof_tries <- nof_try
  for (i in 1:nof_tries) { #rows
    for (j in 1:nof_col) { #columns
      col <- 50*(1:nof_col-1)
      rect(100+col[j], 500-(i*30), 150+col[j], 475-(i*30), col = 'white')
    }
  }
  colours = c('Red','Green','Blue','Yellow','Brown','Orange')
  for (z in 1:nof_col) {
    rect(100+z*50, 100, 150+z*50, 150, col = colours[z])
  } 
}

add_rect <- function(colour,try,nof_try=10) {
  par(new = TRUE)
  max_tries <- numberOfColors*nof_try #10 rows
  if (try %% numberOfColors == 0) { #number of tries = number of colours
    nof_try <- try/numberOfColors
    add_key_pegs(input_colours,store_secret, nof_try)
  } 
  
  if (try > numberOfColors){
    row <- ceiling((try/numberOfColors))
    rect_order <- abs(try-((row-1)*numberOfColors))
  } else {
    row <- 1
    rect_order <- try
  }
  rect(100+(rect_order*50)-50, 500-(row*30),150+((rect_order*50))-50, 475-(row*30), col = colour)
}


add_key_pegs <- function(input_colours, store_secret,nof_try){
 
  ss <- store_secret
  ic <- input_colours 
  ss1 <- as.vector(strsplit(as.character(ss), "")[[1]])
  ic1 <- as.vector(strsplit(as.character(ic), "")[[1]])
  
  white <- ""
  black <- ""
  for (i in 1:length(ss1)){
    for (j in 1:length(ic1)){
      if (i==j && ss1[i] == ic1[j]) {black <- as.integer(paste( c(black, ic1[j]),collapse=""))}
      if (ss1[i] == ic1[j]) { white <- as.integer(paste( c(white, ic1[j]),collapse="")) }
    }
  }
  
  black1 <- as.vector(strsplit(as.character(black), "")[[1]])
  white1 <- as.vector(strsplit(as.character(white), "")[[1]])
  
  black <- nchar(black)
  white <- length(unique(setdiff(white1, black1)))
  nof_tokes <- black + white
  tok <- replicate(black, "black")
  en <- replicate(white, "gray")
  token <- c(tok, en)
  name1 <- token[1]
  name2 <- token[2]
  name3 <- token[3]
  name4 <- token[4]
  
  if (nof_tokes == 1) {
    par(new = TRUE)
    plot(450,500-(nof_try*30), col = name1, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
  }
  if (nof_tokes == 2) {
    par(new = TRUE)
    plot(450,500-(nof_try*30), col = name1, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(450,490-(nof_try*30), col = name2, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
  }
  if (nof_tokes == 3) {
    par(new = TRUE)
    plot(450,500-(nof_try*30), col = name1, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(450,490-(nof_try*30), col = name2, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(470,500-(nof_try*30), col = name3, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
  }
  if (nof_tokes == 4) {
    par(new = TRUE)
    plot(450,500-(nof_try*30), col = name1, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(450,490-(nof_try*30), col = name2, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(470,500-(nof_try*30), col = name3, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
    par(new = TRUE)
    plot(470,490-(nof_try*30), col = name4, lwd = 2, xaxt = 'n', yaxt = 'n', xlab = "",ylab = "",xlim=range(100:500), ylim=range(100:500))
  }
}

get_secret <- function(nof_col, colours_repeat=FALSE) {
  colours <- c(1:4)
  s <- sample(colours,nof_col, replace=colours_repeat) 
  s <- paste(s, collapse="")
  return(as.integer(s))
}


game <- function(numberOfColors=4, numberOfTries=10){
   rm(list = ls())
   x11()
   end_game <- 1
   count <<- 0
   get_board(nof_col = numberOfColors, nof_try = numberOfTries)
   store_secret <<- get_secret(nof_col=numberOfColors, colours_repeat =TRUE)
   input_colours <<- 0L
   #input_colours <- c("Blue", "Yellow","Green","Yellow") #, "Brown", "Green")
   nof_selection <- numberOfColors
   max_tries <- nof_selection*numberOfTries 
 
   while (end_game <= max_tries && store_secret != input_colours) {
     mouse.at <- locator(n = 1, type = "o") 
     x.at <- mouse.at$x
     y.at <- mouse.at$y
     
     
     if (x.at >= 150 & x.at < 200 & y.at >= 100 & y.at <=150) {
       input_colours <<- as.integer(paste( c(input_colours, 1),collapse=""))
       add_rect('Red',end_game) 
     }
     if (x.at >= 200 & x.at < 250 & y.at >= 100 & y.at <=150) {
       input_colours <<- as.integer(paste( c(input_colours, 2),collapse=""))
       add_rect('Green',end_game) 
     }
     if (x.at >= 250 & x.at < 300 & y.at >= 100 & y.at <=150) {
       input_colours <<- as.integer(paste( c(input_colours, 3),collapse=""))
       add_rect('Blue',end_game) 
     }
     if (x.at >= 300 & x.at < 350 & y.at >= 100 & y.at <=150) {
       input_colours <<- as.integer(paste( c(input_colours, 4),collapse=""))
       add_rect('Yellow',end_game) 
     } 

     #end game if needed 
     if (store_secret == input_colours) {
       par(new = TRUE)
       mtext("GAME WON", side=1)
       break
     }

      #end game if needed 
     if (end_game == max_tries) {
       par(new = TRUE)
       mtext("END GAME", side=1)
     }
     
    if (end_game %% numberOfColors == 0)  {
           add_key_pegs(input_colours, store_secret, count)
           input_colours <<- 0L 
           count <<- count + 1
           print(count)
    
      } 
     # increment next level
     end_game = end_game + 1      
   }
    
}
  
######################
### Start The game ###
######################

game()
  

And a simple gameplay:

As always, code is available in at the Github in same Useless_R_function repository and the R file to the game is in the same repository, here. Check Github for future updates.

Happy R-coding and stay healthy!

Tagged with: , , , , ,
Posted in Uncategorized, Useless R functions
4 comments on “Little useless-useful R functions – Mastermind board game for R
  1. […] by data_admin [This article was first published on R – TomazTsql, and kindly contributed to R-bloggers]. (You can report issue about the content on this page […]

    Like

  2. […] Tomaz Kastrun continues a series of useful games: […]

    Like

  3. […] article was first published on R – TomazTsql, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here) […]

    Like

  4. cellocgw's avatar cellocgw says:

    Nice! You may have inspired me to port my console-ASCII version of “2048” to a graphics version!

    Like

Leave a comment

Follow TomazTsql on WordPress.com
Programs I Use: SQL Search
Programs I Use: R Studio
Programs I Use: Plan Explorer
Rdeči Noski – Charity

Rdeči noski

100% of donations made here go to charity, no deductions, no fees. For CLOWNDOCTORS - encouraging more joy and happiness to children staying in hospitals (http://www.rednoses.eu/red-noses-organisations/slovenia/)

€2.00

Top SQL Server Bloggers 2018
TomazTsql

Tomaz doing BI and DEV with SQL Server and R, Python, Power BI, Azure and beyond

Discover WordPress

A daily selection of the best content published on WordPress, collected for you by humans who love to read.

Revolutions

Tomaz doing BI and DEV with SQL Server and R, Python, Power BI, Azure and beyond

Reeves Smith's SQL & BI Blog

A blog about SQL Server and the Microsoft Business Intelligence stack with some random Non-Microsoft tools thrown in for good measure.

SQL Server

for Application Developers

Business Analytics 3.0

Data Driven Business Models

SQL Database Engine Blog

Tomaz doing BI and DEV with SQL Server and R, Python, Power BI, Azure and beyond

Search Msdn

Tomaz doing BI and DEV with SQL Server and R, Python, Power BI, Azure and beyond

R-bloggers

Tomaz doing BI and DEV with SQL Server and R, Python, Power BI, Azure and beyond

Data Until I Die!

Data for Life :)

Paul Turley's SQL Server BI Blog

sharing my experiences with the Microsoft data platform, SQL Server BI, Data Modeling, SSAS Design, Power Pivot, Power BI, SSRS Advanced Design, Power BI, Dashboards & Visualization since 2009

Grant Fritchey

Intimidating Databases and Code

Madhivanan's SQL blog

A modern business theme

Alessandro Alpi's Blog

DevOps could be the disease you die with, but don’t die of.

Paul te Braak

Business Intelligence Blog

Sql Insane Asylum (A Blog by Pat Wright)

Information about SQL (PostgreSQL & SQL Server) from the Asylum.

Gareth's Blog

A blog about Life, SQL & Everything ...

SQLPam's Blog

Life changes fast and this is where I occasionally take time to ponder what I have learned and experienced. A lot of focus will be on SQL and the SQL community – but life varies.

William Durkin

William Durkin a blog on SQL Server, Replication, Performance Tuning and whatever else.

$hell Your Experience !!!

As aventuras de um DBA usando o Poder do $hell

Design a site like this with WordPress.com
Get started