haskell: 2023 06

2023/.inputs/06

@@ -0,0 +1,2 @@
+Time:        51     69     98     78
+Distance:   377   1171   1224   1505

2023/haskell/aoc2023.cabal

@@ -23,6 +23,7 @@ library
     Day03
     Day04
     Day05
+    Day06
 
   -- other-modules:
 

2023/haskell/app/Main.hs

@@ -6,7 +6,8 @@ import Utils (readInput)
 --import qualified Day02
 --import qualified Day03
 --import qualified Day04
-import qualified Day05
+--import qualified Day05
+import qualified Day06
 
 
 run :: (Show b, Show c)
@@ -30,5 +31,6 @@ main = do
   --run 2 Day02.parse Day02.solveA Day02.solveB
   --run 3 Day03.parse Day03.solveA Day03.solveB
   --run 4 Day04.parse Day04.solveA Day04.solveB
-  run 5 Day05.parse Day05.solveA Day05.solveB
+  --run 5 Day05.parse Day05.solveA Day05.solveB
+  run 6 Day06.parse Day06.solveA Day06.solveB
   pure ()

2023/haskell/solutions/Day06.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day06 (parse, solveA, solveB) where
+
+import Data.Void (Void)
+import Data.Text (Text)
+import Data.Bifunctor (first, bimap)
+import Control.Monad (join)
+import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
+import Text.Megaparsec.Char (string, space)
+import Text.Megaparsec.Char.Lexer (decimal)
+
+
+type Parser = Parsec Void Text
+
+
+parse :: Text -> Either String [(Int, Int)]
+parse = first errorBundlePretty . runParser races ""
+  where
+    numbers :: Text -> Parser [Int]
+    numbers s = string s *> space *> many (decimal <* space)
+    races :: Parser [(Int, Int)]
+    races = zip <$> numbers "Time:" <*> numbers "Distance:" <* eof
+
+travelled :: Int -> Int -> Int
+travelled t held = (t - held) * held
+
+choices :: (Int, Int) -> [Int]
+choices (t, d) = filter (d <) . map (travelled t) $ [1 .. t]
+
+solveA :: [(Int, Int)] -> Int
+solveA = product . map (length . choices)
+
+solveB :: [(Int, Int)] -> Int
+solveB = solveA . pure . join bimap (read . concatMap show) . unzip

2023/haskell/tests/Main.hs

@@ -8,6 +8,7 @@ import qualified Day02
 import qualified Day03
 import qualified Day04
 import qualified Day05
+import qualified Day06
 
 
 day01 :: Test
@@ -127,6 +128,18 @@ day05 =
       \60 56 37\n\
       \56 93 4\n"
 
+day06 :: Test
+day06 =
+  let parsed = Day06.parse input
+  in TestList
+      [ TestCase $ assertEqual "A" (Right 288)   (Day06.solveA <$> parsed)
+      , TestCase $ assertEqual "B" (Right 71503) (Day06.solveB <$> parsed)
+    ]
+  where
+    input =
+      "Time:      7  15   30\n\
+      \Distance:  9  40  200\n"
+
 tests :: Test
 tests = TestList
   [ TestLabel "day01" day01
@@ -134,6 +147,7 @@ tests = TestList
   , TestLabel "day03" day03
   , TestLabel "day04" day04
   , TestLabel "day05" day05
+  , TestLabel "day06" day06
   ]
 
 main :: IO ()