A Short R Tutorial

14 minute read

This is an experimental jupyter notebook written using IRkernel. The purpose of this notebook is threefolds: first, to document my progress with self-learning the R language; second, to test the functionality of the R kernel on jupyter; and third, to see if theconvert.sh shell script is capable of converting notebooks written in R to .md markdown format. The example codes in this notebook were borrowed from Hands on Programming with R by Garrett Grolemund.

Basic Operations and Assigment

1 + 1

2

die <- 1:6

ls()

‘die’

dice <- sample(die, 2)
dice
  1. 1
  2. 6

Creating Functions

roll <- function(){
    die <- 1:6
    dice <- sample(die, size = 2, replace = TRUE)
    sum(dice)
}

roll()

6

roll()

5

roll()

6

Creating Plots

library("ggplot2")
options(repr.plot.width=12, repr.plot.height=9)

x <- c(-1, -0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8, 1)
x
  1. -1
  2. -0.8
  3. -0.6
  4. -0.4
  5. -0.2
  6. 0
  7. 0.2
  8. 0.4
  9. 0.6
  10. 0.8
  11. 1
y <- x^3
y
  1. -1
  2. -0.512
  3. -0.216
  4. -0.064
  5. -0.008
  6. 0
  7. 0.008
  8. 0.064
  9. 0.216
  10. 0.512
  11. 1
qplot(x, y)


x2 <- c(1, 2, 2, 2, 3, 3)
qplot(x2, binwidth = 1)


replicate(10, roll())
  1. 4
  2. 10
  3. 9
  4. 7
  5. 5
  6. 7
  7. 9
  8. 9
  9. 7
  10. 8
rolls <- replicate(10000, roll())
qplot(rolls, binwidth = 1)

Object Types

typeof(die)

‘integer’

sum(die)

21

is.vector(die)

TRUE

sqrt(2)^2 - 2

4.44089209850063e-16

3 > 4

FALSE

typeof(F)

‘logical’

comp <- c(1 + 1i, 1 + 2i, 1 + 3i)
typeof(comp)

‘complex’

attributes(die)

NULL

Matrix and Data Frames

names(die) <- c("one", "two", "three", "four", "five", "six")
attributes(die)

$names

  1. 'one'
  2. 'two'
  3. 'three'
  4. 'four'
  5. 'five'
  6. 'six'
die
one
1
two
2
three
3
four
4
five
5
six
6
die + 1
one
2
two
3
three
4
four
5
five
6
six
7
dim(die) <- c(2, 3)
die
1 3 5
2 4 6 
m <- matrix(die, nrow = 2, byrow = TRUE)
m
1 2 3
4 5 6 
hand1 <- c("ace", "king", "queen", "jack", "ten", "spades", "spades", 
  "spades", "spades", "spades")
dim(hand1) <- c(5, 2)
hand1
ace spades
king spades
queen spades
jack spades
ten spades 
class(die)

‘matrix’

now <- Sys.time()
now

[1] "2020-01-07 06:14:50 KST"

gender <- factor(c("male", "female", "female", "male"))
gender
  1. male
  2. female
  3. female
  4. male
<summary style=display:list-item;cursor:pointer> Levels: </summary>
  1. 'female'
  2. 'male'
typeof(gender)

‘integer’

sum(c(TRUE, TRUE, FALSE, FALSE))

2

card <- list("ace", "hearts", 1)
card
  1. 'ace'
  2. 'hearts'
  3. 1
df <- data.frame(face = c("ace", "two", "six"),  
  suit = c("clubs", "clubs", "clubs"), value = c(1, 2, 3))
df
face suit value
ace clubs 1
two clubs 2
six clubs 3 
deck <- data.frame(
  face = c("king", "queen", "jack", "ten", "nine", "eight", "seven", "six",
    "five", "four", "three", "two", "ace", "king", "queen", "jack", "ten", 
    "nine", "eight", "seven", "six", "five", "four", "three", "two", "ace", 
    "king", "queen", "jack", "ten", "nine", "eight", "seven", "six", "five", 
    "four", "three", "two", "ace", "king", "queen", "jack", "ten", "nine", 
    "eight", "seven", "six", "five", "four", "three", "two", "ace"),  
  suit = c("spades", "spades", "spades", "spades", "spades", "spades", 
    "spades", "spades", "spades", "spades", "spades", "spades", "spades", 
    "clubs", "clubs", "clubs", "clubs", "clubs", "clubs", "clubs", "clubs", 
    "clubs", "clubs", "clubs", "clubs", "clubs", "diamonds", "diamonds", 
    "diamonds", "diamonds", "diamonds", "diamonds", "diamonds", "diamonds", 
    "diamonds", "diamonds", "diamonds", "diamonds", "diamonds", "hearts", 
    "hearts", "hearts", "hearts", "hearts", "hearts", "hearts", "hearts", 
    "hearts", "hearts", "hearts", "hearts", "hearts"), 
  value = c(13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 13, 12, 11, 10, 9, 8, 
    7, 6, 5, 4, 3, 2, 1, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 13, 12, 11, 
    10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
)

head(deck, 7)
face suit value
king spades 13
queen spades 12
jack spades 11
ten spades 10
nine spades 9
eight spades 8
seven spades 7 
deck[1, c(1, 2, 3)]
face suit value
king spades 13 
deck[-(2:52), 1:3]
face suit value
king spades 13 
deck[1, ]
face suit value
king spades 13 
deck[1, c(T, T, F)]
face suit
king spades 
deck[1, c("face", "suit")]
face suit
king spades 
deal <- function(cards) {
    cards[1, ]
}

deal(deck)
face suit value
king spades 13 
shuffle <- function(cards){
    random <- sample(1:52, size = 52)
    cards[random, ]
}

head(shuffle(deck))
facesuitvalue
6eight spades 8
5nine spades 9
39ace diamonds 1
3jack spades 11
34six diamonds 6
38two diamonds 2 
better_deal <- function(cards){
    card <- deal(shuffle(cards))
    card
}

better_deal(deck)
facesuitvalue
38two diamonds2 
better_deal(deck)
facesuitvalue
9five spades5

Dollar Sign Selection

deck$value
  1. 13
  2. 12
  3. 11
  4. 10
  5. 9
  6. 8
  7. 7
  8. 6
  9. 5
  10. 4
  11. 3
  12. 2
  13. 1
  14. 13
  15. 12
  16. 11
  17. 10
  18. 9
  19. 8
  20. 7
  21. 6
  22. 5
  23. 4
  24. 3
  25. 2
  26. 1
  27. 13
  28. 12
  29. 11
  30. 10
  31. 9
  32. 8
  33. 7
  34. 6
  35. 5
  36. 4
  37. 3
  38. 2
  39. 1
  40. 13
  41. 12
  42. 11
  43. 10
  44. 9
  45. 8
  46. 7
  47. 6
  48. 5
  49. 4
  50. 3
  51. 2
  52. 1
mean(deck$value)

7

deck2 <- deck

vec <- c(0, 0, 0, 0, 0, 0)
vec[1] <- 1000
vec
  1. 1000
  2. 0
  3. 0
  4. 0
  5. 0
  6. 0
vec[c(1, 3, 5)] <- c(1, 1, 1)
vec
  1. 1
  2. 0
  3. 1
  4. 0
  5. 1
  6. 0
vec[8] <- 0
vec
  1. 1
  2. 0
  3. 1
  4. 0
  5. 1
  6. 0
  7. <NA>
  8. 0
deck2$new <- 1:52
head(deck2)
face suit value new
king spades 13 1
queen spades 12 2
jack spades 11 3
ten spades 10 4
nine spades 9 5
eight spades 8 6 
deck2$new <- NULL
head(deck2)
face suit value
king spades 13
queen spades 12
jack spades 11
ten spades 10
nine spades 9
eight spades 8 
deck2$value[c(13, 26, 39, 52)]
  1. 1
  2. 1
  3. 1
  4. 1
deck2$value[c(13, 26, 39, 52)] <- 14
head(deck2, 13)
face suit value
king spades 13
queen spades 12
jack spades 11
ten spades 10
nine spades 9
eight spades 8
seven spades 7
six spades 6
five spades 5
four spades 4
three spades 3
two spades 2
ace spades 14 
1 > c(0, 1, 2)
  1. TRUE
  2. FALSE
  3. FALSE
typeof(1 > c(0, 1, 2))

‘logical’

c(1, 2, 3) == c(3, 2, 1)
  1. FALSE
  2. TRUE
  3. FALSE
c(1, 2, 3) %in% c(3, 4, 5)
  1. FALSE
  2. FALSE
  3. TRUE
sum(deck2$face == "ace")

4

deck3 <- shuffle(deck)
deck3$value[deck3$face == "ace"] <- 14
head(deck3)
facesuitvalue
33seven diamonds 7
32eight diamonds 8
42jack hearts 11
26ace clubs 14
48five hearts 5
36four diamonds 4 
deck4 <- deck
deck4$value <- 0
deck4$value[deck4$suit == "hearts"] <- 1

queenOfSpades <- deck4$face == "queen" & deck4$suit == "spades"
deck4$value[queenOfSpades] <- 13
deck4[queenOfSpades, ]
facesuitvalue
2queen spades13 
deck5 <- deck
facecard <- deck5$face %in% c("king", "queen", "jack")
deck5$value[facecard] <- 10
head(deck5, 13)
face suit value
king spades 10
queen spades 10
jack spades 10
ten spades 10
nine spades 9
eight spades 8
seven spades 7
six spades 6
five spades 5
four spades 4
three spades 3
two spades 2
ace spades 1

N/A Representation

1 + NA

<NA>

mean(c(NA, 1:50))

<NA>

mean(c(NA, 1:50), na.rm = TRUE)

25.5

vec <- c(1, 2, 3, NA)
is.na(vec)
  1. FALSE
  2. FALSE
  3. FALSE
  4. TRUE
deck5$value[deck5$face == "ace"] <- NA
head(deck5, 13)
face suit value
king spades 10
queen spades 10
jack spades 10
ten spades 10
nine spades 9
eight spades 8
seven spades 7
six spades 6
five spades 5
four spades 4
three spades 3
two spades 2
ace spades NA

Scope and Environments

library(pryr)
parenvs(all = TRUE)

Registered S3 method overwritten by 'pryr':
  method      from
  print.bytes Rcpp




   label                            name               
1  <environment: R_GlobalEnv>       ""                 
2  <environment: package:pryr>      "package:pryr"     
3  <environment: package:ggplot2>   "package:ggplot2"  
4  <environment: 0x7fcfdbe6cf88>    "jupyter:irkernel" 
5  <environment: package:stats>     "package:stats"    
6  <environment: package:graphics>  "package:graphics" 
7  <environment: package:grDevices> "package:grDevices"
8  <environment: package:utils>     "package:utils"    
9  <environment: package:datasets>  "package:datasets" 
10 <environment: package:methods>   "package:methods"  
11 <environment: 0x7fcfd9a813d0>    "Autoloads"        
12 <environment: base>              ""                 
13 <environment: R_EmptyEnv>        ""                 

as.environment("package:stats")

<environment: package:stats>
attr(,"name")
[1] "package:stats"
attr(,"path")
[1] "/Users/jaketae/opt/anaconda3/envs/R/lib/R/library/stats"

parent.env(globalenv())

<environment: package:pryr>
attr(,"name")
[1] "package:pryr"
attr(,"path")
[1] "/Users/jaketae/opt/anaconda3/envs/R/lib/R/library/pryr"

head(globalenv()$deck, 3)
face suit value
king spades 13
queen spades 12
jack spades 11 
assign("new", "Hello Global", envir = globalenv())
globalenv()$new

‘Hello Global’

environment()

<environment: R_GlobalEnv>

DECK <- deck

deal <- function() {
  card <- deck[1, ]
  assign("deck", deck[-1, ], envir = globalenv())
  card
}

shuffle <- function(){
  random <- sample(1:52, size = 52)
  assign("deck", DECK[random, ], envir = globalenv())
}

shuffle()
deal()
facesuitvalue
23four clubs4 
deal()
facesuitvalue
17ten clubs10

Closure

setup <- function(deck) {
  DECK <- deck

  DEAL <- function() {
    card <- deck[1, ]
    assign("deck", deck[-1, ], envir = parent.env(environment()))
    card
  }

  SHUFFLE <- function(){
    random <- sample(1:52, size = 52)
    assign("deck", DECK[random, ], envir = parent.env(environment()))
 }

 list(deal = DEAL, shuffle = SHUFFLE)
}

cards <- setup(deck)
deal <- cards$deal
shuffle <- cards$shuffle

shuffle()
deal()
facesuitvalue
15queenclubs12 
deal()
facesuitvalue
37three diamonds3 
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))
}
get_symbols()
  1. 'BBB'
  2. 'B'
  3. 'BBB'
get_symbols()
  1. '0'
  2. '0'
  3. '0'

If-Else Statements

positive_negative <- function(num){
    if (num < 0){
        result <- "Negative"
    }
    else{
        result <- "Positive"
    }
    result
}

positive_negative(10)

‘Positive’

positive_negative(-10)

‘Negative’

round_decimal <- function(num){
    decimal <- num - trunc(num)
    result <- 0
    if (decimal >= 0.5){
        result <- trunc(num) + 1
    }
    else{
        result <- trunc(num)
    }
    result
}

round_decimal(3.14)

3

round_decimal(1.9)

2

score <- function (symbols) {
  # identify case
  same <- symbols[1] == symbols[2] && symbols[2] == symbols[3]
  bars <- symbols %in% c("B", "BB", "BBB")
  
  # get prize
  if (same) {
    payouts <- c("DD" = 100, "7" = 80, "BBB" = 40, "BB" = 25, 
      "B" = 10, "C" = 10, "0" = 0)
    prize <- unname(payouts[symbols[1]])
  } else if (all(bars)) {
    prize <- 5
  } else {
    cherries <- sum(symbols == "C")
    prize <- c(0, 2, 5)[cherries + 1]
  }
  
  # adjust for diamonds
  diamonds <- sum(symbols == "DD")
  prize * 2 ^ diamonds
}

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

play()

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

0

play()

[1] "B"   "BBB" "B"

5

Class and Attributes

attributes(deck)
$names
  1. 'face'
  2. 'suit'
  3. 'value'
$row.names
  1. 47
  2. 42
  3. 9
  4. 12
  5. 5
  6. 32
  7. 26
  8. 49
  9. 27
  10. 31
  11. 18
  12. 52
  13. 19
  14. 1
  15. 46
  16. 25
  17. 13
  18. 50
  19. 45
  20. 24
  21. 3
  22. 15
  23. 44
  24. 28
  25. 8
  26. 30
  27. 36
  28. 38
  29. 21
  30. 48
  31. 11
  32. 6
  33. 14
  34. 41
  35. 34
  36. 39
  37. 35
  38. 16
  39. 22
  40. 51
  41. 20
  42. 2
  43. 33
  44. 40
  45. 10
  46. 4
  47. 37
  48. 43
  49. 7
  50. 29
$class
'data.frame'
levels(deck) <- c("level 1", "level 2", "level 3")
attributes(deck)
$names
  1. 'face'
  2. 'suit'
  3. 'value'
$row.names
  1. 47
  2. 42
  3. 9
  4. 12
  5. 5
  6. 32
  7. 26
  8. 49
  9. 27
  10. 31
  11. 18
  12. 52
  13. 19
  14. 1
  15. 46
  16. 25
  17. 13
  18. 50
  19. 45
  20. 24
  21. 3
  22. 15
  23. 44
  24. 28
  25. 8
  26. 30
  27. 36
  28. 38
  29. 21
  30. 48
  31. 11
  32. 6
  33. 14
  34. 41
  35. 34
  36. 39
  37. 35
  38. 16
  39. 22
  40. 51
  41. 20
  42. 2
  43. 33
  44. 40
  45. 10
  46. 4
  47. 37
  48. 43
  49. 7
  50. 29
$class
'data.frame'
$levels
  1. 'level 1'
  2. 'level 2'
  3. 'level 3'
one_play <- play()
attr(one_play, "symbols") <- c("B", "0", "B")
one_play

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

0

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

two_play <- play()
two_play

0

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(two_play)

B BB 0
$0

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

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

play()

BB B 0
$0

Expand Grid

rolls <- expand.grid(die, die)
head(rolls)
Var1 Var2
1 1
2 1
3 1
4 1
5 1
6 1 
rolls$value <- rolls$Var1 + rolls$Var2
head(rolls)
Var1 Var2 value
1 1 2
2 1 3
3 1 4
4 1 5
5 1 6
6 1 7 
prob <- c(1/8, 1/8, 1/8, 1/8, 1/8, 3/8)
rolls$prob = prob[rolls$Var1] * prob[rolls$Var2]
head(rolls)
Var1 Var2 value prob
1 1 2 0.015625
2 1 3 0.015625
3 1 4 0.015625
4 1 5 0.015625
5 1 6 0.015625
6 1 7 0.046875 
expected_val <- sum(rolls$value * rolls$prob)
expected_val

8.25

wheel <- c("DD", "7", "BBB", "BB", "B", "C", "0")
combos <- expand.grid(wheel, wheel, wheel, stringsAsFactors = FALSE)
head(combos)
Var1 Var2 Var3
DD DD DD
7 DD DD
BBB DD DD
BB DD DD
B DD DD
C DD DD 
prob <- c("DD" = 0.03, "7" = 0.03, "BBB" = 0.06, "BB" = 0.1, "B" = 0.25, "C" = 0.01, "0" = 0.52)
combos$prob <- prob[combos$Var1] * prob[combos$Var2] * prob[combos$Var3]
head(combos)
Var1 Var2 Var3 prob
DD DD DD 0.000027
7 DD DD 0.000027
BBB DD DD 0.000054
BB DD DD 0.000090
B DD DD 0.000225
C DD DD 0.000009 
sum(combos$prob)

1

For and While Loops

for (value in c("My", "first", "for", "loop")) {
  print(value)
}

[1] "My"
[1] "first"
[1] "for"
[1] "loop"

value

‘loop’

chars <- vector(length = 4)
words <- c("My", "fourth", "for", "loop")

for (i in 1:4) {
    chars[i] <- words[i]
}

chars
  1. 'My'
  2. 'fourth'
  3. 'for'
  4. 'loop'
length(chars)

4

combos$prize <- NA

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

head(combos)
Var1 Var2 Var3 prob prize
DD DD DD 0.000027 0.021600
7 DD DD 0.000027 0.000000
BBB DD DD 0.000054 0.000000
BB DD DD 0.000090 0.000000
B DD DD 0.000225 0.000000
C DD DD 0.000009 0.000072 
sum(combos$prize)

0.538014

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
}

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

sum(combos$prize)

0.934356

play_till_broke <- function(start_with) {
    n <- 0
    cash <- start_with
    while (cash > 0) {
        cash <- cash - 1 + play()
        n <- n + 1
    }
    n
}

play_till_broke(100)

373

Function Vectorization

# Unvectorized
abs_loop <- function(vec){
  for (i in 1:length(vec)) {
    if (vec[i] < 0) {
      vec[i] <- -vec[i]
    }
  }
  vec
}

# Vectorized
abs_vec <- function(vec){
    index <- vec < 0
    vec[index] <- -1 * vec[index]
    vec
}

long <- rep(c(-1, 1), 5000000)

system.time(abs_loop(long))

   user  system elapsed 
  0.599   0.017   0.620 

system.time(abs_vec(long))

   user  system elapsed 
  0.269   0.034   0.304 

change_vec <- function (vec) {
  vec[vec == "DD"] <- "joker"
  vec[vec == "C"] <- "ace"
  vec[vec == "7"] <- "king"
  vec[vec == "B"] <- "queen"
  vec[vec == "BB"] <- "jack"
  vec[vec == "BBB"] <- "ten"
  vec[vec == "0"] <- "nine"
  vec
}

# Lookup Tables
change_vec2 <- function(vec){
  tb <- c("DD" = "joker", "C" = "ace", "7" = "king", "B" = "queen", 
    "BB" = "jack", "BBB" = "ten", "0" = "nine")
  unname(tb[vec])
}

vec <- c("DD", "C", "7", "B", "BB", "BBB", "0")
many <- rep(vec, 1000000)

system.time(change_vec(many))

   user  system elapsed 
  0.518   0.035   0.555 

system.time(change_vec2(many))

   user  system elapsed 
  0.181   0.032   0.213 

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

get_many_symbols(3)
0 0 0
B 0 7
B 0 DD 
score_many <- function(symbols) {

  # Step 1: Assign base prize based on cherries and diamonds ---------
  ## Count the number of cherries and diamonds in each combination
  cherries <- rowSums(symbols == "C")
  diamonds <- rowSums(symbols == "DD") 
  
  ## Wild diamonds count as cherries
  prize <- c(0, 2, 5)[cherries + diamonds + 1]
  
  ## ...but not if there are zero real cherries 
  ### (cherries is coerced to FALSE where cherries == 0)
  prize[!cherries] <- 0
  
  # Step 2: Change prize for combinations that contain three of a kind 
  same <- symbols[, 1] == symbols[, 2] & 
    symbols[, 2] == symbols[, 3]
  payoffs <- c("DD" = 100, "7" = 80, "BBB" = 40, 
    "BB" = 25, "B" = 10, "C" = 10, "0" = 0)
  prize[same] <- payoffs[symbols[same, 1]]
  
  # Step 3: Change prize for combinations that contain all bars ------
  bars <- symbols == "B" | symbols ==  "BB" | symbols == "BBB"
  all_bars <- bars[, 1] & bars[, 2] & bars[, 3] & !same
  prize[all_bars] <- 5
  
  # Step 4: Handle wilds ---------------------------------------------
  
  ## combos with two diamonds
  two_wilds <- diamonds == 2

  ### Identify the nonwild symbol
  one <- two_wilds & symbols[, 1] != symbols[, 2] & 
    symbols[, 2] == symbols[, 3]
  two <- two_wilds & symbols[, 1] != symbols[, 2] & 
    symbols[, 1] == symbols[, 3]
  three <- two_wilds & symbols[, 1] == symbols[, 2] & 
    symbols[, 2] != symbols[, 3]
  
  ### Treat as three of a kind
  prize[one] <- payoffs[symbols[one, 1]]
  prize[two] <- payoffs[symbols[two, 2]]
  prize[three] <- payoffs[symbols[three, 3]]
  
  ## combos with one wild
  one_wild <- diamonds == 1
  
  ### Treat as all bars (if appropriate)
  wild_bars <- one_wild & (rowSums(bars) == 2)
  prize[wild_bars] <- 5
  
  ### Treat as three of a kind (if appropriate)
  one <- one_wild & symbols[, 1] == symbols[, 2]
  two <- one_wild & symbols[, 2] == symbols[, 3]
  three <- one_wild & symbols[, 3] == symbols[, 1]
  prize[one] <- payoffs[symbols[one, 1]]
  prize[two] <- payoffs[symbols[two, 2]]
  prize[three] <- payoffs[symbols[three, 3]]
 
  # Step 5: Double prize for every diamond in combo ------------------
  unname(prize * 2^diamonds)
  
}

play_many <- function(n) {
  symb_mat <- get_many_symbols(n = n)
  data.frame(w1 = symb_mat[,1], w2 = symb_mat[,2],
             w3 = symb_mat[,3], prize = score_many(symb_mat))
}

play_many(3)
w1 w2 w3 prize
7 B 0 0
B B BBB 5
DD BB B 10 
system.time(play_many(1000))

   user  system elapsed 
  0.005   0.000   0.005

You May Also Enjoy

LoRA

August 20 2023

I recently completed another summer internship at Meta (formerly Facebook). I was surprised to learn that one of the intern friends I met was an avid read...

Hacking Word Hunt

August 21 2022

Update: The code was modified with further optimizations. In particular, instead of checking the trie per every DFS call, we update the trie pointer along...

Glow-TTS

April 11 2022

Note: This blog post was completed as part of Yale’s CPSC 482: Current Topics in Applied Machine Learning.

Reflections and Expectations

December 27 2021

Last year, I wrote a blog post reflecting on the year 2020. Re-reading what I had written then was surprisingly insightful, particularly because I could see ...