poker

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,StraightFlu sh) $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
}