Created
September 9, 2012 06:38
-
-
Save cbare/3683016 to your computer and use it in GitHub Desktop.
Evaluate poker hands in R
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## Poker.R | |
## Evaluate poker hands | |
## | |
## by: Christopher Bare | |
############################################################ | |
## define suits and ranks | |
suits <- c('c','d','h','s') | |
ranks <- c(2:10,"J","K","Q","A") | |
suit_names <- c(c="clubs", d="diamonds", h="hearts", s="spades") | |
rank_names <- c(2:10, "Jack", "Queen", "King", "Ace") | |
new.deck <- function() { | |
deck <- list() | |
i <- 1 | |
for (r in 2:14) { | |
for (s in suits) { | |
deck[[i]] <- list(rank=r, suit=s) | |
class(deck[[i]]) <- 'card' | |
i <- i + 1 | |
} | |
} | |
class(deck) <- 'cardList' | |
return(deck) | |
} | |
deal <- function(deck,n) { | |
hand <- sample(deck,n) | |
hand <- hand[order(rank(hand),suit(hand), decreasing=TRUE)] | |
class(hand) <- "cardList" | |
return(hand) | |
} | |
is.card <- function(x) { | |
return(class(x)=='card') | |
} | |
suit <- function(c) { | |
if (is.card(c)) | |
c$suit | |
else if (is.list(c)) | |
sapply(c, suit) | |
} | |
rank <- function(c) { | |
if (is.card(c)) | |
c$rank | |
else if (is.list(c)) | |
sapply(c, rank) | |
} | |
toString.rank <- function(rank, short=TRUE, plural=FALSE) { | |
if (short) | |
result <- ranks[rank-1] | |
else | |
result <- rank_names[rank-1] | |
if (plural) | |
result <- paste(result,"s",sep="") | |
return(result) | |
} | |
as.rank <- function(s) { | |
sapply(s, function(x) which(ranks==toupper(x))) + 1 | |
} | |
parse_card <- function(string) { | |
card_strings <- strsplit(string,"\\s+")[[1]] | |
# extract rank and suit from each card into parallel vectors | |
card_ranks <- as.rank(sub( | |
pattern="(\\d+|[AKQJ])[cdhs]", | |
replacement="\\1", | |
card_strings, ignore.case=TRUE)) | |
card_suits <- sub( | |
pattern="(\\d+|[AKQJ])([cdhs])", | |
replacement="\\2", | |
card_strings, ignore.case=TRUE) | |
# zip together ranks and suits into cards | |
cards <- mapply(function(r,s) { | |
card <- list(rank=r,suit=s) | |
class(card) <- "card" | |
card | |
}, card_ranks, card_suits, SIMPLIFY=FALSE) | |
class(cards) <- "cardList" | |
return(cards) | |
} | |
toString.card <- function(card) { | |
paste(toString.rank(rank(card)), suit(card), sep="") | |
} | |
toString.cardList <- function(cards) { | |
paste(toString.card(cards), collapse=" ") | |
} | |
toString.pokerHandEvaluation <- function(ev) { | |
ev$string | |
} | |
print.cardList <- function(cards) { | |
cat("cards:\n") | |
print(toString.cardList(cards)) | |
} | |
print.card <- function(card) { | |
print(toString.card(card)) | |
} | |
print.pokerHandEvaluation <- function(ev) { | |
print(ev$string) | |
} | |
evaluate.hand <- function(hand) { | |
runs <- table(rank(hand)) | |
runs <- runs[order(runs, names(runs), decreasing=TRUE)] | |
run.ranks <- as.numeric(names(runs)) | |
flush.suit <- unique(suit(hand)) | |
is.flush <- (length(flush.suit) == 1) | |
highest.rank <- max(rank(hand)) | |
lowest.rank <- min(rank(hand)) | |
is.straight <- all(sort(rank(hand))==seq(lowest.rank, lowest.rank+4, 1)) | |
ev <-list(runs=runs, | |
run.ranks=run.ranks, | |
flush.suit=flush.suit, | |
is.flush=is.flush, | |
highest.rank=highest.rank, | |
lowest.rank=lowest.rank, | |
is.straight=is.straight) | |
class(ev) <- "pokerHandEvaluation" | |
## straight flush | |
if (is.straight && is.flush) { | |
ev$type <- "Straight flush" | |
if (lowest.rank==10) | |
ev$string <- paste("Royal flush in", suit_names[flush.suit]) | |
else | |
ev$string <- paste("Straight flush", | |
toString.rank(highest.rank), "high", | |
"in", suit_names[flush.suit]) | |
} | |
## four of a kind | |
else if (length(runs)==2 && all(runs==c(4,1))) { | |
ev$type <- "Four of a kind" | |
ev$string <- paste("4", toString.rank(run.ranks[1], plural=T)) | |
} | |
## full house | |
else if (length(runs)==2 && all(runs==c(3,2))) { | |
ev$type <- "Full house" | |
ev$string <- paste("Full house", | |
toString.rank(run.ranks[1], plural=T), "and", | |
toString.rank(run.ranks[2], plural=T)) | |
} | |
## flush | |
else if (is.flush) { | |
ev$type <- "Flush" | |
ev$string <- paste("Flush in", suit_names[flush.suit]) | |
} | |
## straight | |
else if (is.straight) { | |
ev$type <- "Straight" | |
ev$string <- paste("Straight", toString.rank(highest.rank), "high") | |
} | |
## three of a kind | |
else if (length(runs)==3 && all(runs==c(3,1,1))) { | |
ev$type <- "Three of a kind" | |
ev$string <- paste("3", toString.rank(run.ranks[1], plural=T)) | |
} | |
## two pairs | |
else if (length(runs)==3 && all(runs==c(2,2,1))) { | |
ev$type <- "Two pairs" | |
ev$string <- paste("two pairs", | |
toString.rank(run.ranks[1], plural=T), "and", | |
toString.rank(run.ranks[2], plural=T)) | |
} | |
## pair | |
else if (length(runs)==4 && all(runs==c(2,1,1,1))) { | |
ev$type <- "Pair" | |
ev$string <- paste("pair of", toString.rank(run.ranks[1], plural=T)) | |
} | |
else { | |
ev$type <- "Nothing" | |
ev$string <- paste("Nothing:", toString(hand)) | |
} | |
return(ev) | |
} | |
## deal a bunch of hands and evaluate them | |
count.hands <- function(n=10) { | |
d <- new.deck() | |
counts <- c(`Straight flush`=0, | |
`Four of a kind`=0, | |
`Full house`=0, | |
`Flush`=0, | |
`Straight`=0, | |
`Three of a kind`=0, | |
`Two pairs`=0, | |
`Pair`=0, | |
`Nothing`=0) | |
for (i in 1:n) { | |
hand <- deal(d,5) | |
ev <- evaluate.hand(hand) | |
counts[[ev$type]] <- counts[[ev$type]] + 1 | |
#print(paste(toString(hand), " - ", ev$string)) | |
} | |
return(counts) | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## different types of poker hands | |
hand_rf <- parse_card("Ks As 10s Qs Js") | |
hand_sf <- parse_card("4h 5h 6h 7h 8h") | |
hand_4 <- parse_card("4h 4d 7s 4s 4c") | |
hand_fh <- parse_card("Kh Js Ks Kd Jc") | |
hand_s <- parse_card("5h 7d 9s 6c 8") | |
hand_f <- parse_card("Kd 9d 8d 3d 6d") | |
hand_3 <- parse_card("Kd 7s 6s Kh Ks") | |
hand_2p <- parse_card("8h 9c 8d Kc 9h") | |
hand_2 <- parse_card("8h 3d 9c Qs 9h") | |
hand_nothing <- parse_card("3c 7d 10h Js Qh") | |
evaluate.hand(hand_nothing) | |
evaluate.hand(hand_2) | |
evaluate.hand(hand_2p) | |
evaluate.hand(hand_3) | |
evaluate.hand(hand_s) | |
evaluate.hand(hand_f) | |
evaluate.hand(hand_fh) | |
evaluate.hand(hand_4) | |
evaluate.hand(hand_sf) | |
evaluate.hand(hand_rf) | |
count.hands(1000) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Thanks for posting this! R newb here. I'm struggling to figure out how to apply the parse card function on a data frame of thousands of hands. I'm importing aggregate report full hand/board data from Pio. But I can only seem to use parse_card and evaluate.hand on the first row in the list or dataframe.
This correctly categorizes hand strength for this one flop/hand, but any thoughts on how apply this over many hands?