Creating a slot machine

My notes from Hands-On Programming with R, by Garret Grolemund

     

Create wheels

get_symbols <- function() {
  wheel <- c("DD", "7", "BBB", "BB", "B", "C", "0")
  sample(wheel, size = 3, replace = TRUE, 
    prob = c(0.03, 0.03, 0.06, 0.1, 0.25, 0.01, 0.52))
}

# test 
get_symbols()

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

     

Create score function

     

‘same’ object

symbols <- c("7", "7", "7")
symbols[1]

## [1] "7"

symbols[1] == symbols[2] && symbols[2] == symbols[3]

## [1] TRUE

all(symbols == symbols[1])

## [1] TRUE

length(unique(symbols) == 1)

## [1] 1

same <- symbols[1] == symbols[2] && symbols[2] == symbols[3]

     

create ‘bars’ object

symbols <- c("B", "BB", "BBB")
  
symbols %in% c("B", "BB", "BBB")

## [1] TRUE TRUE TRUE

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

## [1] TRUE TRUE TRUE

all(bars)

## [1] TRUE

     

payouts

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

##  DD 
## 100

payouts[symbols[1]]

##  DD 
## 100

unname(payouts[symbols[1]])

## [1] 100

     

cherries

symbols <- c("C", "DD", "C")

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

## [1] 2

c(0,2,5)[cherries + 1]

## [1] 5

     

Create score function

score <- function(symbols) {
  
  diamonds <- sum(symbols == "DD")
  cherries <- sum(symbols == "C")
  
  # identify case
  # since diamonds are wild, only nondiamonds 
  # matter for three of a kind and all bars
  slots <- symbols[symbols != "DD"]
  same <- length(unique(slots)) == 1
  bars <- slots %in% c("B", "BB", "BBB")

  # assign prize
  if (diamonds == 3) {
    prize <- 100
  } else if (same) {
    payouts <- c("7" = 80, "BBB" = 40, "BB" = 25,
      "B" = 10, "C" = 10, "0" = 0)
    prize <- unname(payouts[slots[1]])
  } else if (all(bars)) {
    prize <- 5
  } else if (cherries > 0) {
    # diamonds count as cherries
    # so long as there is one real cherry
    prize <- c(0, 2, 5)[cherries + diamonds + 1]
  } else {
    prize <- 0
  }
  
  # double for each diamond
  prize * 2^diamonds
}

     

Create play function

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

## [1] "B" "7" "C"

## [1] 2

     

Format output via S3

     

slot_display

# test 
one_play <- play()

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

one_play

## [1] 0

attr(one_play, "symbols") <- c("B", "0", "B")
attributes(one_play)

## $symbols
## [1] "B" "0" "B"

attr(one_play, "symbols")

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

one_play

## [1] 0
## attr(,"symbols")
## [1] "B" "0" "B"

     

update play function

# eliminating the print function

play <- function() {
  symbols <- get_symbols()
  prize <- score(symbols)
  attr(prize, "symbols") <- symbols
  prize
}
play()

## [1] 0
## attr(,"symbols")
## [1] "0" "0" "B"

# shortening the function
play <- function(){
  symbols <- get_symbols()
  structure(score(symbols), symbols = symbols)
}
play()

## [1] 0
## attr(,"symbols")
## [1] "7"   "0"   "BBB"

     

Format play function output

slot_display <- function(prize) {
  
  # extract symbols
  symbols <- attr(prize, "symbols")
  
  # collapse symbols into single string
  symbols <- paste(symbols, collapse = " ")
  
  # combine symbol with prize as a character string
  # \n is special escape sequence for a new line (i.e. return or enter)
  string <- paste(symbols, prize, sep = "\n$")

  # display character string in console without quotes
  cat(string)
}

slot_display(one_play)

## B 0 B
## $0

     

Method dispatch: class

class(one_play) <- "slots"

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

     

Final play function

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

## DD C 0
## $10

     

Calculating pay out rate

create combos with expand.grid

wheel <- c("DD", "7", "BBB", "BB", "B", "C", "0")
combos <- expand.grid(wheel, wheel, wheel, stringsAsFactors = FALSE)
head(combos)

##   Var1 Var2 Var3
## 1   DD   DD   DD
## 2    7   DD   DD
## 3  BBB   DD   DD
## 4   BB   DD   DD
## 5    B   DD   DD
## 6    C   DD   DD

     

create prob

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

     

create prob columns

combos$prob1 <- prob[combos$Var1]
combos$prob2 <- prob[combos$Var2]
combos$prob3 <- prob[combos$Var3]
head(combos)

##   Var1 Var2 Var3 prob1 prob2 prob3
## 1   DD   DD   DD  0.03  0.03  0.03
## 2    7   DD   DD  0.03  0.03  0.03
## 3  BBB   DD   DD  0.06  0.03  0.03
## 4   BB   DD   DD  0.10  0.03  0.03
## 5    B   DD   DD  0.25  0.03  0.03
## 6    C   DD   DD  0.01  0.03  0.03

combos$prob <- c(combos$prob1 * combos$prob2 * combos$prob3)
head(combos)

##   Var1 Var2 Var3 prob1 prob2 prob3     prob
## 1   DD   DD   DD  0.03  0.03  0.03 0.000027
## 2    7   DD   DD  0.03  0.03  0.03 0.000027
## 3  BBB   DD   DD  0.06  0.03  0.03 0.000054
## 4   BB   DD   DD  0.10  0.03  0.03 0.000090
## 5    B   DD   DD  0.25  0.03  0.03 0.000225
## 6    C   DD   DD  0.01  0.03  0.03 0.000009

sum(combos$prob)

## [1] 1

     

modify score function - DD = wild

score <- function(symbols) {
  
  diamonds <- sum(symbols == "DD")
  cherries <- sum(symbols == "C")
  
  # identify case
  # since diamonds are wild, only nondiamonds 
  # matter for three of a kind and all bars
  slots <- symbols[symbols != "DD"]
  same <- length(unique(slots)) == 1
  bars <- slots %in% c("B", "BB", "BBB")

  # assign prize
  if (diamonds == 3) {
    prize <- 100
  } else if (same) {
    payouts <- c("7" = 80, "BBB" = 40, "BB" = 25,
      "B" = 10, "C" = 10, "0" = 0)
    prize <- unname(payouts[slots[1]])
  } else if (all(bars)) {
    prize <- 5
  } else if (cherries > 0) {
    # diamonds count as cherries
    # so long as there is one real cherry
    prize <- c(0, 2, 5)[cherries + diamonds + 1]
  } else {
    prize <- 0
  }
  
  # double for each diamond
  prize * 2^diamonds
}

     

create for loop

for (i in 1:nrow(combos)) {
  symbols <- c(combos[i, 1], combos[i, 2], combos[i, 3])
  combos$prize[i] <- score(symbols)
}

sum(combos$prize * combos$prob)

## [1] 0.934356

     

head(combos) with DD as wild

head(combos, 20)

##    Var1 Var2 Var3 prob1 prob2 prob3     prob prize
## 1    DD   DD   DD  0.03  0.03  0.03 0.000027   800
## 2     7   DD   DD  0.03  0.03  0.03 0.000027   320
## 3   BBB   DD   DD  0.06  0.03  0.03 0.000054   160
## 4    BB   DD   DD  0.10  0.03  0.03 0.000090   100
## 5     B   DD   DD  0.25  0.03  0.03 0.000225    40
## 6     C   DD   DD  0.01  0.03  0.03 0.000009    40
## 7     0   DD   DD  0.52  0.03  0.03 0.000468     0
## 8    DD    7   DD  0.03  0.03  0.03 0.000027   320
## 9     7    7   DD  0.03  0.03  0.03 0.000027   160
## 10  BBB    7   DD  0.06  0.03  0.03 0.000054     0
## 11   BB    7   DD  0.10  0.03  0.03 0.000090     0
## 12    B    7   DD  0.25  0.03  0.03 0.000225     0
## 13    C    7   DD  0.01  0.03  0.03 0.000009    10
## 14    0    7   DD  0.52  0.03  0.03 0.000468     0
## 15   DD  BBB   DD  0.03  0.06  0.03 0.000054   160
## 16    7  BBB   DD  0.03  0.06  0.03 0.000054     0
## 17  BBB  BBB   DD  0.06  0.06  0.03 0.000108    80
## 18   BB  BBB   DD  0.10  0.06  0.03 0.000180    10
## 19    B  BBB   DD  0.25  0.06  0.03 0.000450    10
## 20    C  BBB   DD  0.01  0.06  0.03 0.000018    10