Poker Hand Evaluator Alpha 2 (upd 3/19)

mIRC Code

+ 0 likes

Please Register to submit score.

Average Score	8.8
Scores Submitted	4
Date Added	Mar 10, 2007
Last Updated	Mar 19, 2007
Tags	poker

Introduction

Alright, well here it is. Something I've been wanting to do for quite some time but never had the energy or motivation to get through. This is the beginning of hopefully my full script for online mIRC poker (not for real money, of course). Supply this alias with a "board" and an infinite number of "hole" hands, and it will tell you which hand wins and with what. It will also tell you if there is a split. Usage is $handeval(<board>,<hand1>,..,[handN]) Example: $handeval(JhTd8cAs3c,9hQs,8d8h) -- Evaluates two hands using the provided board. The first hand will win with a Queen high straight against the second hand's 3 of a kind 8's. You may also call this alias as a command, and it will echo the result to the active window. I AM LOOKING FOR PEOPLE TO HELP ME IMPROVE THIS SNIPPET AND HELP CODE ADDITIONAL PARTS OF THE REST OF THE SCRIPT. PM ME IF YOU ARE INTERESTED! Edit 3/10/07 - Full House collision problem fixed. Flush evaluation improved. Edit 3/19/07 - Kicker functionality added.

Grab the Code

alias sortwithintok {
  var %n = $remove($1,s,c,d,h)
  var %s1 = $sorttok(%n,45,nr)
  var %x = 1,%y = $numtok(%s1,45)
  var %nl = $1
  while ( %x <= %y ) {
    if ( $istok(%nl,$gettok(%s1,%x,45) $+ s,45) && !$istok(%s1,$gettok(%s1,%x,45) $+ s,45) ) {
      %s1 = $reptok(%s1,$gettok(%s1,%x,45),$gettok(%s1,%x,45) $+ s,1,45)
    }
    elseif ( $istok(%nl,$gettok(%s1,%x,45) $+ c,45) && !$istok(%s1,$gettok(%s1,%x,45) $+ c,45) ) {
      %s1 = $reptok(%s1,$gettok(%s1,%x,45),$gettok(%s1,%x,45) $+ c,1,45)
    }
    elseif ( $istok(%nl,$gettok(%s1,%x,45) $+ h,45) && !$istok(%s1,$gettok(%s1,%x,45) $+ h,45) ) {
      %s1 = $reptok(%s1,$gettok(%s1,%x,45),$gettok(%s1,%x,45) $+ h,1,45)
    }
    elseif ( $istok(%nl,$gettok(%s1,%x,45) $+ d,45) && !$istok(%s1,$gettok(%s1,%x,45) $+ d,45) ) {
      %s1 = $reptok(%s1,$gettok(%s1,%x,45),$gettok(%s1,%x,45) $+ d,1,45)
    }
    inc %x 1
  }
  return %s1
}
alias handeval {
  ;SYNTAX: $handeval(board,hand1,..,handN)
  ;Returns a value of 1-N for the best poker hand
  ;If there is a split, it will separate the hands that split with spaces, ex 1 3 4 for a 3-way split between hands 1, 3, and 4.

;LEFTOFF- Problem with unnecessary report of a kicker with two pair.
  ;Unextensively tested
  ;Demo command- //echo f $handeval(AhTsJd7c9d,Ac7s,AdQh).debug

var %board = $1
  tokenize 32 $replace($2-,t,10,j,11,q,12,k,13,a,14)

var %x = $0
  set -l %tt
  while ( %x ) {
    set -l %hp [ $+ [ %x ] ] $replace(%board $+ $ [ $+ [ %x ] ],t,10,j,11,q,12,k,13,a,14)
    .echo -q $regsub(%hp [ $+ [ %x ] ],/([a-z])/ig,\1 $+ -,%tt)
    set -l %hp [ $+ [ %x ] ] $sortwithintok(%tt)
    set -l %hv [ $+ [ %x ] ] $replace(%hp [ $+ [ %x ] ],s,-,c,-,d,-,h,-)
    %hv [ $+ [ %x ] ] = $sorttok(%hv [ $+ [ %x ] ],45,nr)
    set -l %hs [ $+ [ %x ] ] $replace(%hp [ $+ [ %x ] ],1,-,2,-,3,-,4,-,5,-,6,-,7,-,8,-,9,-,0,-)
    %hs [ $+ [ %x ] ] = $sorttok(%hs [ $+ [ %x ] ],45)
    dec %x
  }
  if ( $prop == debug ) {
    echo hp1 %hp1
    echo hp2 %hp2
    echo hs1 %hs1
    echo hs2 %hs2
    echo hv1 %hv1
    echo hv2 %hv2
    echo --
  }
  var %x = 1,%b = 0,%v = 0,%s = 0
  set -l %tv
  set -l %slist
  set -l %fhv
  set -l %tfhv
  set -l %fl1
  set -l %fl2
  set -l %fl3
  set -l %fl4
  ;B values
  ;8 = Straight Flush
  ;7 = Quads
  ;6 = Boat
  ;5 = Flush
  ;4 = Straight
  ;3 = Trips
  ;2 = Two Pair
  ;1 = Pair
  ;0 = Highcard
  while ( %x <= $0 ) {
    if ( $issf(%hp [ $+ [ %x ] ]) ) {
      %tv = $v1
      if ( %b == 8 ) {
        if ( %tv > %v ) {
          %v = %tv
          %s = 1
          set -l %fhv
          set -l %slist %x
          inc %x
          continue
        }
        elseif ( %tv == %v ) {
          inc %s
          %slist = $addtok(%slist,%x,32)
          set -l %fhv
          inc %x
          continue
        }
        else {
          %s = 1
          set -l %slist %x
          set -l %fhv
          inc %x
          continue
        }
      }
      else {
        %b = 8
        %v = %tv
        %s = 1
        set -l %slist %x
      }
      inc %x
      continue
    }
    if ( %b > 7 ) {
      inc %x
      continue
    }
    var %d = $dupfinder(%hv [ $+ [ %x ] ])
    if ( $wildtok(%d,*:4,1,32) ) {
      %tv = $gettok($wildtok(%d,*:4,1,32),1,58)
      if ( %b == 7 ) {
        if ( %tv > %v ) {
          %v = %tv
          %s = 1
          set -l %fhv
          set -l %slist %x
          inc %x
          continue
        }
        elseif ( %tv == %v ) {
          inc %s
          %slist = $addtok(%slist,%x,32)
        }
      }
      else {
        %b = 7
        %s = 1
        %v = %tv
        set -l %slist %x
        set -l %fhv
      }
      inc %x
      continue
    }
    if ( %b > 6 ) {
      inc %x
      continue
    }
    if ( $numtok(%d,32) > 1 ) {
      if ( $wildtok(%d,*:2,0,32) && $wildtok(%d,*:3,0,32) ) || ( $wildtok(%d,*:3,0,32) > 1 ) {
        if ( $wildtok(%d,*:2,1,32) ) {
          %tv = $gettok($wildtok(%d,*:3,1,32),1,58)
          %tfhv = $gettok($wildtok(%d,*:2,1,32),1,58)
        }
        else {
          if ( $gettok($wildtok(%d,*:3,1,32),1,58) > $gettok($wildtok(%d,*:3,2,32),1,58) ) {
            %tv = $gettok($wildtok(%d,*:3,1,32),1,58)
            %tfhv = $gettok($wildtok(%d,*:3,2,32),1,58)
          }
          else {
            %tv = $gettok($wildtok(%d,*:3,2,32),1,58)
            %tfhv = $gettok($wildtok(%d,*:3,1,32),1,58)
          }
        }
        if ( %b == 6 ) {
          if ( %tv > %v ) {
            %v = %tv
            %fhv = %tfhv
          }
          elseif ( %tv == %v ) {
            if ( %fhv < $gettok($wildtok(%d,*:2,1,32),1,58) ) {
              %v = %tv
              %s = 1
              set -l %slist %x
              inc %x
              continue
              %fhv = %tfhv
            }
            elseif ( %fhv == $gettok($wildtok(%d,*:2,1,32),1,58) ) {
              inc %s
              %slist = $addtok(%slist,%x,32)
            }
          }
          else {
            inc %x
            continue
          }
        }
        else {
          %b = 6
          %v = %tv
          %s = 1
          set -l %slist %x
          %fhv = %tfhv
          inc %x
          continue
        }
      }
    }
    if ( %b > 5 ) {
      inc %x
      continue
    }
    if ( $isflush(%hs [ $+ [ %x ] ]) ) {
      set -l %asdf $v1
      %tv = $hcs(%hp [ $+ [ %x ] ],%asdf)
      var %z = 1
      while ( %z <= 4 ) {
        set -l %tfl [ $+ [ %z ] ] $hcs($deltok(%hp [ $+ [ %x ] ],1- %z,45),%asdf)
        if ( %tfl [ $+ [ %z ] ] > %fl [ $+ [ %z ] ] ) {
          var %iw = 1
        }
        elseif ( %tfl [ $+ [ %z ] ] < %fl [ $+ [ %z ] ] ) {
          var %icl = 1
        }
        inc %z
      }
      if ( %b == 5 ) {
        if ( %tv == %v ) {
          if ( %iw ) {
            %v = %tv
            %fl1 = %tfl1
            %fl2 = %tfl2
            %fl3 = %tfl3
            %fl4 = %tfl4
            %s = 1
            set -l %slist %x
            inc %x
            continue
          }
          elseif ( %icl ) {
            inc %x
            continue
          }
          else {
            inc %s
            set -l %slist $addtok(%slist,%x,32)
            inc %x
            continue
          }
        }
        elseif ( %tv > %v ) {
          %v = %tv
          %fl1 = %tfl1
          %fl2 = %tfl2
          %fl3 = %tfl3
          %fl4 = %tfl4
          %s = 1
          set -l %slist %x
          inc %x
          continue
        }
        else {
          inc %x
          continue
        }
      }
      else {
        %b = 5
        %v = %tv
        %fl1 = %tfl1
        %fl2 = %tfl2
        %fl3 = %tfl3
        %fl4 = %tfl4
        %s = 1
        set -l %slist %x
        inc %x
        continue
      }
    }
    if ( %b > 4 ) {
      inc %x
      continue
    }
    if ( $isstraight(%hv [ $+ [ %x ] ]) ) {
      %tv = $v1
      if ( %b == 4 ) {
        if ( %tv > %v ) {
          %v = %tv
          %s = 1
          set -l %slist %x
          inc %x
          continue
        }
        elseif ( %tv == %v ) {
          inc %s
          %slist = $addtok(%slist,%x,32)
          inc %x
          continue
        }
        else {
          inc %x
          continue
        }
      }
      else {
        %b = 4
        %v = %tv
        %s = 1
        set -l %slist %x
        inc %x
        continue
      }
    }
    if ( %b > 3 ) {
      inc %x
      continue
    }
    if ( $wildtok(%d,*:3,1,32) ) {
      %tv = $gettok($v1,1,58)
      if ( %b == 3 ) {
        if ( %tv > %v ) {
          %v = %tv
          %s = 1
          set -l %slist %x
          inc %x
          continue
        }
        elseif ( %tv == %v ) {
          inc %s
          %slist = $addtok(%slist,%x,32)
          inc %x
          continue
        }
        else {
          inc %x
          continue
        }
      }
      else {
        %b = 3
        %s = 1
        %v = %tv
        set -l %slist %x
        inc %x
        continue
      }
    }
    if ( %b > 2 ) {
      inc %x
      continue
    }
    if ( $numtok(%d,32) > 1 ) {
      if ( $wildtok(%d,*:2,0,32) == 2 ) {
        %tv = $gettok($iif($wildtok(%d,*:2,1,32) < $wildtok(%d,*:2,2,32),$wildtok(%d,*:2,1,32),$wildtok(%d,*:2,2,32)),1,58)
        %tfhv = $gettok($iif($wildtok(%d,*:2,1,32) > $wildtok(%d,*:2,2,32),$wildtok(%d,*:2,1,32),$wildtok(%d,*:2,2,32)),1,58)
        if ( %b == 2 ) {
          if ( %tv > %v ) {
            %v = %tv
            %fhv = %tfhv
            %s = 1
            set -l %slist %x
            inc %x
            continue
          }
          elseif ( %tv == %v ) {
            if ( %tfhv > %fhv ) {
              %v = %tv
              %fhv = %tfhv
              %s = 1
              set -l %slist %x
              inc %x
              continue
            }
            elseif ( %tfhv == %fhv ) {
              inc %s
              %slist = $addtok(%slist,%x,32)
            }
          }
          else {
            inc %x
            continue
          }
        }
        else {
          %b = 2
          %v = %tv
          %fhv = %tfhv
          %s = 1
          set -l %slist %x
          inc %x
          continue
        }
      }
    }
    if ( %b > 1 ) {
      inc %x
      continue
    }
    if ( $gettok(%d,1,58) >= %v && $gettok(%d,1,58) != 0 ) {
      if ( %b == 1 ) {
        if ( $gettok(%d,1,58) > %v ) {
          %v = $gettok(%d,1,58)
          %s = 1
          set -l %slist %x
        }
        else {
          inc %s
          %slist = $addtok(%slist,%x,32)
        }
        inc %x
        continue
      }
      %b = 1
      %s = 1
      set -l %slist %x
      %v = $gettok(%d,1,58)
      inc %x
      continue
    }
    if ( %b > 0 ) {
      inc %x
      continue
    }
    %tv = $gettok(%hv [ $+ [ %x ] ],1,45)
    var %z = 2
    while ( %z <= 7 ) {
      set -l %tfl [ $+ [ %z ] ] $gettok(%hv [ $+ [ %x ] ],%z,45)
      if ( %tfl [ $+ [ %z ] ] > %fl [ $+ [ $calc(%z -1) ] ] ) && ( !%iw ) {
        var %iw = %tfl [ $+ [ %z ] ]
      }
      elseif ( %tfl [ $+ [ %z ] ] < %fl [ $+ [ $calc(%z -1) ] ] ) && ( !%icl ) {
        var %icl = %fl [ $+ [ $calc(%z -1) ] ]
      }
      inc %z
    }
    if ( %tv > %v ) {
      %v = %tv
      %fl1 = %tfl2
      %fl2 = %tfl3
      %fl3 = %tfl4
      %fl4 = %tfl5
      %s = 1
      set -l %slist %x
      inc %x 1
      continue
    }
    elseif ( %tv == %v ) {
      if ( %iw ) {
        var %kicker = %iw
        %v = %tv
        %fl1 = %tfl1
        %fl2 = %tfl2
        %fl3 = %tfl3
        %fl4 = %tfl4
        %s = 1
        set -l %slist %x
        inc %x
        continue
      }
      elseif ( %icl ) {
        var %kicker = %icl
        inc %x
        continue
      }
      else {
        inc %s
        set -l %slist $addtok(%slist,%x,32)
        inc %x
        continue
      }
      inc %s
      %slist = $addtok(%slist,%x,32)
      inc %x 1
      continue
    }
    inc %x 1
  }
  if ( %s > 1 ) {
    var %x = %s,%upd = 0,%chgd = 0
    var %fl1 = %v
    set -l %fl2
    set -l %fl3
    set -l %fl4
    set -l %fl5
    while ( %x ) {
      var %z = 1
      while ( %z <= 5 ) {
        set -l %tfl [ $+ [ %z ] ] $gettok(%hv [ $+ [ %x ] ],%z,45)
        ;Good debugging echo for problems with kicker determination and split pot evaluation
        ;echo x %x it %z fl %fl [ $+ [ %z ] ] tfl %tfl [ $+ [ %z ] ]
        if ( %fl [ $+ [ %z ] ] < %tfl [ $+ [ %z ] ] ) || ( !%fl [ $+ [ %z ] ] ) {
          if ( !%fl [ $+ [ %z ] ] ) {
            %fl [ $+ [ %z ] ] = %tfl [ $+ [ %z ] ]
          }
          else {
            var %slist = %x
            var %chgd = 1
            var %upd = %tfl [ $+ [ %z ] ]
            %s = 1
          }
        }
        elseif ( %fl [ $+ [ %z ] ] > %tfl [ $+ [ %z ] ] ) && ( !%chgd ) {
          dec %s
          var %slist = $deltok(%slist,%x,32)
          var %kicker = %fl [ $+ [ %z ] ]
          break
        }
        elseif ( %chgd ) {
          inc %s
          var %slist = $addtok(%slist,%x,32)
        }
        if ( %upd ) {
          var %kicker = %upd
          %fl1 = %tfl1
          %fl2 = %tfl2
          %fl3 = %tfl3
          %fl4 = %tfl4
          %fl5 = %tfl5
        }
        var %upd = 0
        set -l %chgd
        inc %z
      }
      dec %x
    }
  }
  $iif($isid,return,echo -a) $iif(%s > 1,%s $+ -way split between hands numbers,Winner is hand number) $replace(%slist,$chr(32),$chr(44)) with $replace(%b,0,Highcard,1,Pair,2,TwoPair,3,Trips,4,Straight,5,Flush,6,FullHouse,7,Quads,8,StraightFlush) $replace(%v,10,Ten,11,Jack,12,Queen,13,King,14,Ace) $iif(%fhv,over $replace(%fhv,10,Tens,11,Jacks,12,Queens,13,Kings,14,Aces)) $iif(%kicker,- $replace(%kicker,10,Ten,11,Jack,12,Queen,13,King,14,Ace) kicker)
  return
}
;Format- Winners WinnerList Hand Highcard NextHighCard Kicker
;Winners is the number of winners (more than 1 indicates a split pot)
;WinnerList is a comma separated list of the winners (there will only be one value unless there's a split)
;Hand will be in the format of %b - See above notes
;NextHighCard is only used for Full Houses and Two Pairs.  It will be 0 if the winning hand was not a Full House or Two Pair.
;Kicker may or may not have a value
return %s %slist %b %v $iif(%fhv,%fhv,0) %kicker
}
alias dupfinder {
;SYNTAX: $dupfinder(text)
;text should be in %hvX format
;Returns sets of duplicates or 0 if there are no duplicates (used for finding pair, two pair, 3 of a kind, full house, 4 of a kind)
;Return format is value:duplicates where value is the "card" and duplicates is the number of duplicates found
;One or two sets of duplicates may be returned.  If it's two, they are space separated
;Ex if it returns 9:3 5:2 this indicates a full house with 3 nines and 2 fives

var %x = 1,%h = 99
var %asdf = $calc($len($remove($1,1,2,3,4,5,6,7,8,9,0)) +1)
set -l %l
set -l %m
while ( %x <= %asdf ) {
  if ( !$wildtok(%l,$gettok($1,%x,45) $+ :*,0,32) ) {
    %l = $addtok(%l,$gettok($1,%x,45),32) $+ :1
  }
  else {
    var %a = $wildtok(%l,$gettok($1,%x,45) $+ :*,1,32)
    var %l = $reptok(%l,%a,$gettok(%a,1,58) $+ : $+ $calc($gettok(%a,2,58) +1),1,32)
    var %m = $iif($istok(%m,%a,32),$reptok(%m,%a,$gettok(%a,1,58) $+ : $+ $calc($gettok(%a,2,58) +1),1,32),$addtok(%m,$gettok(%a,1,58) $+ : $+ $calc($gettok(%a,2,58) +1),32))
    if ( $gettok(%a,1,58) < %h ) %h = $gettok(%a,1,58)
  }
  inc %x
}
if ( $numtok(%m,32) > 2 ) {
  %m = $remtok(%m,$wildtok(%m,%h $+ :*,1,32),32)
}
return $iif(%m,%m,0)
}
alias isstraight {
;SYNTAX: $isstraight(text)
;Text should be in %hvX format
;NOTE- Text *MUST* be sorted descendingly!
;Returns highest card of the straight or 0 if there is no straight

var %x = 1
set -l %v
set -l %c
while ( %x <= $numtok($1,45) ) {
  if ( $gettok($1,%x,45) == 14 ) set -l %ha 1
  if ( $gettok($1,%x,45) == %v ) {
    inc %x
    continue
  }
  if ( $gettok($1,%x,45) == $calc(%v -1) ) {
    if ( %ha ) && ( %c == 3 ) && ( $gettok($1,%x,45) == 2 ) {
      %v = 2
      %c = 5
      break
    }
    inc %c
    if ( %c == 5 ) break
    dec %v
  }
  else {
    %c = 1
    %v = $gettok($1,%x,45)
  }
  inc %x
}
return $iif(%c == 5,$calc(%v +3),0)
}
alias isflush {
;Returns suit character (s,h,d,c) of a flush if there is one
;If there is no flush returns 0
;Should be formatted in %hsX

var %x = 1,%asdf = $calc($len($remove($1,s,c,d,h)) +1)
var %c = 0
var %h = 0
var %s = 0
var %d = 0
while ( %x <= %asdf ) {
  inc % [ $+ [ $gettok($1,%x,45) ] ]
  inc %x
}
if ( %c >= 5 ) return c
elseif ( %h >= 5 ) return h
elseif ( %s >= 5 ) return s
elseif ( %d >= 5 ) return d
else return 0
}
alias issf {
;Returns high card of a straight flush if there is one
;Returns 0 if there is no straight flush
;Should be formatted as %hpX

var %a = $isstraight($remove($1,s,c,d,h))
var %b = $isflush($remove($1,0,1,2,3,4,5,6,7,8,9))
if ( !%a ) || ( !%b ) {
  return 0
}
var %x = 1,%s = 0
while ( %x > 5 ) {
  if ( !$findtok($1,$calc(%a - %s) $+ %b,0,45) ) {
    return 0
    break
  }
  inc %s
  dec %x
}
inc %s
return %a
}
alias hcs {
;Syntax: $hcs(text,suit)
;Returns the highest card of a particular suit in a hand
;Used to find a flush's high card.
;Text should be formatted as hpX

var %x = 1,%h = 0
while ( %x <= $numtok($1,45) ) {
  if ( $2 !isin $gettok($1,%x,45) ) {
    inc %x
    continue
  }
  elseif ( $remove($gettok($1,%x,45),s,h,d,c) > %h ) { 
    %h = $remove($gettok($1,%x,45),s,h,d,c)
  }
  inc %x
}
return %h
}

Comments

(1) RSS

Go to Bottom

Pass

Comments: 45

mIRC Snippet: Poker Hand Evaluator Alpha 2 (upd 3/19)
Posted on Mar 10, 2007 12:56 pm

Great, original idea, LIQUID_NiTrO! This snippet has the potential to be a great game. Seeing snippets like this is rare around here lately.

LIQUID_NiTrO

		Full-Time Pimp /root
Last seen: Aug 13, 2008 Profile Friends (3) Snippets (17) Comments Received (80) Comments Submitted (113) Forum Posts (1066)

My Snippet Tags

Contact

Add to Friends

Send Private Message

AOL AIM:

Friends (3)

Yoinx

Hawkee

View All