From 9f3affadbb7c2211b402cfd71c45eb3f96bd4926 Mon Sep 17 00:00:00 2001 From: Lucas Bouju Date: Sun, 7 Sep 2025 23:39:30 +0200 Subject: [PATCH 1/3] experiment for a new way of computing kinds --- src/Hands.hs | 52 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 37 insertions(+), 15 deletions(-) diff --git a/src/Hands.hs b/src/Hands.hs index e650200..7fb55ed 100644 --- a/src/Hands.hs +++ b/src/Hands.hs @@ -59,27 +59,49 @@ toStraightFlush = join . (liftA2 returnsifequal <$> toStraight <*> toFlush) isFlushStraight :: Cards -> Bool isFlushStraight = isJust . toStraightFlush --- this should be tweaked to also get the kickers -toNOfAKind :: Int -> Cards -> Maybe Card -toNOfAKind n = fmap NE.head . find ((== n) . NE.length) . NE.groupAllWith1 value - -toPair :: Cards -> Maybe Hand -toPair = fmap ((`Pair` noKicker) . value) . toNOfAKind 2 +toKinds :: Cards -> Maybe Hand +toKinds cs = case lengths of + 4 NE.:| _ -> Just $ FourOfAKind extractedDominant extractedKickersWithoutSecondary + 3 NE.:| 2 : _ -> Just $ FullHouse extractedDominant extractedSecondary + 3 NE.:| _ -> Just $ ThreeOfAKind extractedDominant extractedKickersWithoutSecondary + 2 NE.:| 2 : _ -> Just $ TwoPair extractedDominant extractedSecondary extractedKickersWithSecondary + 2 NE.:| _ -> Just $ Pair extractedDominant extractedKickersWithoutSecondary + 1 NE.:| _ -> Just $ High extractedDominant extractedKickersWithoutSecondary + _ -> Nothing + where + grouped = NE.sortWith NE.length $ NE.groupAllWith1 value cs + lengths = fmap NE.length grouped + extractedDominant = NE.head (NE.head (fmap (fmap value) grouped)) + extractedSecondary = NE.head (fmap (fmap value) grouped NE.!! 1) + extractedKickersWithoutSecondary = kickers $ fmap value $ NE.toList $ grouped NE.!! 1 + extractedKickersWithSecondary = kickers $ fmap value $ NE.toList $ grouped NE.!! 2 isFourOfAKind :: Cards -> Bool -isFourOfAKind cards = (NE.head sorted == sorted NE.!! 3) || (sorted NE.!! 1 == sorted NE.!! 4) - where - sorted = sortByValue cards +isFourOfAKind cs = case toKinds cs of + Just (FourOfAKind _ _) -> True + _ -> False + +-- isFourOfAKind cards = (NE.head sorted == sorted NE.!! 3) || (sorted NE.!! 1 == sorted NE.!! 4) +-- where +-- sorted = sortByValue cards isThreeOfAKind :: Cards -> Bool -isThreeOfAKind cards = (NE.head sorted == sorted NE.!! 2) || (sorted NE.!! 1 == sorted NE.!! 3) || (sorted NE.!! 2 == sorted NE.!! 4) - where - sorted = sortByValue cards +isThreeOfAKind cs = case toKinds cs of + Just (ThreeOfAKind _ _) -> True + _ -> False + +-- isThreeOfAKind cards = (NE.head sorted == sorted NE.!! 2) || (sorted NE.!! 1 == sorted NE.!! 3) || (sorted NE.!! 2 == sorted NE.!! 4) +-- where +-- sorted = sortByValue cards isPair :: Cards -> Bool -isPair cards = (NE.head sorted == sorted NE.!! 1) || (sorted NE.!! 1 == sorted NE.!! 2) || (sorted NE.!! 2 == sorted NE.!! 3) || (sorted NE.!! 3 == sorted NE.!! 4) - where - sorted = sortByValue cards +isPair cs = case toKinds cs of + Just (Pair _ _) -> True + _ -> False + +-- isPair cards = (NE.head sorted == sorted NE.!! 1) || (sorted NE.!! 1 == sorted NE.!! 2) || (sorted NE.!! 2 == sorted NE.!! 3) || (sorted NE.!! 3 == sorted NE.!! 4) +-- where +-- sorted = sortByValue cards isTwoPairs :: Cards -> Bool isTwoPairs cards = not (isFourOfAKind cards) && (((NE.head sorted == sorted NE.!! 1) && (sorted NE.!! 2 == sorted NE.!! 3)) || ((NE.head sorted == sorted NE.!! 1) && (sorted NE.!! 3 == sorted NE.!! 4)) || ((sorted NE.!! 3 == sorted NE.!! 4) && (sorted NE.!! 2 == sorted NE.!! 3))) From 8c5b196256a91f2860ec855da8309545cccb9e0d Mon Sep 17 00:00:00 2001 From: Lucas Bouju Date: Fri, 12 Sep 2025 19:20:26 +0200 Subject: [PATCH 2/3] Fixed bug in NofaKind detection --- src/Hands.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Hands.hs b/src/Hands.hs index 7fb55ed..5a5d680 100644 --- a/src/Hands.hs +++ b/src/Hands.hs @@ -7,6 +7,7 @@ import Data.List (find, maximumBy, sort, uncons) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust, listToMaybe) +import Data.Ord (Down(..), comparing) type Cards = NonEmpty Card @@ -69,7 +70,7 @@ toKinds cs = case lengths of 1 NE.:| _ -> Just $ High extractedDominant extractedKickersWithoutSecondary _ -> Nothing where - grouped = NE.sortWith NE.length $ NE.groupAllWith1 value cs + grouped = NE.sortBy (comparing (Down . NE.length)) $ NE.groupAllWith1 value cs lengths = fmap NE.length grouped extractedDominant = NE.head (NE.head (fmap (fmap value) grouped)) extractedSecondary = NE.head (fmap (fmap value) grouped NE.!! 1) From 8784d9015beb70d15705b962a5a0e370bc943d44 Mon Sep 17 00:00:00 2001 From: Lucas Bouju Date: Fri, 12 Sep 2025 19:25:39 +0200 Subject: [PATCH 3/3] fully switched to toKinds computation method for hands --- src/Hands.hs | 24 ++++++------------------ 1 file changed, 6 insertions(+), 18 deletions(-) diff --git a/src/Hands.hs b/src/Hands.hs index 5a5d680..0a0c6b2 100644 --- a/src/Hands.hs +++ b/src/Hands.hs @@ -82,34 +82,22 @@ isFourOfAKind cs = case toKinds cs of Just (FourOfAKind _ _) -> True _ -> False --- isFourOfAKind cards = (NE.head sorted == sorted NE.!! 3) || (sorted NE.!! 1 == sorted NE.!! 4) --- where --- sorted = sortByValue cards - isThreeOfAKind :: Cards -> Bool isThreeOfAKind cs = case toKinds cs of Just (ThreeOfAKind _ _) -> True _ -> False --- isThreeOfAKind cards = (NE.head sorted == sorted NE.!! 2) || (sorted NE.!! 1 == sorted NE.!! 3) || (sorted NE.!! 2 == sorted NE.!! 4) --- where --- sorted = sortByValue cards - isPair :: Cards -> Bool isPair cs = case toKinds cs of Just (Pair _ _) -> True _ -> False --- isPair cards = (NE.head sorted == sorted NE.!! 1) || (sorted NE.!! 1 == sorted NE.!! 2) || (sorted NE.!! 2 == sorted NE.!! 3) || (sorted NE.!! 3 == sorted NE.!! 4) --- where --- sorted = sortByValue cards - isTwoPairs :: Cards -> Bool -isTwoPairs cards = not (isFourOfAKind cards) && (((NE.head sorted == sorted NE.!! 1) && (sorted NE.!! 2 == sorted NE.!! 3)) || ((NE.head sorted == sorted NE.!! 1) && (sorted NE.!! 3 == sorted NE.!! 4)) || ((sorted NE.!! 3 == sorted NE.!! 4) && (sorted NE.!! 2 == sorted NE.!! 3))) - where - sorted = sortByValue cards +isTwoPairs cs = case toKinds cs of + Just (TwoPair _ _ _) -> True + _ -> False isFull :: Cards -> Bool -isFull cards = ((NE.head sorted == sorted NE.!! 2) && (sorted NE.!! 3 == sorted NE.!! 4)) || ((NE.head sorted == sorted NE.!! 1) && (sorted NE.!! 2 == sorted NE.!! 4)) - where - sorted = sortByValue cards +isFull cs = case toKinds cs of + Just (FullHouse _ _) -> True + _ -> False