Rosetta Code

Poker hand analyser: Difference between revisions

Page Discussion

Poker hand analyser (view source)

Revision as of 13:11, 8 June 2024

25,876 bytes added ,  27 days ago
Added XPL0 example.
(add RPL)
(Added XPL0 example.)
 
(6 intermediate revisions by 5 users not shown)
Line 177:
QC TC 7C 6C 4C: flush
</pre>
 
=={{header|Ada}}==
 
{{works with|GNAT Ada 2022}}
 
<syntaxhighlight lang="ada">
pragma Ada_2022;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Containers.Generic_Constrained_Array_Sort;
with Ada.Text_IO; use Ada.Text_IO;
 
procedure Poker is
 
type Face_T is (two, three, four, five, six, seven, eight, nine, t, j, q, k, a);
for Face_T use (2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14);
type Suit_T is (C, D, H, S);
type Card_T is record
Face : Face_T;
Suit : Suit_T;
end record;
 
subtype Hand_Index is Natural range 1 .. 5;
type Hand_T is array (Hand_Index) of Card_T;
type Test_Hand_Arr is array (Positive range <>) of Hand_T;
type Pip_Counter_T is array (Face_T range Face_T'Range) of Natural;
 
Pip_Counts : Pip_Counter_T := [others => 0];
 
Test_Hands : Test_Hand_Arr := [
1 => [(two, H), (two, D), (two, C), (k, S), (q, D)],
2 => [(two, H), (five, H), (seven, D), (eight, C), (nine, S)],
3 => [(a, H), (two, D), (three, C), (four, C), (five, D)],
4 => [(two, H), (three, H), (two, D), (three, C), (three, D)],
5 => [(two, H), (seven, H), (two, D), (three, C), (three, D)],
6 => [(two, H), (seven, H), (seven, D), (seven, C), (seven, S)],
7 => [(t, H), (j, H), (q, H), (k, H), (a, H)],
8 => [(four, H), (four, S), (k, S), (five, D), (t, S)],
9 => [(q, C), (t, C), (seven, C), (six, C), (q, C)]
];
 
function "<" (L, R : Card_T) return Boolean is
begin
if L.Face = R.Face then
return L.Suit < R.Suit;
else
return L.Face < R.Face;
end if;
end "<";
 
procedure Sort_Hand is new Ada.Containers.Generic_Constrained_Array_Sort (Hand_Index, Card_T, Hand_T);
 
procedure Print_Hand (Hand : Hand_T) is
begin
for Card of Hand loop
if Card.Face < j then
Put (Face_T'Enum_Rep (Card.Face)'Image);
else
Put (" " & To_Lower (Card.Face'Img));
end if;
Put (To_Lower (Card.Suit'Img));
end loop;
end Print_Hand;
 
function Is_Invalid (Hand : Hand_T) return Boolean is
begin
for Ix in 2 .. 5 loop
if Face_T'Pos (Hand (Ix).Face) = Face_T'Pos (Hand (Ix - 1).Face) and then
Hand (Ix).Suit = Hand (Ix - 1).Suit
then
return True;
end if;
end loop;
return False;
end Is_Invalid;
 
function Is_Flush (Hand : Hand_T) return Boolean is
begin
for Ix in 2 .. 5 loop
if Hand (Ix).Suit /= Hand (1).Suit then
return False;
end if;
end loop;
return True;
end Is_Flush;
 
function Is_Straight (Hand : Hand_T) return Boolean is
begin
-- special case: Ace low
if Hand (5).Face = a and then Hand (1).Face = two and then Hand (2).Face = three and then Hand (3).Face = four then
return True;
end if;
for Ix in 2 .. 5 loop
if Face_T'Pos (Hand (Ix).Face) /= Face_T'Pos (Hand (Ix - 1).Face) + 1 then
return False;
end if;
end loop;
return True;
end Is_Straight;
 
function Of_A_Kind (N : Positive) return Boolean is
begin
for Pip in two .. a loop
if Pip_Counts (Pip) = N then
return True;
end if;
end loop;
return False;
end Of_A_Kind;
 
function Count_Pairs return Natural is
Pairs : Natural := 0;
begin
for Pip in two .. a loop
if Pip_Counts (Pip) = 2 then
Pairs := Pairs + 1;
end if;
end loop;
return Pairs;
end Count_Pairs;
 
Flush, Straight : Boolean;
 
begin
 
for Hand of Test_Hands loop
Print_Hand (Hand);
Put (":");
Set_Col (20);
Sort_Hand (Hand); -- Print_Hand (Hand);
if Is_Invalid (Hand) then
Put ("invalid");
else
Flush := Is_Flush (Hand);
Straight := Is_Straight (Hand);
if Flush and Straight then
Put ("straight-flush");
else
for Pip in two .. a loop
Pip_Counts (Pip) := 0;
for Card of Hand loop
if Card.Face = Pip then
Pip_Counts (Pip) := Pip_Counts (Pip) + 1;
end if;
end loop;
end loop;
if Of_A_Kind (4) then
Put ("four-of-a-kind");
elsif Of_A_Kind (3) and then Of_A_Kind (2) then
Put ("full-house");
elsif Flush then
Put ("flush");
elsif Straight then
Put ("straight");
elsif Of_A_Kind (3) then
Put ("three-of-a-kind");
else
case Count_Pairs is
when 2 => Put ("two-pairs");
when 1 => Put ("one-pair");
when others => Put ("high-card");
end case;
end if;
end if;
end if;
Put_Line ("");
end loop;
 
end Poker;
</syntaxhighlight>
 
Output:
2h 2d 2c ks qd: three-of-a-kind
2h 5h 7d 8c 9s: high-card
ah 2d 3c 4c 5d: straight
2h 3h 2d 3c 3d: full-house
2h 7h 2d 3c 3d: two-pairs
2h 7h 7d 7c 7s: four-of-a-kind
10h jh qh kh ah: straight-flush
4h 4s ks 5d 10s: one-pair
qc 10c 7c 6c qc: invalid
 
=={{header|AutoHotkey}}==
Line 1,176 ⟶ 1,356:
QC TC 7C 6C 4C: Flush
</pre>
 
=={{header|FreeBASIC}}==
{{trans|C}}
<syntaxhighlight lang="vbnet">Const As String FACES = "23456789tjqka"
Const As String SUITS = "shdc"
 
Type card
face As Integer ' FACES map to 0..12 respectively
suit As String
End Type
 
Dim Shared As card cards(4)
 
Sub insertionSort(arr() As card, Byval n As Integer)
Dim As Integer i, key, j
For i = 1 To n-1
key = arr(i).face
j = i-1
While j >= 0 And arr(j).face > key
arr(j+1) = arr(j)
j = j-1
Wend
arr(j+1).face = key
Next i
End Sub
 
Function compareCard(Byval a As card, Byval b As card) As Integer
Return a.face - b.face
End Function
 
Function equalsCard(Byval c1 As card, Byval c2 As card) As Integer
If c1.face = c2.face And c1.suit = c2.suit Then Return True
Return False
End Function
 
Function areDistinct() As Integer
Dim As Integer i, j
For i = 0 To 3
For j = i + 1 To 4
If equalsCard(cards(i), cards(j)) = True Then Return False
Next j
Next i
Return True
End Function
 
Function isStraight() As Boolean
insertionSort(cards(), 5)
If cards(0).face + 4 = cards(4).face Then Return True
If cards(4).face = 12 And cards(0).face = 0 And cards(3).face = 3 Then Return True
Return False
End Function
 
Function isFlush() As Boolean
Dim As String suit = cards(0).suit
For i As Integer = 1 To 4
If cards(i).suit <> suit Then Return False
Next i
Return True
End Function
 
Function analyzeHand(Byval hand As String) As String
Dim As Integer i, j, cp, gs = 0
Dim As String suit
Dim As Integer found, flush, straight
Dim As Integer groups(12)
If Len(hand) <> 14 Then Return "invalid"
For i = 0 To 13 Step 3
cp = Instr(FACES, Lcase(Mid(hand, i + 1, 1)))
If cp = 0 Then Return "invalid"
j = i \ 3
cards(j).face = cp - 1
suit = Lcase(Mid(hand, i + 2, 1))
cp = Instr(SUITS, suit)
If cp = 0 Then Return "invalid"
cards(j).suit = suit
Next i
If areDistinct() = False Then Return "invalid"
For i = 0 To 12
groups(i) = 0
Next i
For i = 0 To 4
groups(cards(i).face) += 1
Next i
For i = 0 To 12
If groups(i) > 0 Then gs += 1
Next i
Select Case gs
Case 2
found = False
For i = 0 To 12
If groups(i) = 4 Then
found = True
Exit For
End If
Next i
If found = True Then Return "four-of-a-kind"
Return "full-house"
Case 3
found = False
For i = 0 To 12
If groups(i) = 3 Then
found = True
Exit For
End If
Next i
If found = True Then Return "three-of-a-kind"
Return "two-pairs"
Case 4
Return "one-pair"
Case Else
flush = isFlush()
straight = isStraight()
If flush = True And straight = True Then
Return "straight-flush"
Elseif flush = True Then
Return "flush"
Elseif straight = True Then
Return "straight"
Else
Return "high-card"
End If
End Select
End Function
 
Dim As String tipo
Dim As String hands(9) = { _
"2h 2d 2c kc qd", _
"2h 5h 7d 8c 9s", _
"ah 2d 3c 4c 5d", _
"2h 3h 2d 3c 3d", _
"2h 7h 2d 3c 3d", _
"2h 7h 7d 7c 7s", _
"th jh qh kh ah", _
"4h 4s ks 5d ts", _
"qc tc 7c 6c 4c", _
"ah ah 7c 6c 4c" }
 
For i As Integer = 0 To 9
tipo = analyzeHand(hands(i))
Print hands(i); ": "; tipo
Next i
 
Sleep</syntaxhighlight>
{{out}}
<pre>Same as C entry.</pre>
 
=={{header|Go}}==
Line 2,052 ⟶ 2,378:
joker 2♠ joker a♠ 10♠: flush
joker q♦ joker a♦ 10♦: straight-flush
</pre>
 
=={{header|jq}}==
'''Adapted from [[#Wren|Wren]]'''
 
'''Works with jq, the C implementation of jq'''
 
'''Works with gojq, the Go implementation of jq'''
 
With a few small tweaks, the program shown below also works with jaq,
the Rust implementation of jq.
<syntaxhighlight lang="jq">
# A card is represented by a JSON object:
def Card($face; $suit): {$face, $suit};
 
def FACES: "23456789tjqka";
def SUITS: "shdc";
 
# Input: an array of Card
def isStraight:
sort_by(.face)
| (.[0].face + 4 == .[4].face)
or (.[4].face == 14 and .[0].face == 2 and .[3].face == 5) ;
 
def isFlush:
.[0].suit as $suit
| all(.[]; .suit == $suit);
 
# Input: a string such as "2h 2d 2c kc qd"
def analyzeHand:
(FACES | split("")) as $FACES
| (SUITS | split("")) as $SUITS
| ascii_downcase
| split(" ")
| unique
| if length != 5 or
any(length != 2 or
(.[0:1] | IN($FACES[]) | not) or
(.[1: ] | IN($SUITS[]) | not) )
then "invalid"
else [.[] as $s | Card(($FACES|index($s[0:1])) + 2; $s[1:]) ]
| . as $cards
| group_by(.face)
| if length == 2
then if any(length == 4) then "four-of-a-kind"
else "full-house"
end
elif length == 3
then if any(length == 3) then "three-of-a-kind"
else "two-pairs"
end
elif length == 4
then "one-pair"
else ($cards|[isFlush, isStraight]) as [$flush, $straight]
| if $flush and $straight then "straight-flush"
elif $flush then "flush"
elif $straight then "straight"
else "high-card"
end
end
end ;
 
def hands: [
"2h 2d 2c kc qd",
"2h 5h 7d 8c 9s",
"ah 2d 3c 4c 5d",
"2h 3h 2d 3c 3d",
"2h 7h 2d 3c 3d",
"2h 7h 7d 7c 7s",
"th jh qh kh ah",
"4h 4s ks 5d ts",
"qc tc 7c 6c 4c",
"ah ah 7c 6c 4c"
];
 
hands[]
| "\(.): \(analyzeHand)"
</syntaxhighlight>
{{output}}
<pre>
2h 2d 2c kc qd: three-of-a-kind
2h 5h 7d 8c 9s: high-card
ah 2d 3c 4c 5d: straight
2h 3h 2d 3c 3d: full-house
2h 7h 2d 3c 3d: two-pairs
2h 7h 7d 7c 7s: four-of-a-kind
th jh qh kh ah: straight-flush
4h 4s ks 5d ts: one-pair
qc tc 7c 6c 4c: flush
ah ah 7c 6c 4c: invalid
</pre>
 
Line 2,186 ⟶ 2,602:
Hand ["Q♣", "T♣", "7♣", "6♣", "4♣"] is a flush hand.
</pre>
 
 
 
 
=={{header|Kotlin}}==
Line 2,431 ⟶ 2,844:
🃂 🃞 🃍 🃁 🃊 : high-card
</pre>
 
=={{header|Liberty Basic}}==
{{works with|LB Booster}}
<syntaxhighlight lang="Liberty Basic>
 
NoMainWin
WindowWidth=900
WindowHeight=720
BackgroundColor$ = "191 191 255" ' buttonface default
Global Deck, MaxDecks
 
StaticText #1.Debug "", 0, 0, 600, 20
StaticText #1.StaticText "Ten Decks of Poker Hands", 50, 50, 3000, 40
Button #1.Deal "Deal", [Start], UL, 700, 180, 80, 40
Button #1.TenThousand "10,000", [TenThousand], UL, 700, 250, 80, 40
Button #1.Stats "History", ShowStats, UL, 700, 320, 80, 40
Button #1.Quit "Quit", Quit, UL, 700, 390, 80, 40
TextEditor #1.TextEditor 50, 100, 600, 500
 
open "POKER HANDS" for dialog as #1
#1 "TrapClose Quit"
#1 "Font Ariel 12 Bold"
#1.StaticText "!Font Ariel 16 Bold"
#1.TextEditor "!Font Courier_New 14 Bold"
if not(exists("Poker Hands.txt")) then #1.Stats "!Disable"
MaxDecks=10
wait
 
[TenThousand]
TenThousand = 1
[Start]
if TenThousand then
MaxDecks=10000
#1.TextEditor "!Hide"
#1.Deal "!Hide"
#1.TenThousand "!Hide"
#1.Stats "!Hide"
#1.Quit "!Hide"
#1.StaticText "Ten Thousand Decks of Poker Hands"
end if
Deck += 1
if TenThousand then #1.Debug Str$(Deck)
if Deck>MaxDecks then Deck -= 1: call Quit
#1.TextEditor "!cls"
call ShuffleDeck 0
'call TestDeck
NextCard=1
for y=1 to 10
for x=1 to 5
y$ = A$(NextCard)
B$(x) = ConvertHiCard$(y$)
NextCard += 1
next x
sort B$(), 1, 5
for x=NextCard-5 to NextCard-1
#1.TextEditor A$(x)+" ";
next x
#1.TextEditor " ";
Values$="" 'determine high value of hand
for x=1 to 5
Values$ = Values$ + left$(B$(x),1)
next x
HiValue$ = RealValue$(right$(Values$,1))
 
z=0: Flush=0: Straight=0: Royal=0: FourKind=0
ThreeKind=0: Pair=0: TwoPair=0: FullHouse=0
if Flush() then Flush=1
x = Straight()
if x then Straight=1: if x=9 then Royal=1
z$ = Kind$()
Value$ = RealValue$(right$(z$,1))
z=val(left$(z$, len(z$)-1))
if z=41 then FourKind=1
if z=32 then FullHouse=1
if z=31 then ThreeKind=1
if z=22 then TwoPair=1
if z=21 then Pair=1
select case
case Straight and Royal and Flush: #1.TextEditor "Royal Flush": Stats(1) += 1
case Straight and Flush: #1.TextEditor "Straight Flush, " + HiValue$ + " high": Stats(2) += 1
case FourKind: #1.TextEditor "Four of a kind, " + Value$ + "s": Stats(3) += 1
case FullHouse: #1.TextEditor "Full House, " + Value$ + "s high": Stats(4) += 1
case Flush: #1.TextEditor "Flush, " + HiValue$ + " high": Stats(5) += 1
case Straight: #1.TextEditor "Straight, " + HiValue$ + " high": Stats(6) += 1
case ThreeKind: #1.TextEditor "Three of a kind, " + Value$ + "s": Stats(7) += 1
case TwoPair: #1.TextEditor "Two Pair, " + Value$ + " high": Stats(8) += 1
case Pair: #1.TextEditor "Pair " + Value$ + "s": Stats(9) += 1
case else: #1.TextEditor HiValue$ + " high"
end select
next y
#1.TextEditor ""
#1.TextEditor "Deck #" + str$(Deck)
if TenThousand then goto [Start] else wait
 
function RealValue$(Value$)
select case Value$
case "A": RealValue$="T"
case "B": RealValue$="J"
case "C": RealValue$="Q"
case "D": RealValue$="K"
case "E": RealValue$="A"
case else: RealValue$=Value$
end select
end function
 
sub SaveStats Deck
Stats(0) = 10*Deck
if not(exists("Poker Hands.txt")) then
open "Poker Hands.txt" for output as #2
for x=0 to 9
print #2 Stats(x)
next
close #2
#1.Stats "!Enable"
else
open "Poker Hands.txt" for input as #2
for x=0 to 9
input #2 History(x)
next
close #2
for x=0 to 9
History(x) += Stats(x)
next
open "Poker Hands.txt" for output as #2
for x=0 to 9
print #2 History(x)
next
close #2
end if
end sub
 
sub ShowStats
if exists("Poker Hands.txt") then
open "Poker Hands.txt" for input as #2
for x=0 to 9
input #2 History(x)
next
close #2
#1.TextEditor "!cls"
for x=1 to 9
Total += History(x)
next x
Nothing = History(0) - Total
 
for x=0 to 9
#1.TextEditor using("###,### ", History(x));
select case x
case 0: #1.TextEditor "hands "
case 1: #1.TextEditor "royal flush " + using("##.# %", History(x)/History(0)*100)
case 2: #1.TextEditor "straight flush " + using("##.# %", History(x)/History(0)*100)
case 3: #1.TextEditor "four of a kind " + using("##.# %", History(x)/History(0)*100)
case 4: #1.TextEditor "full house " + using("##.# %", History(x)/History(0)*100)
case 5: #1.TextEditor "flush " + using("##.# %", History(x)/History(0)*100)
case 6: #1.TextEditor "straight " + using("##.# %", History(x)/History(0)*100)
case 7: #1.TextEditor "three of a kind " + using("##.# %", History(x)/History(0)*100)
case 8: #1.TextEditor "two pair " + using("##.# %", History(x)/History(0)*100)
case 9: #1.TextEditor "pair " + using("##.# %", History(x)/History(0)*100)
end select
next
#1.TextEditor using("###,### ", Nothing) + "nothing " + using("###.# %", Nothing/History(0)*100)
end if
end sub
 
function Kind$()
for x=1 to 5
C$(x) = left$(B$(x), 1)
next x
if C$(1) = C$(2) then 'check for Lo4
Lo2=1
if C$(2) = C$(3) then
Lo2=0: Lo3=1
if C$(3) = C$(4) then
Lo3=0: Kind$="41" + left$(C$(4),1): exit function
end if
end if
end if
if C$(5) = C$(4) then 'check for Hi4
Hi2=1
if C$(4) = C$(3) then
Hi2=0: Hi3=1
if C$(3) = C$(2) then
Hi3=0: Kind$="41" + left$(C$(5),1): exit function
end if
end if
end if
if Lo3 then 'check for Full House and 3Kind
if C$(4) = C$(5) then
Kind$="32" + left$(C$(3),1): exit function
else
Kind$="31" + left$(C$(3),1): exit function
end if
end if
if Hi3 then
if C$(1) = C$(2) then
Kind$="32" + left$(C$(5),1): exit function
else
Kind$="31" + left$(C$(5),1): exit function
end if
end if
if C$(2) = C$(3) and C$(3) = C$(4) then 'Mid3
Kind$="31" + left$(C$(4),1): exit function
end if
if Lo2 and Hi2 then 'check for pairs
Kind$="22" + left$(C$(5),1): exit function
end if
if Lo2 and (C$(3)=C$(4)) then
Kind$="22" + left$(C$(4),1): exit function
end if
if Hi2 and (C$(3)=C$(2)) then
Kind$="22" + left$(C$(5),1): exit function
end if
if Lo2 then Kind$="21" + left$(C$(2),1)
if Hi2 then Kind$="21" + left$(C$(5),1)
if C$(2)=C$(3) then Kind$="21" + left$(C$(3),1)
if C$(3)=C$(4) then Kind$="21" + left$(C$(4),1)
end function
 
function Straight()
Order$="23456789ABCDEF"
for x=1 to 5
Ranks$ = Ranks$ + left$(B$(x), 1)
next x
x = instr(Order$, Ranks$)
if x then Straight=x
end function
 
function Flush()
Flush=1
for x=1 to 5
Suits$ = Suits$ + right$(B$(x), 1)
next x
for x=2 to 5
if mid$(Suits$, x, 1) <> left$(Suits$, 1) then Flush=0: exit function
next x
end function
 
sub ShuffleDeck Jokers
Jokers = int(abs(Jokers)): if Jokers>4 then Jokers=4
Size=52 + Jokers
dim CardDeck$(Size+10,1), A$(Size+10) 'Open new card deck
[Start]
for x=1 to Size
CardDeck$(x,0) = "99"
next x
 
for x=1 to Size
1 y=RandomNumber(1,Size)
if CardDeck$(y,0)="99" then CardDeck$(y,0)=str$(x) else goto 1
next x
 
for x=1 to Size 'Examine shuffled deck
if CardDeck$(x,0)=str$(x) then z = 1: exit for
next x
if z then z=0: goto [Start]
for x=1 to Size 'Save shuffled deck
A$(x) = CardFace$(val(CardDeck$(x,0)))
next x
A$(0) = str$(Size)
end sub
 
function CardFace$(n)
select case n
case 1: CardFace$="AD"
case 2: CardFace$="2D"
case 3: CardFace$="3D"
case 4: CardFace$="4D"
case 5: CardFace$="5D"
case 6: CardFace$="6D"
case 7: CardFace$="7D"
case 8: CardFace$="8D"
case 9: CardFace$="9D"
case 10: CardFace$="TD"
case 11: CardFace$="JD"
case 12: CardFace$="QD"
case 13: CardFace$="KD"
case 14: CardFace$="AC"
case 15: CardFace$="2C"
case 16: CardFace$="3C"
case 17: CardFace$="4C"
case 18: CardFace$="5C"
case 19: CardFace$="6C"
case 20: CardFace$="7C"
case 21: CardFace$="8C"
case 22: CardFace$="9C"
case 23: CardFace$="TC"
case 24: CardFace$="JC"
case 25: CardFace$="QC"
case 26: CardFace$="KC"
case 27: CardFace$="AH"
case 28: CardFace$="2H"
case 29: CardFace$="3H"
case 30: CardFace$="4H"
case 31: CardFace$="5H"
case 32: CardFace$="6H"
case 33: CardFace$="7H"
case 34: CardFace$="8H"
case 35: CardFace$="9H"
case 36: CardFace$="TH"
case 37: CardFace$="JH"
case 38: CardFace$="QH"
case 39: CardFace$="KH"
case 40: CardFace$="AS"
case 41: CardFace$="2S"
case 42: CardFace$="3S"
case 43: CardFace$="4S"
case 44: CardFace$="5S"
case 45: CardFace$="6S"
case 46: CardFace$="7S"
case 47: CardFace$="8S"
case 48: CardFace$="9S"
case 49: CardFace$="TS"
case 50: CardFace$="JS"
case 51: CardFace$="QS"
case 52: CardFace$="KS"
case 53: CardFace$="X1"
case 54: CardFace$="X2"
case 55: CardFace$="X3"
case 56: CardFace$="X4"
end select
end function
 
function RandomNumber(a, b)
smaller = min(a, b)
range = abs(int(a-b))+1
if range < 1 then exit function
r = int(rnd()*range)
RandomNumber = r + smaller
end function
 
function ConvertHiCard$(Card$)
select case left$(Card$,1)
case "T": left$(Card$,1)="A"
case "J": left$(Card$,1)="B"
case "Q": left$(Card$,1)="C"
case "K": left$(Card$,1)="D"
case "A": left$(Card$,1)="E"
case "X": left$(Card$,1)="F"
end select
ConvertHiCard$ = Card$
end function
 
sub TestDeck
data KD, KC, KS, AH, AS ' full house
data 6D, 6C, 6S, 6H, 8H ' four of a kind (io)
data 2D, 4S, 4C, TH, TD ' two pair
data 4H, 5H, 6H, 7H, 8H ' straight flush
data 9S, QD, QC, QH, 3D ' three of a kind
data 6H, 7D, 8C, 9C, TS ' straight
data TH, AH, AS, AC, AD ' four of a kind (hI)
data 3S, 5S, 7S, 9S, JS ' flush
data AD, KD, QD, JD, TD ' royal flush
data 2C, 2D, 3H, 4S, 5C ' one pair
dim A$(50)
for x=1 to 50
read A$(x)
next x
end sub
 
function exists(FileName$)
files "", FileName$, FileDir$()
FileCount$ = FileDir$(0, 0)
exists = val(FileCount$)
end function
 
sub Quit
if Deck = MaxDecks then call SaveStats Deck
close #1
end
end sub
 
</syntaxhighlight>
{{out}}
<pre>
JH 8C 8S TH KC Pair 8s
9C JS 3S 5D 3D Pair 3s
TD QH 6S TS AD Pair Ts
AH 9D KD 3H AC Pair As
QS 6D JC QD 2H Pair Qs
4H 2D 5S 4C JD Pair 4s
KH 6C 4S 7C 5H K high
3C 7D 8D 4D 7H Pair 7s
9S 2S 7S 9H 6H Pair 9s
AS QC 5C TC 2C A high
 
Deck #1
</pre>
 
 
=={{header|Lua}}==
Line 5,109 ⟶ 5,916:
{{libheader|Wren-seq}}
===Basic Version===
<syntaxhighlight lang="ecmascriptwren">import "./dynamic" for Tuple
import "./sort" for Sort
import "./str" for Str
import "./seq" for Lst
 
var Card = Tuple.create("Card", ["face", "suit"])
Line 5,195 ⟶ 6,002:
</pre>
===Extra Credit Version===
<syntaxhighlight lang="ecmascriptwren">import "./dynamic" for Tuple
import "./sort" for Sort
import "./seq" for Lst
 
var Card = Tuple.create("Card", ["face", "suit"])
Line 5,327 ⟶ 6,134:
🃏 🃂 🂢 🃍 🃍: invalid
🃂 🃞 🃍 🃁 🃊: high-card
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang "XPL0">string 0; \Use null-terminated strings (vs MSB terminated)
int Count(1+18); \Counts of ranks and suits in a hand
 
proc ShowCat; \Show category of poker hand
int I, J;
[for I:= 1 to 14 do
[if Count(I) = 1 then
[for J:= I+1 to I+4 do \are next 4 cards present?
if Count(J) # 1 then J:= 100;
if J <= 100 then
[Text(0, "straight");
for J:= 15 to 18 do \scan suits
if Count(J) >= 4 then Text(0, "-flush");
return;
];
];
];
for I:= 15 to 18 do
if Count(I) = 4 then [Text(0, "flush"); return];
for I:= 1 to 14 do \scan ranks
if Count(I) = 4 then
[Text(0, "four-of-a-kind"); return];
for I:= 1 to 14 do
[if Count(I) = 3 then
[for J:= 1 to 14 do
if Count(J) = 2 then
[Text(0, "full-house"); return];
Text(0, "three-of-a-kind"); return;
];
];
for I:= 1 to 14 do
[if Count(I) = 2 then
[for J:= 1 to 14 do
if J # I and Count(J) = 2 then
[Text(0, "two-pairs"); return];
Text(0, "one-pair"); return;
];
];
Text(0, "high-card");
];
 
int Hands, H, Card, I, Char, N, Invalid, Valid(4), Suit, Rank;
char Str;
[Hands:= [
"2h 2d 2c kc qd ",
"2h 5h 7d 8c 9s ",
"ah 2d 3c 4c 5d ",
"2h 3h 2d 3c 3d ",
"2h 7h 2d 3c 3d ",
"2h 7h 7d 7c 7s ",
"10h jh qh kh ah ",
"4h 4s ks 5d 10s ",
"qc 10c 7c 6c qc "];
for H:= 0 to 9-1 do
[for I:= 0 to 18 do Count(I):= 0;
for I:= 0 to 3 do Valid(I):= 0;
Invalid:= false;
Str:= Hands(H);
Card:= 0; I:= 0;
loop [Char:= Str(I); I:= I+1;
case Char of
^h: N:= 18;
^d: N:= 17;
^c: N:= 16;
^s: N:= 15;
^a: N:= 14;
^k: N:= 13;
^q: N:= 12;
^j: N:= 11;
^1: N:= 10;
^ : [N:= 0; Card:= Card+1; if Card >= 5 then quit]
other N:= Char-^0;
Count(N):= Count(N)+1;
if N = 14 then Count(1):= Count(1)+1; \two-place ace
if N <= 14 then Rank:= N
else [Suit:= N - 15;
if Valid(Suit) and 1<<Rank then Invalid:= true
else Valid(Suit):= Valid(Suit) or 1<<Rank;
];
];
Text(0, Str);
if Invalid then Text(0, "invalid")
else ShowCat;
CrLf(0);
];
]</syntaxhighlight>
{{out}}
<pre>
2h 2d 2c kc qd three-of-a-kind
2h 5h 7d 8c 9s high-card
ah 2d 3c 4c 5d straight
2h 3h 2d 3c 3d full-house
2h 7h 2d 3c 3d two-pairs
2h 7h 7d 7c 7s four-of-a-kind
10h jh qh kh ah straight-flush
4h 4s ks 5d 10s one-pair
qc 10c 7c 6c qc invalid
</pre>
Boreal
297

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/345388...365069"