#' Score Games of Texas Hold'em
#'
#' @param games
#'
#' @return
#' @export
# CM NOTE: Want to try bit wise method:
# https://www.codeproject.com/Articles/569271/A-Poker-hand-analyzer-in-JavaScript-using-bit-math
# Need to find vectorized bit functions in R though (or make them?)
poker_hands <- c(
"Straight Flush", "Four of a Kind", "Full House", "Flush", "Straight", "Three of a Kind", "Two Pair", "Pair", "High Card"
)
#' @export
score_games <- function(games) {
UseMethod("score_games")
}
#' @export
score_games.data.frame <- function(games) {
# Initialize Results
n_hands <- nrow(games)
hand_rank <- rep.int(0, n_hands)
hand_score <- rep(0, n_hands)
# Pull cards
cards <- games[, grepl("card", colnames(games))]
# Pull Values/Suits
card_value <- pull_value(x = cards)
card_suits <- pull_suits(x = cards)
# Find Duplicates (Quads, Trips, and Pairs)
dup_cards <- find_duplicates(values = card_value, n_hands = n_hands)
# Find Straights
st_top <- find_straight(values = card_value, n_hands = n_hands)
# Find Flushes
fl_suit <- find_flush(suits = card_suits, n_hands = n_hands)
# Find Straight Flush
stfl_top <- find_straightflush(
suits = card_suits, values = card_value,
fl_suit = fl_suit, st_top = st_top,
n_hands = n_hands
)
# Score Straight Flushes
PickOut <- stfl_top != 0
hand_rank[PickOut] <- 1L
hand_score[PickOut] <- score_straightflush(top_card = stfl_top[PickOut])
unscored <- !PickOut
# Score Four of a Kinds
PickOut <- unscored & dup_cards[, 1] != 0
hand_rank[PickOut] <- 2L
hand_score[PickOut] <- score_quad(quad_card = dup_cards[PickOut, 1], values = card_value[PickOut, ])
unscored <- unscored & !PickOut
# Score Full-houses
PickOut <- unscored & dup_cards[, 2] != 0 & (dup_cards[, 3] != 0 | dup_cards[, 4] != 0)
hand_rank[PickOut] <- 3L
hand_score[PickOut] <- score_fullhouse(
trip_card = dup_cards[PickOut, 2],
# Pull the column that completes the full house (either second three of a kind or highest pair)
pair_card = dup_cards[cbind(which(PickOut), c(3, 4)[as.numeric(PickOut & dup_cards[, 4] != 0) + 1][PickOut])]
)
unscored <- unscored & !PickOut
# Score Flush
PickOut <- unscored & fl_suit != 0
hand_rank[PickOut] <- 4L
hand_score[PickOut] <- score_flush(
suit_card = fl_suit[PickOut],
suits = card_suits[PickOut, ],
values = card_value[PickOut, ]
)
unscored <- unscored & !PickOut
# Score Straight
PickOut <- unscored & st_top != 0
hand_rank[PickOut] <- 5L
hand_score[PickOut] <- score_straight(top_card = st_top[PickOut])
unscored <- unscored & !PickOut
# Score Three of a Kind
PickOut <- unscored & dup_cards[, 2] != 0
hand_rank[PickOut] <- 6L
hand_score[PickOut] <- score_trips(trip_card = dup_cards[PickOut, 2], values = card_value[PickOut, , drop = FALSE])
unscored <- unscored & !PickOut
# Score Two Pair
PickOut <- unscored & dup_cards[, 4] != 0 & dup_cards[, 5] != 0
hand_rank[PickOut] <- 7L
hand_score[PickOut] <- score_twopair(
pair_cards = dup_cards[PickOut, c(4, 5), drop = FALSE],
values = card_value[PickOut, , drop = FALSE]
)
unscored <- unscored & !PickOut
# Score Pair
PickOut <- unscored & dup_cards[, 4] != 0
hand_rank[PickOut] <- 8L
hand_score[PickOut] <- score_pair(pair_card = dup_cards[PickOut, 4], values = card_value[PickOut, , drop = FALSE])
unscored <- unscored & !PickOut
# Score High Card
hand_rank[unscored] <- 9L
hand_score[unscored] <- score_highcard(values = card_value[unscored, , drop = FALSE])
# Add hand types, scores, place, and winner info to games
games$hand_type <- factor(hand_rank, levels = 1:9, labels = poker_hands)
levels(games$hand_type) <- poker_hands
games$hand_score <- hand_score
games$hand_place <- ave(-games$hand_score, games$hand_id, FUN = function(x) rank(x, ties.method = "min"))
games$winner <- games$hand_place == 1
return(games)
}
#' @export
score_games.tbl_df <- function(games) {
# Initialize Results
flat_games <- games %>% unnest(cols = player)
n_hands <- nrow(flat_games)
# Pull Values/Suits
card_value <- flat_games %>% select(contains("card")) %>% pull_value()
card_suits <- flat_games %>% select(contains("card")) %>% pull_suits()
# Find Duplicates (Quads, Trips, and Pairs)
dup_cards <- card_value %>% find_duplicates()
# Find Straights
st_top <- card_value %>% find_straight()
# Find Flushes
fl_suit <- card_suits %>% find_flush()
# Find Straight Flush
stfl_top <- card_suits %>%
find_straightflush(
values = card_value,
fl_suit = fl_suit, st_top = st_top,
n_hands = n_hands
)
# Put final hand info back together
games <- flat_games %>%
select(hand_id, player_id, pocket_card1, pocket_card2) %>%
bind_cols(stfl_top = stfl_top, st_top = st_top, fl_suit = fl_suit, dup_cards) %>%
# Hand Type
mutate(
hand_type = case_when(
stfl_top != 0 ~ 1L, # Straight Flush
out_four != 0 ~ 2L, # Four of a Kind
out_three1 != 0 & (out_three2 != 0 | out_two1 != 0) ~ 3L, # Full House
fl_suit != 0 ~ 4L, # Flush
st_top != 0 ~ 5L, # Straight
out_three1 != 0 ~ 6L, # Three of a Kind
out_two1 != 0 & out_two2 != 0 ~ 7L, # Two Pair
out_two1 != 0 ~ 8L, # One Pair
TRUE ~ 9L # High Card
),
# Hand Score
hand_score = case_when(
hand_type == 1L ~ score_straightflush(top_card = stfl_top),
hand_type == 2L ~ score_quad(quad_card = out_four, values = as.matrix(card_value)),
hand_type == 3L & out_three2 != 0 ~ score_fullhouse(trip_card = out_three1, pair_card = out_three2),
hand_type == 3L & out_two1 != 0 ~ score_fullhouse(trip_card = out_three1, pair_card = out_two1),
hand_type == 4L ~ score_flush(suit_card = fl_suit, suits = as.matrix(card_suits), values = as.matrix(card_value)),
hand_type == 5L ~ score_straight(top_card = st_top),
hand_type == 6L ~ score_trips(trip_card = out_three1, values = as.matrix(card_value)),
hand_type == 7L ~ score_twopair(
pair_cards = as.matrix(.[, c("out_two1", "out_two2")]),
values = as.matrix(card_value)
),
hand_type == 8L ~ score_pair(pair_card = out_two1, values = as.matrix(card_value)),
hand_type == 9L ~ score_highcard(values = as.matrix(card_value))
),
hand_type = factor(hand_type, levels = 1:9, labels = poker_hands)
) %>%
select(hand_id, player_id, pocket_card1, pocket_card2, hand_type, hand_score) %>%
group_by(hand_id) %>%
mutate(
hand_place = rank(-hand_score, ties.method = "min"),
winner = hand_place == 1
) %>%
nest(player = !hand_id) %>%
left_join(games %>% select(!player), by = "hand_id") %>%
ungroup() %>%
new_TexasHoldEm_tidy()
return(games)
}
#' @export
score_games.data.table <- function(games) {
# Initialize Results
games <- copy(games)
n_hands <- nrow(games)
hand_rank <- rep.int(0, n_hands)
hand_score <- rep(0, n_hands)
# Pull cards
cards <- games[, .SD, .SDcols = grep("card", colnames(games), value = TRUE)]
# Pull Values/Suits
card_value <- pull_value(x = cards)
card_suits <- pull_suits(x = cards)
# Find Duplicates (Quads, Trips, and Pairs)
dup_cards <- find_duplicates(values = card_value, n_hands = n_hands)
# Find Straights
st_top <- find_straight(values = card_value, n_hands = n_hands)
# Find Flushes
fl_suit <- find_flush(suits = card_suits, n_hands = n_hands)
# Find Straight Flush
stfl_top <- find_straightflush(
suits = card_suits, values = card_value,
fl_suit = fl_suit, st_top = st_top,
n_hands = n_hands
)
# Add hand types, scores, place, and winner info to games
dup_cards <- as.matrix(dup_cards)
card_value <- as.matrix(card_value)
card_suits <- as.matrix(card_suits)
# Hand Type
games[, hand_type := factor(fcase(
stfl_top != 0 , 1L, # Straight Flush
dup_cards[, "out_four"] != 0 , 2L, # Four of a Kind
dup_cards[, "out_three1"] != 0 &
(dup_cards[, "out_three2"] != 0 |
dup_cards[, "out_two1"] != 0) , 3L, # Full House
fl_suit != 0 , 4L, # Flush
st_top != 0 , 5L, # Straight
dup_cards[, "out_three1"] != 0 , 6L, # Three of a Kind
dup_cards[, "out_two1"] != 0 &
dup_cards[, "out_two2"] != 0 , 7L, # Two Pair
dup_cards[, "out_two1"] != 0 , 8L, # One Pair
default = 9L # High Card
), levels = 1:9, labels = poker_hands)]
# Hand Score
games[, hand_score := fcase(
hand_type == "Straight Flush", score_straightflush(
top_card = stfl_top),
hand_type == "Four of a Kind", score_quad(
quad_card = dup_cards[, "out_four"], values = card_value),
hand_type == "Full House" & dup_cards[, "out_three2"] != 0, score_fullhouse(
trip_card = dup_cards[, "out_three1"], pair_card = dup_cards[, "out_three2"]),
hand_type == "Full House" & dup_cards[, "out_two1"] != 0, score_fullhouse(
trip_card = dup_cards[, "out_three1"], pair_card = dup_cards[, "out_two1"]),
hand_type == "Flush", score_flush(
suit_card = fl_suit, suits = card_suits, values = card_value),
hand_type == "Straight", score_straight(
top_card = st_top),
hand_type == "Three of a Kind", score_trips(
trip_card = dup_cards[, "out_three1"], values = card_value),
hand_type == "Two Pair", score_twopair(
pair_cards = dup_cards[, c("out_two1", "out_two2")], values = card_value),
hand_type == "Pair", score_pair(
pair_card = dup_cards[, "out_two1"], values = card_value),
hand_type == "High Card", score_highcard(
values = card_value),
default = NA
)]
# Hand Place
games[, hand_place := rank(-hand_score, ties.method = "min"), by = hand_id]
games[, winner := hand_place == 1]
return(games)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.