poker

breed [cards card]
breed [players player]

cards-own [
  suit ; club, diamond, heart, spade
  number ; 1 to 13
]

players-own [
  money
  my_cards
  my_card_slot
  my_move_patch
  my_move ; check, bet, call, raise, fold
  current_bet
  betted?
]

globals [
  table_color
  seats
  card_seq
  player_seq
  community_cards
  flop_slot
  river_slot
  turn_slot
  big_blind
  small_blind
  pot_patch
  pot_money
  patch_display_money_to_call
  money_to_call
  current_round
  winners
  hand_rank
  #_round
]

to setup
  clear-all
  reset-ticks

  set hand_rank ["high card" "pair" "two pair" "three of a kind" "straight" "flush" "full house" "four of a kind" "straight flush" "royal flush"]
  set table_color 53
  init-table
  init-cards
  repeat num-players [init-1-player 100]

  set player_seq sort players
  set small_blind last but-last player_seq
  set big_blind last player_seq
  blinds-shift

  set winners no-turtles
end 

to shuffle-cards
  set card_seq (shuffle sort cards)
end 

to init-table
  ask patches with [ (abs pycor) < 10 and (abs pxcor) < 26 ][
    set pcolor table_color
  ]
  set seats (list patch -6 10 patch -18 10 patch -26 0  patch -18 -10 patch -6 -10 patch 6 -10 patch 18 -10 patch 26 0 patch 18 10 patch 6 10)
  set flop_slot (list patch -14 0 patch -10 0 patch -6 0)
  set turn_slot patch -2 0
  set river_slot patch 2 0
  set pot_patch patch 10 0
  set patch_display_money_to_call patch 10 -2
end 

to init-cards
  ask cards [die]
  ask players [
    set my_cards []
    set my_move 0
    update-player-status
  ]
  set community_cards []
  set current_round 0
  update-pot

  (foreach ["Club" "Diamond" "Heart" "Spade"] [ s ->
    (foreach (range 13) [ n ->
      crt 1 [
        set breed cards
        set heading 0
        set size 2
        set suit s
        set shape suit
        set color ifelse-value (suit = "Heart" or suit = "Diamond")[red][black]
        setxy -1 12
        set number n + 1
        set label (word (first s)  "/"  number)
      ]
    ])
  ])
  shuffle-cards
end 

to init-1-player [m]
  create-players 1 [
    set shape "square"
    set money m
    set color brown
    move-to item (count players - 1) seats
    let my_card_spot one-of neighbors4 with [pcolor = table_color]
    face my_card_spot
    set my_cards []
    set my_card_slot (list patch-left-and-ahead 30 2 patch-right-and-ahead 30 2 )
    set my_move_patch patch-ahead 4
    set betted? false
    set label (word "Player " who)
    update-player-status
  ]
end 



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
;
;
;
;
;
; HANDS RANKING PROCEDURES
;
; wrote in observer context
;
;
;
;
;
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to-report contend-of [hands]
  report map [c -> [list suit number] of c] sort hands
end 

to-report compare-players-hands [player1 player2]
  if (count (turtle-set [my_cards] of player1 community_cards) < 7 or
      count (turtle-set [my_cards] of player2 community_cards) < 7)[
    user-message "ERROR: not sufficient cards to compare"
    report "ERROR"
  ]
  let hand1 compute contend-of (turtle-set [my_cards] of player1 community_cards)
  let hand2 compute contend-of (turtle-set [my_cards] of player2 community_cards)

  let result ifelse-value (compare-hands hand1 hand2 = true) [
    "WIN"
  ][
;    ifelse-value (compare-hands hand2 hand1 = true) [
      "LOSS"
;    ][
;      "TIE"
;    ]
  ]

  if print-logs? [
    output-print (word player1 " hand: " hand1)
    output-print (word player2 " hand: " hand2)
    output-print (word ifelse-value (result = "WIN") [player1][player2] "WIN")
  ]
  report result
end 

to-report compare-hands [hand1 hand2]
  ifelse (position first hand1 hand_rank) != (position first hand2 hand_rank) [
    ; compare with different types
    report (position first hand1 hand_rank) > (position first hand2 hand_rank)
  ][; compare within same type, compare biggest card in descending order
    report ifelse-value ((first last hand1) != (first last hand2))[
      is-bigger-than (first last hand1) (first last hand2)
    ][
      ifelse-value ((item 1 last hand1) != (item 1 last hand2))[
        is-bigger-than (item 1 last hand1) (item 1 last hand2)
      ][
        ifelse-value ((item 2 last hand1) != (item 2 last hand2))[
          is-bigger-than (item 2 last hand1) (item 2 last hand2)
        ][
          ifelse-value ((item 3 last hand1) != (item 3 last hand2))[
            is-bigger-than (item 3 last hand1) (item 3 last hand2)
          ][
            ifelse-value ((item 4 last hand1) != (item 4 last hand2))[
              is-bigger-than (item 4 last hand1) (item 4 last hand2)
            ][
              false
            ]
          ]
        ]
      ]
    ]
  ]
end 

; test the compute procedure (the hand ranking calculator)
; with the content of "hand" input gadget at the interface

to-report hh
  report read-from-string hand
end 

to-report is-bigger-than [n1 n2]
  report (ifelse-value (n1 = 1)[14][n1]) > (ifelse-value (n2 = 1)[14][n2])
end 

to-report compute [a_hand]
  let r []
  ; high card
  let high_card_list find-high-cards a_hand
  set r (list "high card" sublist find-high-cards a_hand 0 5)

  ; pair, two pair, three of a kind
  let slist find-same a_hand
  if max slist = 2 [
    ifelse length filter [s -> s = 2] slist = 1 [
      let pairN 13 - (position 2 slist)
      let plist sublist (fput pairN fput pairN (remove pairN remove pairN high_card_list)) 0 5
      set r list "pair"  plist
    ][
      let pos1 (position 2 slist)
      let pos2 pos1 + 1 + position 2 ( sublist slist (pos1 + 1) 13 )
      let p1 13 - pos1
      let p2 13 - pos2
      set r (list "two pair" (list p1 p1 p2 p2
        max ( filter [n -> n != p1 and n != p2] high_card_list ) ) )
    ]
  ]

  if max slist = 3 [
    let t3 (13 - position 3 slist)
    set r list "three of a kind" sublist (sentence t3 t3 t3 filter [n -> n != t3] high_card_list ) 0 5
  ]

  ;straight
  let straight_list find-straight a_hand
  if member? 5 straight_list [
    let n (14 - position 5 reverse straight_list)
    set r list "straight" (range n (n - 5) -1)
  ]

  ; flush
  let flist find-flush a_hand
  let cardNumber []
  if last first flist >= 5 [
    let fclub first first flist
    set cardNumber sublist
            (sort-by [[?1 ?2] -> is-bigger-than ?1 ?2] map [? -> last ?] filter [c -> first c = fclub] a_hand)
        0 (1 + min (list 5 length flist))
    set r (list "flush" cardNumber)
  ]

  ; full house
  if max slist = 3 and member? 2 slist [
    let n1 (13 - position 3 slist)
    let n2 (13 - position 2 slist)
    set r (list "full house" (list n1 n1 n1 n2 n2))]

  ; four of a kind
  if max slist = 4 [
    let f 13 - position 4 slist
    set r (list "four of a kind" (list f f f f first (filter [n -> n != f] high_card_list )))
  ]

  ; straight flush
  if (last first flist >= 5) and member? 5 straight_list [
    let cnList find-straight-flush a_hand
    if member? 5 cnList [
      let pos (14 - position 5 reverse cnList)
      ifelse (pos = 14)[
        set r list "royal flush" (range pos (pos - 5) -1)
      ][
        set r list "straight flush" (range pos (pos - 5) -1)
      ]
    ]
  ]

  report r
end 

to-report find-straight [h]
  let seqlist map [? -> ifelse-value (member? ? map [c -> last c] h) [1][0] ] [1 2 3 4 5 6 7 8 9 10 11 12 13 1]
  report map [n -> sum sublist seqlist (n - 5) n ] [5 6 7 8 9 10 11 12 13 14]
end 

to-report find-flush [h]
  report sort-by [[c1 c2] ->
    (last c1) > (last c2)
  ] map [c -> (list c (length filter [hc -> first hc = c] h) ) ] ["Diamond" "Spade" "Club" "Heart"]
end 

to-report find-straight-flush [h]
  let flist find-flush h
  let cardNumber []
  let fclub first first flist
  set cardNumber (sort-by [[?1 ?2] -> ?1 > ?2] map [? -> last ?] filter [c -> first c = fclub] h)
  let seqlist map [? -> ifelse-value (member? ? cardNumber) [1][0] ] [1 2 3 4 5 6 7 8 9 10 11 12 13 1]
  report map [n -> sum sublist seqlist (n - 5) n ] [5 6 7 8 9 10 11 12 13 14]
end 

to-report find-same [h]
  report map [n -> length filter [c -> last c = n] h ] [13 12 11 10 9 8 7 6 5 4 3 2 1]
end 

to-report find-high-cards [h]
  report map [? -> last ?] sort-by [[c1 c2] -> is-bigger-than (last c1) (last c2)] h
end 



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
;
;
;
;
;
; DEALER PROCEDURES
;
; wrote in observer context
;
;
;
;
;
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to play-one-round
  set #_round #_round + 1
  init-cards
  deal ;"pre-flop"
  bet-round
  deal ;"the-flop"
  bet-round
  deal ;"the-turn"
  bet-round
  deal ;"the-river"
  bet-round
  winner-collect-the-money
  blinds-shift
end 


; card context, if card is on the green table

to-report dealt
  report pcolor = table_color
end 

to-report next_card
  report first filter [c -> [not dealt] of c] card_seq
end 

to deal
  ; deal-hole-cards
  ifelse current_round = 0 [
    set current_round "pre-flop"
    repeat 2 [
      foreach player_seq [ p ->
        ask first filter [c -> [not dealt] of c] card_seq [
          ask p [set my_cards lput myself my_cards]
          move-to one-of filter [s -> [not any? turtles-here] of s] [my_card_slot] of p
          if (print-logs?) [ output-print (word "card " (word suit number) " goes to " p) ]
    ] ] ]
  ][ ; deal flop cards
    ifelse current_round = "pre-flop"  [
      set current_round "the-flop"
      foreach [0 1 2][ n ->
        ask next_card [
          set community_cards lput self community_cards
          move-to item n flop_slot
          if (print-logs?) [ output-print (word "flop card " (word suit number)) ]
      ] ]
    ][ ;deal-the-turn
      ifelse current_round = "the-flop" [
        set current_round "the-turn"
        ask next_card [
          set community_cards lput self community_cards
          move-to turn_slot
          if (print-logs?) [ output-print (word "turn card " (word suit number)) ]
        ]
      ][
        ; deal-the-river
        if current_round = "the-turn" [
          set current_round "the-river"
          ask next_card [
            set community_cards lput self community_cards
            move-to river_slot
            if (print-logs?) [ output-print (word "river card " (word suit number)) ]
          ]
        ]
      ]
    ]
  ]
end 

to-report has-winner?
  report any? winners
end 

to-report alive_players
  report players with [my_move != "fold"]
end 

; To determin if current betting round is completed.

to-report current_betting_completed?
  report ifelse-value ( count alive_players with [betted?] = count alive_players)
  [ true ][ false ]
end 

; Betting continues until every player has
; either matched the bets made or folded (if no bets are made,
; the round is complete when every player has checked).
; When the betting round is completed, the next dealing/betting round begins,
; or the hand is complete.

to bet-until-check-or-win
  let bet_round 0
  let alive_player_seq filter [p -> [my_move] of p != "fold" and not [betted?] of p] player_seq

  while [ not current_betting_completed? ][
    if print-logs? [ output-print (word "bet round " bet_round) ]
    ; at pre-flop round, small blind and big blind drop chips
    if current_round = "pre-flop" and bet_round = 0 [
      blind-bet
      set alive_player_seq (remove big_blind (remove small_blind alive_player_seq))
    ]

    foreach alive_player_seq [ p ->  ask p [ bet ] ]

    set alive_player_seq filter [p -> [my_move] of p != "fold" and not [betted?] of p] player_seq
    set bet_round bet_round + 1
  ]
end 

to bet-round
  ;tick
  set money_to_call 0
  ; init alive players status
  ask alive_players [
    set betted? false
    set my_move 0
  ]

  ifelse has-winner? [
    if print-logs? [ output-print "There is a winner, game stop." ]
  ][
      ; this is the recursive betting round
    bet-until-check-or-win
    if count alive_players = 1 [ set winners alive_players ]
  ]
  gather-bets
  update-pot
end 

to hands-rank
  let playerRank sort-by [[p1 p2] -> compare-players-hands p1 p2 = "WIN"] alive_players
  let p0 first playerRank
  set winners (turtle-set winners p0)
  if print-logs? [ output-print word "ADD WINNER " p0 ]
  foreach but-first playerRank [ p ->
    if compare-players-hands p p0 != "LOSS" [
      set winners (turtle-set winners p)
      if print-logs? [ output-print word "ADD WINNER " p ]
    ]
    set p0 p
  ]
  if print-logs? [ output-print (word "WINNERS: " ( sort winners)) ]
end 

; cannot deal with all-in for now

to winner-collect-the-money
  if current_round = "the-river" [
    hands-rank
  ]
  ifelse any? winners [
    let reward pot_money / count winners
    ask winners [
      set money money + reward
      update-player-status
    ]
  ][

  ]

  set pot_money 0
  update-pot
  set winners no-turtles
end 

to-report total_money
  report sum [money] of players
end 

to-report total_bet
  report sum [current_bet] of players
end 

to gather-bets
  set pot_money pot_money + total_bet
  ask players [
    set money money - current_bet
    set current_bet 0 ]
end 

to update-pot
  ask pot_patch [set plabel (word "pot: " pot_money)]
end 

; make the players loop end with big blind

to update-player-seq
  set player_seq (sentence (filter [p -> [who] of p > [who] of big_blind] (sort players)) ( filter [p -> [who] of p <= [who] of big_blind] (sort players) ) )
end 

; shifting small blind and big blind

to blinds-shift
  ask small_blind [ ask patch-ahead -4 [set plabel "" ]]
  set small_blind big_blind
  set big_blind first player_seq
  ask small_blind [ ask patch-ahead -4 [set plabel "SB" ]]
  ask big_blind [ ask patch-ahead -4 [set plabel "BB" ]]
  update-player-seq
  ask players [update-player-status]
end 

to update-money-to-call
  if current_bet > money_to_call [ set money_to_call current_bet ]
  ask patch_display_money_to_call [ set plabel (word "money to call: " money_to_call)]

;  if money_to_call < max [current_bet] of players [
;    user-message "ERROR! money_to_call less than max betting"
;    stop
;  ]
end 

to-report contents-of [pole-cards]
  let card1 first pole-cards
  let card2 last pole-cards
  report (list [list suit number] of card1 [list suit number] of card2)
end 


;
; MONTE-CARLO DEALING
;
; record the win/loss rate for each combination of pole cards
;

to batch-dealing [n_rounds]
  if is-string? n_rounds [ set n_rounds read-from-string n_rounds]
  let dic_cards []
  let #_wins []
  let #_occur []
  repeat n_rounds [
    set #_round #_round + 1
    init-cards
    repeat 4 [deal]
    hands-rank
    ask players [
      ifelse member? (contents-of sort my_cards) dic_cards [
        let pos position (contents-of sort my_cards) dic_cards
        if member? self winners [
          set #_wins replace-item pos #_wins (1 + item pos #_wins)
        ]
        set #_occur replace-item pos #_occur (1 + item pos #_occur)
      ][
        set dic_cards lput (contents-of sort my_cards) dic_cards
        set #_wins lput (ifelse-value (member? self winners)[1][0] ) #_wins
        set #_occur lput 1 #_occur
      ]
    ]
    set winners no-turtles
  ]

  (foreach dic_cards #_wins #_occur [ [d n o] -> print (list d n o)])
end 





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
;
;
;
;
;
; PLAYER PROCEDURES
;
; wrote in player context
;
;
;
;
;
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to bet
  random-bet
  set betted? true
  update-money-to-call
  update-player-status
  if (print-logs?)[ output-print (word self ": " my_move " " ifelse-value (my_move != "fold")[current_bet][""] )]

  ; a raise move requires other alive players to make decisions again (call or re-raise)
  if my_move = "raise" or my_move = "bet" [
    ask other alive_players [ set betted? false ]
    update-player-status
  ]
end 

to blind-bet
  ask small_blind [ set current_bet blind / 2 set betted? true]
  ask big_blind   [ set current_bet blind set betted? true]
end 

to random-bet
  let myBet ifelse-value (money > 20)[random 20][random money]

  ifelse myBet <= money_to_call / 2 [
    ifelse current_bet >= money_to_call
    [ ;I'm big blind
      set my_move "check"
    ]
    [ ;fold
      set my_move "fold"
    ]
  ][
    ifelse (money_to_call > 0 and myBet / money_to_call < 1.5) [
      set my_move "call"
      set current_bet money_to_call
    ][
      set my_move ifelse-value (money_to_call = 0)["bet"] ["raise"]
      set current_bet myBet
    ]
  ]
end 

to update-player-status
  ifelse heading = 90 or heading = 270 [
    ask patch-at 0 1 [set plabel word "$" [money] of myself]
  ][
    ask patch-ahead -1 [set plabel word "$" [money] of myself]
  ]
  ask my_move_patch [set plabel [(word ifelse-value (my_move != 0) [my_move][""] ifelse-value (current_bet > 0) [word " " current_bet][""] )] of myself ]
  set color ifelse-value (my_move = "fold")[black][ifelse-value betted? [green][red]]
end