Day 4: Camp Cleanup

Author: ephemient

README.md

@@ -8,3 +8,4 @@ Development occurs in language-specific directories:
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day1.kt)|[day1.py](py/aoc2022/day1.py)|[day1.rs](rs/src/day1.rs)|
 |[Day2.hs](hs/src/Day2.hs)|[Day2.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day2.kt)|[day2.py](py/aoc2022/day2.py)|[day2.rs](rs/src/day2.rs)|
 |[Day3.hs](hs/src/Day3.hs)|[Day3.kt](kt/src/commonMain/kotlin/com/github/ephemient/aoc2022/Day3.kt)|[day3.py](py/aoc2022/day3.py)|[day3.rs](rs/src/day3.rs)|
+|[Day4.hs](hs/src/Day4.hs)|

hs/aoc2022.cabal

@@ -14,6 +14,7 @@ data-files:
     day1.txt
   , day2.txt
   , day3.txt
+  , day4.txt
 
 extra-source-files:
     README.md
@@ -23,6 +24,7 @@ library
         Day1
       , Day2
       , Day3
+      , Day4
     build-depends:
         base ^>=4.16.0.0
       , split ^>=0.2.3.5
@@ -57,6 +59,7 @@ test-suite aoc2022-test
         Day1Spec
       , Day2Spec
       , Day3Spec
+      , Day4Spec
     hs-source-dirs:   test
     default-language: GHC2021
     build-tool-depends:

hs/app/Main.hs

@@ -4,6 +4,7 @@ module Main (main) where
 import Day1 (day1a, day1b)
 import Day2 (day2a, day2b)
 import Day3 (day3a, day3b)
+import Day4 (day4a, day4b)
 
 import Control.Monad ((<=<), when)
 import Data.Maybe (mapMaybe)
@@ -30,3 +31,4 @@ main = do
     run 1 print [day1a, day1b]
     run 2 print [day2a, day2b]
     run 3 print [day3a, day3b]
+    run 4 (either fail print) [day4a, day4b]

hs/bench/Main.hs

@@ -6,6 +6,7 @@ import qualified Data.Text.IO as TIO (readFile)
 import Day1 (day1a, day1b)
 import Day2 (day2a, day2b)
 import Day3 (day3a, day3b)
+import Day4 (day4a, day4b)
 import Paths_aoc2022 (getDataFileName)
 
 getDayInput :: Int -> IO Text
@@ -25,4 +26,8 @@ main = defaultMain
       [ bench "part 1" $ nf day3a input
       , bench "part 2" $ nf day3b input
       ]
+  , env (getDayInput 4) $ \input -> bgroup "Day 4"
+      [ bench "part 1" $ nf day4a input
+      , bench "part 2" $ nf day4b input
+      ]
   ]

hs/src/Common.hs

@@ -1,9 +1,13 @@
-module Common (readEntire) where
+module Common (count, readEntire) where
 
+import Data.Foldable (toList)
 import Data.Text (Text)
 import qualified Data.Text as T (null)
 import Data.Text.Read (Reader)
 
+count :: (Foldable t) => (a -> Bool) -> t a -> Int
+count p = length . filter p . toList
+
 readEntire :: Reader a -> Text -> Either String a
 readEntire reader input = do
     (a, t) <- reader input

hs/src/Day4.hs

@@ -0,0 +1,29 @@
+{-|
+Module:         Day4
+Description:    <https://adventofcode.com/2022/day/4 Day 4: Camp Cleanup>
+-}
+{-# LANGUAGE OverloadedStrings #-}
+module Day4 (day4a, day4b) where
+
+import Common (count)
+import Control.Monad (ap)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, stripPrefix)
+import qualified Data.Text.Read as T (decimal)
+
+parse :: (Integral a) => Text -> Either String (a, a, a, a)
+parse line = do
+    (a, line) <- T.decimal line
+    (b, line) <- T.decimal $ fromMaybe `ap` T.stripPrefix "-" $ line
+    (c, line) <- T.decimal $ fromMaybe `ap` T.stripPrefix "," $ line
+    (d, line) <- T.decimal $ fromMaybe `ap` T.stripPrefix "-" $ line
+    pure (a, b, c, d)
+
+day4a :: Text -> Either String Int
+day4a input = fmap (count ok) . sequence $ parse <$> T.lines input where
+    ok (a, b, c, d) = a >= c && b <= d || a <= c && b >= d
+
+day4b :: Text -> Either String Int
+day4b input = fmap (count ok) . sequence $ parse <$> T.lines input where
+    ok (a, b, c, d) = a <= d && b >= c

hs/test/Day4Spec.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day4Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day4 (day4a, day4b)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ "2-4,6-8"
+  , "2-3,4-5"
+  , "5-7,7-9"
+  , "2-8,3-7"
+  , "6-6,4-6"
+  , "2-6,4-8"
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            day4a example `shouldBe` Right 2
+    describe "part 2" $ do
+        it "examples" $ do
+            day4b example `shouldBe` Right 4