Poker hand analyser: Difference between revisions

Content added Content deleted
m (used more consistent indentations in the task's preamble.)
m (→‎{{header|REXX}}: added/changed comments, simplified the function.)
Line 1,759: Line 1,759:
2x 2h 3h 4h 5h Error: invalid suit x in 2x</pre>
2x 2h 3h 4h 5h Error: invalid suit x in 2x</pre>


===version 2===
===version 2 with suit glyphs===
This REXX version supports:
This REXX version supports:
* upper/lower/mixed case for suits and pips
::* &nbsp; upper/lower/mixed case for suits and pips
* allows commas or blanks for card separation
::* &nbsp; allows commas or blanks for card separation
* alternate names for a aces and tens
::* &nbsp; alternate names for aces and tens
* alphabetic letters for suits and/or glyphs
::* &nbsp; alphabetic letters for suits and/or glyphs
* specification of number of cards in a hand
::* &nbsp; specification of number of cards in a hand
* the dealt hands can be in a file &nbsp; (blank lines are ignored)
::* &nbsp; the dealt hands can be in a file &nbsp; (blank lines are ignored)
* dealt hands in the file can have comments after a semicolon (''';''')
::* &nbsp; dealt hands in the file can have comments after a semicolon (''';''')
<lang rexx>/*REXX program analyzes an N-card poker hand, displays what the hand is.*/
<lang rexx>/*REXX program analyzes an N-card poker hand, and displays what the poker hand is. */
parse arg iFID .; if iFID=='' then iFID='POKERHAN.DAT'
parse arg iFID .; if iFID=='' | iFID=="," then iFID='POKERHAN.DAT'
/* [↓] read the poker hands dealt*/
/* [↓] read the poker hands dealt. */
do while lines(iFID)\==0; ox=linein(iFID); if ox='' then iterate
do while lines(iFID)\==0; ox=linein(iFID); if ox='' then iterate
say right(ox,max(30,length(ox))) ' ◄─── ' analyze(ox)
say right(ox, max(30, length(ox) ) ) ' ◄─── ' analyze(ox)
end /*while*/ /* [↑] analyze/validate the hand.*/
end /*while*/ /* [↑] analyze/validate the poker hand*/
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────ANALYZE subroutine──────────────────*/
analyze: procedure; arg x ';',mc; hand=translate(x,'♥♦♣♠1',"HDCSA,")
analyze: procedure; arg x ';',mc; hand=translate(x, '♥♦♣♠1', "HDCSA,")
kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0,13); pips=run
kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0 ,13); pips=run
if mc=='' then mc=5; n=words(hand); if n\==mc then return 'invalid'
if mc=='' then mc=5; n=words(hand); if n\==mc then return 'invalid'
/* [↓] PIP can be 1 or 2 chars.*/
/* [↓] PIP can be 1 or 2 characters.*/
do j=1 for n; _=word(hand,j); pip=left(_,length(_)-1); ws=right(_,1)
do j=1 for n; _=word(hand, j) /*obtain a card from the dealt hand. */
if pip==10 then pip='T' /*allow alternate form for a TEN.*/
pip=left(_, length(_)-1); ws=right(_, 1) /*obtain the card's pip; get the suit.*/
if pip==10 then pip='T' /*allow an alternate form for a "TEN". */
@._=@._+1; #=pos(pip,123456789TJQK) /*bump card ctr, get pip index*/
@._=@._+1; #=pos(pip, 123456789TJQK) /*bump the card counter, get pip index.*/
if pos(ws,"♥♣♦♠")==0 | #==0 | @._\==1 then return 'invalid'
if pos(ws, "♥♣♦♠")==0 | #==0 | @._\==1 then return 'invalid'
suit.ws=suit.ws+1; flush=max(flush,suit.ws); run=overlay(.,run,#)
suit.ws=suit.ws+1; flush=max(flush,suit.ws) /*count suits for a flush; find # suits*/
_=substr(pips,#,1)+1; pips=overlay(_,pips, #); kinds=max(kinds,_)
run=overlay(.,run,#); _=substr(pips,#,1)+1 /*convert run to series of dots. */
⚫
end /*i*/ /*keep track of N-of-a-kind. [↑] */
pips=overlay(_,pips,#); kinds=max(kinds,_) /*convert certain pips to their number.*/
⚫
end /*i*/ /* [↑] keep track of N-of-a-kind. */


pairs=countstr(2,pips) /*count #pairs (2s in PIPS)*/
pairs=countstr(2, pips) /*count number of pairs (2s in PIPS).*/
straight=pos(....., run||left(run,1))\==0 /*RUN contains a straight?*/
straight=pos(....., run || left(run, 1))\==0 /*does the RUN contains a straight? */
if flush==5 & straight then return 'straight-flush'
select
when flush==5 & straight then return 'straight-flush'
if kinds==4 then return 'four-of-a-kind'
when kinds==4 then return 'four-of-a-kind'
if kinds==3 & pairs==1 then return 'full-house'
when kinds==3 & pairs==1 then return 'full-house'
if flush==5 then return 'flush'
when flush==5 then return 'flush'
if straight then return 'straight'
when straight then return 'straight'
if kinds==3 then return 'three-of-a-kind'
when kinds==3 then return 'three-of-a-kind'
if kinds==2 & pairs==2 then return 'two-pair'
when kinds==2 & pairs==2 then return 'two-pair'
if kinds==2 then return 'one-pair'
when kinds==2 then return 'one-pair'
return 'high-card'</lang>
⚫
otherwise return 'high-card'
end /*select*/</lang>
Programming note: some older REXXes don't have the '''countstr''' BIF, so that REXX statement (above, line 21) can be replaced with:
Programming note: some older REXXes don't have the '''countstr''' BIF, so that REXX statement (above, line 21) can be replaced with:
<lang rexx>pairs=13-length(space(translate(pips,,2),0)) /*count # of 2's in PIPS.*/</lang>
<lang rexx>pairs=13-length(space(translate(pips,,2),0)) /*count # of 2's in PIPS.*/</lang>
Line 1,818: Line 1,818:
ah 2h 3h 4h
ah 2h 3h 4h
</pre>
</pre>
{{out}} using the (above) input file:
'''output''' &nbsp; when using the (above) input file:
<pre>
<pre>
2♥ 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind
2♥ 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind
Line 1,833: Line 1,833:
</pre>
</pre>


===version 3 (with jokers)===
===version 3 with suit glyphs and jokers===
This REXX version has three additional features:
This REXX version has three additional features:
* "invalid" hands have additional diagnostic information
::* &nbsp; "invalid" hands have additional diagnostic information
* supports up to two ''jokers''
::* &nbsp; supports up to two ''jokers''
* the ''joker'' card may be abbreviated (and in upper/lower/mixed case)
::* &nbsp; the ''joker'' card may be abbreviated (and can be in upper/lower/mixed case)
<lang rexx>/*REXX program analyzes an N-card poker hand, displays what the hand is.*/
<lang rexx>/*REXX program analyzes an N-card poker hand, and displays what the poker hand is, */
/*─────────────────────────────── poker hands may contain up to 2 jokers*/
/*──────────────────────────────────────────── poker hands may contain up to two jokers.*/
parse arg iFID .; if iFID=='' then iFID='POKERHAJ.DAT'
parse arg iFID .; if iFID=='' | iFID=="," then iFID='POKERHAN.DAT'
/* [↓] read the poker hands dealt*/
/* [↓] read the poker hands dealt. */
do while lines(iFID)\==0; ox=linein(iFID); if ox='' then iterate
do while lines(iFID)\==0; ox=linein(iFID); if ox='' then iterate
say right(ox,max(30,length(ox))) ' ◄─── ' analyze(ox)
say right(ox, max(30, length(ox) ) ) ' ◄─── ' analyze(ox)
end /*while*/ /* [↑] analyze/validate the hand.*/
end /*while*/ /* [↑] analyze/validate the poker hand*/
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────ANALYZE subroutine──────────────────*/
analyze: procedure; arg x ';',mc; hand=translate(x,'♥♦♣♠1',"HDCSA,")
analyze: procedure; arg x ';',mc; hand=translate(x, '♥♦♣♠1', "HDCSA,")
kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0,13); pips=run
kinds=0; suit.=0; flush=0; pairs=0; @.=0; run=copies(0 ,13); pips=run
if mc=='' then mc=5; n=words(hand) /*N is the # of cards in hand.*/
if mc=='' then mc=5; n=words(hand) /*N is the number of cards in hand. */
if n\==mc then return 'invalid number of cards, must be' mc
if n\==mc then return 'invalid number of cards, must be' mc
/* [↓] PIP can be 1 or 2 chars.*/
/* [↓] the PIP can be 1 or 2 chars. */
do j=1 for n; _=word(hand,j); pip=left(_,length(_)-1); ws=right(_,1)
do j=1 for n; _=word(hand,j) /*obtain a card from the dealt hand. */
if pip==10 then pip='T' /*allow alternate form for a TEN*/
pip=left(_, length(_)-1); ws=right(_, 1) /*obtain card's pip; obtain card's suit*/
if abbrev('JOKER',_,1) then _="JK" /*allow altername forms of JOKER*/
if pip==10 then pip='T' /*allow alternate form for a TEN pip.*/
if abbrev('JOKER',_,1) then _="JK" /*allow altername forms of JOKER names.*/
@._=@._+1; #=pos(pip,123456789TJQK) /*bump card ctr, get pip index*/
@._=@._+1; #=pos(pip,123456789TJQK) /*bump card counter, get the pip index.*/
if _=='JK' then do
if @.j>2 then return 'invalid, too many jokers'
if _=='JK' then do; if @.j>2 then return 'invalid, too many jokers'
iterate
iterate
end
end
if pos(ws,"♥♣♦♠")==0 then return 'invalid suit in card:' _
if pos(ws, "♥♣♦♠")==0 then return 'invalid suit in card:' _
if #==0 then return 'invalid pip in card:' _
if #==0 then return 'invalid pip in card:' _
if @._\==1 then return 'invalid, duplicate card:' _
if @._\==1 then return 'invalid, duplicate card:' _
suit.ws=suit.ws+1; flush=max(flush,suit.ws); run=overlay(.,run,#)
suit.ws=suit.ws+1; flush=max(flush,suit.ws) /*count suits for a flush; find # suits*/
_=substr(pips,#,1)+1; pips=overlay(_,pips, #); kinds=max(kinds,_)
run=overlay(.,run,#); _=substr(pips,#,1)+1 /*convert run to series of dots. */
pips=overlay(_,pips,#); kinds=max(kinds,_) /*convert certain pips to their number.*/
end /*i*/ /*keep track of N-of-a-kind. [↑] */
⚫
end /*i*/ /* [↑] keep track of N-of-a-kind. */


run=run || left(run,1) /*Ace can be high or low. */
run=run || left(run, 1) /*An ace can be high -or- low. */
jok=@.jk; kinds=kinds+jok; flush=flush+jok /*N-of-a-kind, joker adjust*/
jok=@.jk; kinds=kinds+jok; flush=flush+jok /*N─of─a─kind; adjustments for jokers.*/
straight= pos(..... , run)\==0 |, /*RUN contains a straight? */
straight= pos(..... , run)\==0 |, /*does the RUN contain a straight? */
(pos(.... , run)\==0 & jok>=1) |, /* " " " " */
(pos(.... , run)\==0 & jok>=1) |, /* " " " " " " */
(pos(..0.. , run)\==0 & jok>=1) |, /* " " " " */
(pos(..0.. , run)\==0 & jok>=1) |, /* " " " " " " */
(pos(...0. , run)\==0 & jok>=1) |, /* " " " " */
(pos(...0. , run)\==0 & jok>=1) |, /* " " " " " " */
(pos(.0... , run)\==0 & jok>=1) |, /* " " " " */
(pos(.0... , run)\==0 & jok>=1) |, /* " " " " " " */
(pos(... , run)\==0 & jok>=2) |, /* " " " " */
(pos(... , run)\==0 & jok>=2) |, /* " " " " " " */
(pos(..0. , run)\==0 & jok>=2) |, /* " " " " */
(pos(..0. , run)\==0 & jok>=2) |, /* " " " " " " */
(pos(.0.. , run)\==0 & jok>=2) |, /* " " " " */
(pos(.0.. , run)\==0 & jok>=2) |, /* " " " " " " */
(pos(.00.. , run)\==0 & jok>=2) |, /* " " " " */
(pos(.00.. , run)\==0 & jok>=2) |, /* " " " " " " */
(pos(..00. , run)\==0 & jok>=2) |, /* " " " " */
(pos(..00. , run)\==0 & jok>=2) |, /* " " " " " " */
(pos(.0.0. , run)\==0 & jok>=2) /* " " " " */
(pos(.0.0. , run)\==0 & jok>=2) /* " " " " " " */
pairs=countstr(2,pips) /*count #pairs (2s in PIPS)*/
pairs=countstr(2, pips) /*count number of pairs (2s in PIPS). */
if jok\==0 then pairs=pairs-1 /*adjust #pairs with jokers*/
if jok\==0 then pairs=pairs-1 /*adjust number of pairs with jokers. */
select
if kinds>=5 then return 'five-of-a-kind'
when kinds>=5 then return 'five-of-a-kind'
if flush>=5 & straight then return 'straight-flush'
when flush>=5 & straight then return 'straight-flush'
if kinds>=4 then return 'four-of-a-kind'
when kinds>=4 then return 'four-of-a-kind'
if kinds>=3 & pairs>=1 then return 'full-house'
when kinds>=3 & pairs>=1 then return 'full-house'
if flush>=5 then return 'flush'
when flush>=5 then return 'flush'
if straight then return 'straight'
when straight then return 'straight'
if kinds>=3 then return 'three-of-a-kind'
when kinds>=3 then return 'three-of-a-kind'
if kinds==2 & pairs==2 then return 'two-pair'
when kinds==2 & pairs==2 then return 'two-pair'
if kinds==2 then return 'one-pair'
when kinds==2 then return 'one-pair'
return 'high-card'</lang>
when kinds==2 then return 'one-pair'
otherwise return 'high-card'
end /*select*/</lang>
Programming note: the method used for analyzing hands that contain jokers are limited to a maximum of two jokers.
Programming note: the method used for analyzing hands that contain jokers are limited to a maximum of two jokers.
A different methodology would be needed for a generic number of jokers (and/or wild cards [such as deuces and one-eyed jacks]).
<br>A different methodology would be needed for a generic number of jokers (and/or wild cards [such as deuces and one-eyed jacks]).


'''input file''':
'''input file''':
Line 1,924: Line 1,922:
J♥ Q♦ K♠ A♠ jok
J♥ Q♦ K♠ A♠ jok
</pre>
</pre>
{{out}} using the (above) input file:
'''output''' &nbsp; when using the (above) input file:
<pre>
<pre>
joker 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind
joker 2♦ 2♠ k♠ q♦ ◄─── three-of-a-kind
Retrieved from "https://rosettacode.org/wiki/Poker_hand_analyser"