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)


dfcorbin/pokersim documentation built on Nov. 13, 2019, 4:21 p.m.