Probability poker game task

Question

I have this task: And I've got this far in my mathematica program, however I can't figure out why my probability turns out 0? ClearAll["'*"] (* Deck *) (* We let colors (black, red, green and blue) be represented by the first position in a 3-digit integer and the values (1,2,3,4,5,6,7,8,9,10) be represented by the third position in the 3-digit integer *) deck = Sort[Join[Range[101, 110], Range[201, 209], Range[301, 308], Range[401, 407]]] Out[174]= {101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 201, 202, 203, 204, 205, 206, 207, 208, 209, 301, 302, 303, 304, 305, 306, 307, 308, 401, 402, 403, 404, 405, 406, 407} hands = Subsets[deck, {5}]; Short[hands] Out[176]/Short= {{101, 102, 103, 104, 105}, {101, 102, 103, 104, 106}, <<278253>>, {403, 404, 405, 406, 407}} pairQ[{___, x_, x_, ___}] := True; (* a pair *) pairQ[{___, x_, x_, ___, y_, y_, ___} /; x != y] := False; (* two pairs *) pairQ[{___, x_, x_, x_, ___}] := False; (* three of a kind *) pairQ[{___, x_, x_, x_, x_, ___}] := False; (* four of a kind *) pairQ[{___}] := False (* else *) Count[hands, _?(pairQ)]/Length[hands] Out[199]= 0 Any suggestions would kind!

flinty · Answer

There's no need to use patterns here. They just make more trouble figuring them out and debugging. There's also no reason to introduce a coding scheme for the cards at this stage, which is a bit of a premature optimization.
ranks[hand_] := Sort[hand[[All, 1]]]
suits[hand_] := Sort[hand[[All, 2]]]
countranks[hand_] := Values@Counts@ranks@hand
pairQ[hand_] := Not[DuplicateFreeQ[ranks[hand]]]
twoPairsQ[hand_] := Count[countranks@hand, 2] == 2
threeOfAKindQ[hand_] := MemberQ[countranks@hand, 3]
fourOfAKindQ[hand_] := MemberQ[countranks@hand, 4]
fullHandQ[hand_] := ContainsExactly[countranks@hand,{3,2}]
straightQ[hand_] := ContainsOnly[Differences[Sort[ranks[hand]]], {1}]
flushQ[hand_] := SameQ @@ suits[hand]
straightFlushQ[hand_] := flushQ[hand] && straightQ[hand]

(* in order of best to worst *)
scoringFunctions = {
  {straightFlushQ, "Straight Flush"},
  {flushQ, "Flush"},
  {straightQ, "Straight"},
  {fullHandQ, "Full Hand"},
  {fourOfAKindQ, "Four of a kind"},
  {threeOfAKindQ, "Three of a kind"},
  {twoPairsQ, "Two pairs"},
  {pairQ, "Pair"}
};

bestScore[hand_] := Last[SelectFirst[scoringFunctions,First[#][hand]&]]

deck = Join[
   {#, Black} & /@ Range[10],
   {#, Red} & /@ Range[9],
   {#, Green} & /@ Range[8],
   {#, Blue} & /@ Range[7]
];

hands = Subsets[deck, {5}];
CountsBy[hands, pairQ][True]/Length[hands]

(* result: 11021/17391 *)

(* best hand probabilities *)
#/Length[hands]& /@ KeyDrop[CountsBy[hands, bestScore], "NotFound"]
(** 
<|"Straight Flush" -> 3/46376,
 "Flush" -> 437/278256, 
 "Pair" -> 17395/34782,
 "Straight" -> 717/46376, 
 "Two pairs" -> 737/8432,
 "Three of a kind" -> 5741/139128, 
 "Full Hand" -> 1163/278256,
 "Four of a kind" -> 35/46376|>
**)

Probability poker game task

One Answer

Add your own answers!

Ask a Question