Guest User

Untitled

a guest
Dec 7th, 2023
78
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE OverloadedStrings #-}
  2. module DaySeven (module DaySeven) where
  3.  
  4. import qualified Data.Text as T
  5. import qualified Data.List as L
  6. import qualified Text.Read as TR
  7. import qualified Data.Maybe as M
  8. import qualified Data.Set as S
  9. import qualified Control.Monad as CM
  10. import Data.Range((+=+))
  11. import qualified Data.Range as R
  12. import Lib (operateOnFile)
  13.  
  14. data Card = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Ord, Show, Eq, Enum)
  15.  
  16. scoreCardV2 Jack = 0
  17. scoreCardV2 Two = 1
  18. scoreCardV2 Three = 2
  19. scoreCardV2 Four = 3
  20. scoreCardV2 Five = 4
  21. scoreCardV2 Six = 5
  22. scoreCardV2 Seven = 6
  23. scoreCardV2 Eight = 7
  24. scoreCardV2 Nine = 8
  25. scoreCardV2 Ten = 9
  26. scoreCardV2 Jack = 10
  27. scoreCardV2 Queen = 11
  28. scoreCardV2 King = 12
  29. scoreCardV2 Ace = 13
  30.  
  31. data HandType = HighCard | Pair | TwoPair | ThreeOfAKind | FullHouse | FourOfAKind | FiveOfAKind deriving (Ord, Show, Eq, Enum)
  32.  
  33. type ScoreableHand = (HandType, [Card])
  34. type Bid = (ScoreableHand, Int)
  35.  
  36. parseCard 'A' = Ace
  37. parseCard 'K' = King
  38. parseCard 'Q' = Queen
  39. parseCard 'J' = Jack
  40. parseCard 'T' = Ten
  41. parseCard '9' = Nine
  42. parseCard '8' = Eight
  43. parseCard '7' = Seven
  44. parseCard '6' = Six
  45. parseCard '5' = Five
  46. parseCard '4' = Four
  47. parseCard '3' = Three
  48. parseCard '2' = Two
  49.  
  50. allCards = enumFrom Two
  51.  
  52. extractFiveOfAKind :: [Card] -> M.Maybe HandType
  53. extractFiveOfAKind hand
  54.   | (length (L.nub hand) == 1) = Just FiveOfAKind
  55.   | otherwise = Nothing
  56.  
  57. extractFourOfAKind :: [Card] -> M.Maybe HandType
  58. extractFourOfAKind hand
  59.   | 4 `elem` (cardCounts hand) = Just FourOfAKind
  60.   | otherwise = Nothing
  61.  
  62. extractFullHouse hand
  63.   | nonzeroCardCounts hand == [2,3] = Just FullHouse
  64.   | otherwise = Nothing
  65.  
  66. extractThreeOfAKind :: [Card] -> M.Maybe HandType
  67. extractThreeOfAKind hand
  68.   | 3 `elem` (cardCounts hand) = Just ThreeOfAKind
  69.   | otherwise = Nothing
  70.  
  71. extractTwoPair :: [Card] -> M.Maybe HandType
  72. extractTwoPair hand
  73.   | length (filter (> 1) (cardCounts hand)) > 1 = Just TwoPair
  74.   | otherwise = Nothing
  75.  
  76. extractPair :: [Card] -> M.Maybe HandType
  77. extractPair hand
  78.   | length (filter (> 1) (cardCounts hand)) > 0 = Just Pair
  79.   | otherwise = Nothing
  80.  
  81. extractHighCard :: [Card] -> M.Maybe HandType
  82. extractHighCard hand = Just HighCard
  83.  
  84. hasHowMany hand card = length $ filter (== card) hand
  85.  
  86. cardCounts hand = map (hasHowMany hand) allCards
  87.  
  88. nonzeroCardCounts = L.sort . (filter (> 0)) . cardCounts
  89.  
  90. classify hand = maximum $ M.catMaybes $ [extractFiveOfAKind hand, extractFourOfAKind hand, extractFullHouse hand, extractThreeOfAKind hand, extractTwoPair hand, extractPair hand, extractHighCard hand]
  91.  
  92. classifyV2 hand = maximum hands
  93.   where hands = map (classify . (replace hand Jack)) replacements
  94.         replacements = allCards L.\\ [Jack]
  95.         allCards = enumFrom Two
  96.  
  97. replace :: (Eq t) => [t] -> t -> t -> [t]
  98. replace [] old new = []
  99. replace (h:t) old new
  100.   | h == old = new:(replace t old new)
  101.   | otherwise = h:(replace t old new)
  102.  
  103. score hand = (classify hand, hand)
  104.  
  105. parseBid :: T.Text -> Bid
  106. parseBid row = ((handType, hand), amount)
  107.   where lhs:(rhs:_) = T.split (== ' ') row
  108.         handType = classify $ hand
  109.         hand = map parseCard $ T.unpack lhs
  110.         amount = TR.read $ T.unpack rhs
  111.  
  112. parseBidV2 :: T.Text -> Bid
  113. parseBidV2 row = ((handType, hand), amount)
  114.   where lhs:(rhs:_) = T.split (== ' ') row
  115.         handType = classifyV2 $ hand
  116.         hand = map parseCard $ T.unpack lhs
  117.         amount = TR.read $ T.unpack rhs
  118.  
  119. compareBids (firstHand, _) (secondHand, _) = compare firstHand secondHand
  120. compareBidsV2 ((firstHandType, firstCards), _) ((secondHandType, secondCards), _) = compare (firstHandType, firstCardsV2) (secondHandType, secondCardsV2)
  121.   where firstCardsV2 = map scoreCardV2 firstCards
  122.         secondCardsV2 = map scoreCardV2 secondCards
  123.  
  124. testInput = map T.pack ["32T3K 765",
  125.   "T55J5 684",
  126.   "KK677 28",
  127.   "KTJJT 220",
  128.   "QQQJA 483"]
  129.  
  130. partOne rows = sum $ map finalScore withIndex
  131.   where finalScore (idx, ((handType, cards), bid)) = idx * bid
  132.         parsed = map parseBid rows
  133.         withIndex = L.zip (enumFrom 1) $ L.sortBy compareBids parsed
  134.  
  135.  
  136. partTwo rows = sum $ map finalScore withIndex
  137.   where finalScore (idx, ((handType, cards), bid)) = idx * bid
  138.         parsed = map parseBidV2 rows
  139.         withIndex = L.zip (enumFrom 1) $ L.sortBy compareBidsV2 parsed
  140.  
  141.  
Advertisement
Add Comment
Please, Sign In to add comment