Casino Games - Slots

Introduction

In the final entry of my three-part series of casino games in R, I break down how to tackle creating a complex function. Following closely with third project of Hands-On Programming with R by Garrett Grolemund, I’ll walk you through how to create a slot machine, step-by-step. If you find this post interesting, check out my resource review and have a go at the book yourself.

First, we’ll have to define exactly what we want to achieve. Then we’ll break up the project into smaller and more simple tasks and achieve those tasks individually. Finally, we’ll bring it all back together to format and test out our finished product to make sure it works.

I want to create a function that randomly generates three symbols, just as a traditional three-wheel slot machine would. I will define the probability of each symbol, and I want the symbols to be generated according to these probabilities.

I also want my function to score the symbols and tell me just how much I’ve won in that round. I want the prize to be presented as a dollar amount, and I want it to be accurate for every possible combination of symbols.

Finally, I want the function to return the values in this manner -

play() 
### 0 0 DD 
### $0 

Sounds easy enough!

Part I - Generate Symbols

The first step in creating this complex function is to break it down into bite-sized functions and tasks. Taking a sample of seven different symbols isn’t terribly difficult.

The possible symbols are diamonds, 7’s, 3 bars, 2 bars, 1 bar, a cherry, and a zero.

Their probabilities are 0.03, 0.03, 0.06, 0.10, 0.25, 0.01, and 0.52, respectively.

Let’s write this into a table in R:

possible_symbols <- c('DD' = 0.03,
                      '7' = 0.03,
                      'BBB' = 0.06,
                      'BB' = 0.1,
                      'B' = 0.25,
                      'C' = 0.01,
                      '0' = 0.52
                      )

possible_symbols

##   DD    7  BBB   BB    B    C    0 
## 0.03 0.03 0.06 0.10 0.25 0.01 0.52

Now that we’ve defined the symbols and their associated probabilities, we’ll use the sample function to choose the symbols three times, based on their probabilities. We will replace the symbols as we pick them, or else we would never be able to get more than 1 of any symbol.

get_symbols <- function() {
  
  # possible symbols are defined as the names of the possible_symbols vector
  wheel <- names(possible_symbols)
  # symbols take a sample from variable wheel
  symbols <- sample(
                    wheel,
  # the sample has size of 3 symbols
                    size = 3,
  # the symbols are taken and replaced so they can show up two or three times
                    replace = T, 
  # the probability of each symbol is taken from possible_symbols vector
                    prob <- possible_symbols
                    )
  # the generated symbols are now displayed
  symbols
  
}

  # test the function
get_symbols()

## [1] "0"   "B"   "BBB"

Looks good! You can think of get_symbols() as pulling the slot machine’s lever, and it’s output as the slot machine’s display. The symbols aren’t formatted properly, but we’ll format them at the same time as we format the prize output. For now, let’s move on to calculating that prize.

Part II - Calculate Prize

This function is a little more difficult because it deals with multiple cases. We should clearly explain what we want the function to do, then we should write pseudo-code for the function. Pseudo code is a notation resembling a simplified programming language, used in program design. Instead of using specific R syntax, we just state something like “if this, do that” in English.

Once we’ve wrote sufficient pseudo code, we’ll identify and complete simple tasks within the pseudo code until we’ve completed every piece of the function individually. Then we’ll work these simple tasks in together in a generalized way so they work for the larger program.

Once all of that is complete, we’ll test the program to make sure it all functions as expected.

Let’s get started by defining exactly how we want to score each of the combinations of symbols.

If get_symbols() returns three of a kind, such as DD DD DD, or B B B, the gambler wins. Three of a kind prizes are defined based on how rare the associated symbol is, where:

DD DD DD = $100
7 7 7 = $80 
BBB BBB BBB = $40 
BB BB BB = $25
B B B = $10 
C C C = $10 
0 0 0 = $0 

If get_symbols() returns any sequence of three bars, the gambler wins $5. A sequence of three bars can look like, but is not limited to, these examples:

BB BBB B 
BBB BBB BB
B B BB

If the bars are exactly alike, the three-of-a-kind prize takes precedence.

If get_symbol() returns one cherry, the gambler wins $2. If get_symbol() returns two cherries, the gambler wins $5. If get_symbol() returns three cherries, the gambler wins the three-of-a-kind cherries prize of $10.

Finally, the presence of diamonds doubles a payout. So, if get_symbols() returns all three diamonds, DD DD DD, the payout of $100 is doubled three times to equal $800. If get_symbols() returns C DD 0, the payout doubles from $2 for the single cherry, to $4 for the cherry and diamond.

And that’s the rules! They sound like a lot, but when we break them down into pseudo code they seem a lot more manageable.

Here’s some pseudo code to outline our tasks -

# get_symbols() returns 3 symbols 

define what three-of-a-kind is
define how three-of-a-kinds are scored

define sequence of bars
define how sequence of bars are scored

count cherries 
define how cherries are scored


count diamonds
apply diamond multiplier to score

# plug the defined values into a decision tree 

if (three-of-a-kind = True) {
    return three-of-a-kind score
} else if (sequence of bars = True) { 
  return bars scores
} else if (cherries = 1 or 2) {
  return cherries score
} else if (diamonds = 1, 2, or 3)
  return score with diamond multiplier
  
  
# return the calculated prize

If you thought about completing the task another way, that’s great! It might even be that your way is better. R prefers vectorized code, but my R-chops aren’t quite up to that level yet, so I’m still working with old fashion if-then statements and for-loops.

Now let’s work through these tasks one at a time.

Task 1. Define 3-of-a-kind

First things first, we’ll make test symbols so we don’t have to run the function get_symbols() over and over again, wishing for a testable results.

symbols_1 <- c('7', '7', '7')
symbols_2 <- c('0', '7', '7')
symbols_3 <- c('0', 'DD', '7')

A good way to test if the symbols are all alike utilizes the simple functions unique() and length() functions.

symbols_1

## [1] "7" "7" "7"

unique(symbols_1)

## [1] "7"

length(unique(symbols_1))

## [1] 1

If the symbols are alike, this sequence of functions returns the value 1. Let’s see what it does when the symbols are not all the same.

symbols_2

## [1] "0" "7" "7"

length(unique(symbols_2))

## [1] 2

symbols_3 

## [1] "0"  "DD" "7"

length(unique(symbols_3))

## [1] 3

This sequence of functions is just what we’re looking for. Now to create a simple variable that we can plug into an if-then statement, returning true if the functions equal 1, returning false if they do not.

same <- length(unique(symbols)) == 1

Task 2. Score Three-of-a-kind

We can again utilize a lookup table to score three of a kind in accordance with the defined payouts.

payouts <- c('DD' = 100,
             '7' = 80, 
             'BBB' = 40,
             'BB' = 25, 
             'B' = 10, 
             'C' = 10, 
             '0' = 0
             )

payouts

##  DD   7 BBB  BB   B   C   0 
## 100  80  40  25  10  10   0

This chunk of code will be placed after the same test we previously created. That means that only symbols that are three of a kind will ever reach this task. We can take any of the three symbols (because they must all be the same to get here) and return the payout based on that symbol.

symbols_1

## [1] "7" "7" "7"

payouts[[symbols_1[[1]]]]

## [1] 80

The payout associated with three-of-a-kind symbols 7 is $80. Our lookup table returns just that. Now let’s create the generalized version that we can insert into the function.

same_table <- c(
                'DD' = 100,
                '7' = 80,
                'BBB' = 40,
                'BB' = 25,
                'B' = 10,
                'C' = 10,
                '0' = 0
                )

same_prize <- same_table[[symbols[[1]]]]

Task 3. Test if symbols are all a version of ‘bar’

This task is actually very easy. We want to see if all three elements of the symbols variable are either B, BB, or BBB. Let’s create new test variables to help us with this.

symbols_1 <- c('B', 'BB', 'BBB')
symbols_2 <- c('0', 'B', '0')
symbols_3 <- c('7', 'BBB', 'BBB')

Two tools that can help us make this test easier are the all() function and the %in% operator.

bars <- all(symbols_1 %in% c('B','BB','BBB'))
bars

## [1] TRUE

bars <- all(symbols_2 %in% c('B','BB','BBB'))
bars

## [1] FALSE

bars <- all(symbols_3 %in% c('B', 'BB', 'BBB'))
bars

## [1] FALSE

In English, this code tests if all elements of symbol can be found in the vector containing B, BB, and BBB. Let’s generalize this code for the function.

bars <- all(symbols %in% c('B','BB','BBB'))

Task 4. Assign Prize for Bars

This is the easiest task in the entire function. If the function passes the prescribed “bar” test, the gambler wins $5. We’ve already created the bar test, so all we must do is award the prize.

prize <- 5 

Task 5. Test if Cherries are Present

This task is also quite easy. First, we need to determine if there are cherries present in the three symbols. Then we need to determine how many cherries there are. That’s it!

We’ll change the test parameters to fit this task again.

symbols_1 <- c('C', 'C', '7')
symbols_2 <- c('0', '0', 'C')
symbols_3 <- c('0', '0', '0')

Now we can use the sum function to add up how many of the elements in symbol are cherries.

cherries <- sum(symbols_1 == 'C')
cherries

## [1] 2

cherries <- sum(symbols_2 == 'C')
cherries

## [1] 1

cherries <- sum(symbols_3 == 'C')
cherries

## [1] 0

Here’s a generalized version of this.

cherries <- sum(symbols == 'C')
cherries

Task 6. Cherries Payout

It’s time for another look-up table! Remember that 0 cherries require no payout, 1 cherry earns a $2 payout, and two cherries earns a $5 payout.

Because of R’s indexing rules, we should add 1 to the cherry sum to access the proper payout (R starts at index 1, while the cherry count starts at 0).

cherries_0 <- 0
cherries_1 <- 1
cherries_2 <- 2

cherries_pay <- c(0, 2, 5)

cherries_pay[[cherries_0 + 1]]

## [1] 0

cherries_pay[[cherries_1 + 1]]

## [1] 2

cherries_pay[[cherries_2 + 1]]

## [1] 5

Great! Implementing a lookup table gets easier every time you do it. The generalized version of this task looks as follows.

cherries_pay <- c(0, 2, 5)

prize <- cherries_pay[[cherries + 1]]

Task 7. Diamond Count

Just like the cherry count, we’re going to sum how many diamonds are present in symbols.

diamonds <- sum(symbols == 'DD')
diamonds

Task 8. Diamonds Multiplier

If there is one diamond, we should multiply the prize that has already been determined by 2. If there are two diamonds, we should multiply it again by two. And for three, we do the same thing. A clever way of writing this is 2^diamond. Here’s what the code looks like in action.

diamonds_0 <- 0 
diamonds_1 <- 1 
diamonds_2 <- 2

prize <- 100 

prize * 2 ^ diamonds_0

## [1] 100

prize * 2 ^ diamonds_1

## [1] 200

prize * 2 ^ diamonds_2

## [1] 400

And the generalized version.

prize <- prize * 2 ^ diamonds

Creating the Score Function

Now that we’ve done the hard work, we can simply insert the generalized bits of code into the bare-bones program we previously described in pseudo-code. Translate that pseudo-code structure to R syntax, and we should have a complex function up and running in no time!

#### Create Function 
score <- function(symbols) {

### Definitions 

#  define default prize 
prize <- 0 

#  define same 
same <- length(unique(symbols)) == 1
#  define same prize
same_table <- c('DD' = 100,'7' = 80, 'BBB' = 40, 'BB' = 25, 'B' = 10, 'C' = 10, '0' = 0)
same_prize <- same_table[[symbols[[1]]]]

#  define bars
bars <- all(symbols %in% c('B','BB','BBB'))
#  define bar scores
bars_prize <- 5 

#  define cherries
cherries <- sum(symbols == 'C')
#  define cherries scores
cherries_table <- c(0, 2, 5)
cherries_prize <- cherries_table[[cherries + 1]]

#  define diamonds
diamonds <- sum(symbols =="DD")
#  define diamonds scores
diamonds_prize <- same_prize * 2 ^ diamonds
diamonds_prize <- diamonds_prize + cherries_prize * 2 ^ diamonds


### If / Then 

#  if same, same prize
if (same) {
  prize <- same_prize
# if bars, bars prize
} else if (bars) {
  prize <- bars_prize
# if cherries, cherries prize
} else if (cherries > 0) {
  prize <- cherries_prize
# if diamonds, diamonds multiplier
}

if (diamonds > 0) {
  prize <- diamonds_prize
}


### Display Prize
prize 

### End Function
}

Let’s test the function to make sure it works.

symbols <- c('7', '7', '7')
score(symbols)

## [1] 80

symbols <- c('B', 'BBB', 'B')
score(symbols)

## [1] 5

symbols <- c('C', 'B', 'B')
score(symbols)

## [1] 2

symbols <- c('DD', 'DD', 'DD')
score(symbols)

## [1] 800

symbols <- c('0', '0', '0')
score(symbols)

## [1] 0

Part two complete! Now to combine the get_symbols() function with the score() function, and format the results!

Part III - Format Results

Now that we’ve done all the hard work, we can put it together and make it beautiful!

play <- function() {
  symbols <- get_symbols()
  print(symbols)
  score(symbols)
}

Like always, we should test the function before moving forward.

play()

## [1] "BB" "B"  "B"

## [1] 5

Well it’s together, but the output isn’t beautiful! One. More. Step!

Create a function called slot_display that takes the output of play() and does the following.

slot_display <- function(prize){
  
# extra symbol 
symbols <- attr(prize, "symbols")

# collapse symbols into single string 
symbols <- paste(symbols, collapse = " ")

# combine symbols with prize as a regex
string <- paste(symbols, prize, sep = '\n$')

#display regex in consol without quotes
cat(string)

}

Does slot display works?

slot_display(play())

## [1] "BB" "B"  "B" 
## 
## $5

We’re getting closer! Now to encode the slot_display() function into print(). Print is what’s called a generic function. That means it can interact with different objects in different ways.

To define how it interacts with objects that have the attribute slots, we do the following.

print.slots <- function(x, ...) {
  slot_display(x)
}

For print to recognize that an object is of attribute slots and print it properly, we should assign that attribute to the play function.

play <- function() {
  symbols <- get_symbols()
  structure(score(symbols), symbols = symbols, class= 'slots')
}

class(play())

## [1] "slots"

Now for the big reveal, the complete, fully formatted, function!

play()

## 0 B DD
## $0

Aaaand didn’t win a dime. Oh well.

Conclusions

If you’ve made it through this blog post, I’m positive you would find the book ten times more informative. Garrett Goes much deeper into S3 attributes and dives into simulations, vectorized code, and much more.

His book is easy to read and will teach you quite a lot. Check it out sometime.

I’ll be switching gears to Python programming soon. I’ve picked up a few books on the fundamentals of Python, and I’m excited to get working on them as my semester progresses. check out my most recent Data Science Update for more information on that.

Until next time,

• Fisher