Day 4

aoc2022.cabal

       Day3.Part1
       Day3.Part2
       Day3.Shared
+      Day4
+      Day4.Part1
+      Day4.Part2
+      Day4.Shared
       Lib
   other-modules:
       Paths_aoc2022
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       QuickCheck
+    , Ranged-sets
     , base >=4.7 && <5
     , containers
     , heredoc
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck
+    , Ranged-sets
     , aoc2022
     , base >=4.7 && <5
     , containers
       Day1Spec
       Day2Spec
       Day3Spec
+      Day4Spec
       Paths_aoc2022
   hs-source-dirs:
       test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck
+    , Ranged-sets
     , aoc2022
     , base >=4.7 && <5
     , containers

package.yaml

 - containers
 - split
 - lens
+- Ranged-sets
 
 ghc-options:
 - -Wall

src/Day4.hs

+module Day4 (day4) where
+
+import Day4.Part1
+import Day4.Part2
+
+day4 :: IO ()
+day4 = do
+   input <- readFile "ressources/day04-input"
+   putStrLn "Day4"
+   let score1 = countFullyOverlappingPairs input
+   putStrLn ("Number of fully overlapping section pairs " ++ show score1)
+   let score2 = countOverlappingPairs input
+   putStrLn ("Number of section pairs that overlap at all " ++ show score2)
+   return ()

src/Day4/Part1.hs

+module Day4.Part1 (
+  isFullyOverlapping,
+  countFullyOverlappingPairs
+)
+ where
+   
+import Day4.Shared
+import Data.Ranged
+
+isFullyOverlapping :: ElfPair -> Bool
+isFullyOverlapping (a, b) = a `rangeEncloses` b || b `rangeEncloses` a
+
+countFullyOverlappingPairs :: String -> Int
+countFullyOverlappingPairs input = length $ filter isFullyOverlapping pairs
+  where
+    pairs = map elfPair $ lines input

src/Day4/Part2.hs

+module Day4.Part2 (
+  countOverlappingPairs
+) where
+
+import Day4.Shared
+import Data.Ranged
+
+
+isOverlapping :: ElfPair -> Bool
+isOverlapping (a, b) = a `rangeOverlap` b || b `rangeOverlap` a
+
+countOverlappingPairs :: String -> Int
+countOverlappingPairs input = length $ filter isOverlapping pairs
+  where
+    pairs = map elfPair $ lines input
+

src/Day4/Shared.hs

+module Day4.Shared(
+  section,
+  elfPair,
+  (+=+),
+  Section,
+  ElfPair
+) where
+
+
+import Data.Ranged
+import Control.Lens
+
+type Section = Range Int
+type ElfPair = (Section, Section)
+
+(+=+) :: Int -> Int -> Range Int
+x +=+ y = Range (BoundaryBelow x) (BoundaryAbove y)
+
+section :: String -> Section
+section s = read start +=+ read end
+  where
+    (start, rest) = break ('-' ==) s
+    end = drop 1 rest
+
+
+elfPair :: String -> ElfPair
+elfPair s = over each section (first, drop 1 second)
+  where
+    (first, second) = break (',' ==) s

src/Lib.hs

     ( someFunc
     ) where
       
-import Day3      
+import Day4      
 
 someFunc :: IO ()
-someFunc = day3
+someFunc = day4
 

test/Day3Spec.hs

 
 spec :: Spec
 spec =
-  describe "Day2" $ do
+  describe "Day3" $ do
     describe "Part1" $ do
       it "can determine Rucksack compartment contents" $ do
         splitContents simpleContents `shouldBe` ("abc", "dec")

test/Day4Spec.hs

+{-# LANGUAGE QuasiQuotes #-}
+module Day4Spec (spec) where
+
+import Test.Hspec
+import Text.Heredoc
+import Day4.Part1
+import Day4.Part2
+import Day4.Shared
+
+inputPart1 :: String
+inputPart1 = [str|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 =
+  describe "Day4" $ do
+    describe "Part 1" $ do
+      it "parses section" $ do
+        section "2-4" `shouldBe` 2 +=+ 4
+      it "parses section pair" $ do
+        elfPair "2-4,6-8" ` shouldBe` (2 +=+ 4, 6 +=+ 8)
+      it "finds fully overlapping sections" $ do
+        isFullyOverlapping (3 +=+ 6, 4 +=+ 6) `shouldBe` True
+      it "counts fully overlapping pairs" $ do
+        countFullyOverlappingPairs inputPart1 `shouldBe` 2
+    describe "Part 2" $ do
+      it "counts overlapping pairs" $ do
+        countOverlappingPairs inputPart1 `shouldBe` 4
+