knitr::opts_chunk$set(echo = TRUE)
rankings <- 10:1 names(rankings) <- c("High Card","Pair", "Two Pair", "Three of a kind", "Straight", "Flush", "Full House", "Four of a kind ", "Straight Flush") suit <- 1:4 names(suit) <- c("Spades", "Clubs", "Hearts", "Diamonds") library(methods) setClass("card", slots = c( suit = "character", value = "numeric" ) ) setClass("deck", slots = c( withdrawn = "list" ) ) new_deck <- function(){ deck <- new("deck", withdrawn = list()) return(deck) } new_card <- function(){ new("card", suit = names(suit)[rdunif(1,1,4)], value = rdunif(1,1,13)) } library(purrr) new_cards <- function(n,deck){ if (n > 52-length(deck@withdrawn)) return("Not enough cards remaining in the deck") cards <- c() count <- 0 while (count<n){ newcard <- new_card() if (exists(paste(newcard@value,newcard@suit),where = deck@withdrawn)){ next } count = count +1 cards <- c(cards, newcard) names(cards)[count] <- paste(newcard@value,newcard@suit) deck@withdrawn <- c(deck@withdrawn, newcard) names(deck@withdrawn)[length(deck@withdrawn)] <- paste(newcard@value,newcard@suit) } return(c(cards, "deck" = deck)) } setClass("player", slots = c( hand="list", bet = "numeric" ) )
We now write a function preflop_deal()
which will deal the cards for a specificied number of players.
preflop_deal <- function(n){ deck <- new_deck() players <- list() for (i in 1:n){ player <- new("player", hand = new_cards(2,deck), bet = 0 ) deck <- player@hand[3] player@hand <- player@hand[-3] players <- c(players,player) } names(players) <- paste("Player", 1:n) return(c(players,deck)) }
When attempting to run this function, the system returns an error "Error in new_cards(2, deck) : trying to get slot "withdrawn" from an object of a basic class ("list") with no slots" . The debugging tool debug()
reveals that the problem occurs AFTER the first iteration when we attempt to generate a new player object. Since the change after the first iteration is that the deck has been updated, we focus our attention in this area.
preflop_deal <- function(n){ deck <- new_deck() players <- list() for (i in 1:n){ player <- new("player", hand = new_cards(2,deck), bet = 0 ) deck <- player@hand$deck player@hand <- player@hand[-3] players <- c(players,player) } names(players) <- paste("Player", 1:n) return(c(players,deck)) }
input_action <- function(players,turn,pot=0,bets,skip){ n <- length(players) print(paste("Pot:",pot)) print(paste("Player",turn,"to act.")) print(names(players[[turn]]@hand)) names(bets) <- paste("Player",1:n) print(bets) action <- readline(prompt="Action: ") if (action == "fold"){ pot <- pot + as.numeric(bets[turn]) bets[turn] <- 0 skip[turn] <- TRUE } else if (as.numeric(action) + bets[turn] >= max(bets)){ bets[turn] <- bets[turn] + as.numeric(action) } else{ print("Non-valid action. Player Folded") pot <- pot + as.numeric(bets[turn]) bets[turn] <- 0 skip[turn] <- TRUE } return(c(pot,skip,bets)) }
bet_round <- function(players,start=1,pot=0,bets,skip,action = input_action){ n <- length(players) turn <- start - 1 while (sum(bets/(max(bets)))%%(n-sum(skip)) != 0){ turn <- (turn + 1) %% n if (turn == 0) turn <-n if(skip[turn]) next input <- action(players,turn,pot,bets,skip) pot <- input[1] skip <- as.logical(input[2:(n+1)]) bets <- input[(n+2):length(input)] } pot <- pot + sum(bets) if(sum(skip) == n-1){ turn <- (turn + 1)%%n if (turn == 0) turn <- n print(paste("Player",turn,"wins")) } print(paste("Pot:",pot)) return(pot) }
players <- preflop_deal(4)[-5] bets <- c(0,0,1,2) skip <- rep(FALSE,4) bet_round(players,bets=bets,skip=skip)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.