Day 14 but kind of shitty

advent-of-code-2023.cabal

@@ -108,3 +108,11 @@ executable day13
     build-depends:    base ^>=4.15.1.0, array
     hs-source-dirs:   day13
     default-language: Haskell2010
+
+executable day14
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, array
+    hs-source-dirs:   day14
+    default-language: Haskell2010

day14/Commons.hs

@@ -0,0 +1,37 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Array (Array, listArray, bounds, (!), (//))
+
+
+data Tile = Empty | Round | Square deriving (Eq, Show)
+type Platform = Array (Int, Int) Tile
+
+
+parseLine :: String -> [Tile]
+parseLine [] = []
+parseLine ('O': t) = Round: parseLine t
+parseLine ('#': t) = Square: parseLine t
+parseLine ('.': t) = Empty: parseLine t
+
+parsePlatform :: IO [[Tile]]
+parsePlatform = do done <- isEOF
+                   if done
+                      then return []
+                      else do line <- getLine
+                              let platformLine = parseLine line
+                              platform <- parsePlatform
+                              return (platformLine: platform)
+
+parse :: IO Platform
+parse = do platform <- parsePlatform
+           return (listArray ((1, 1), (length platform, length $ head platform)) $ concat platform)
+
+
+tilt :: (Int, Int) -> [(Int, Int)] -> Platform -> Platform
+tilt _ [] platform = platform
+tilt (yI, xI) ((y, x): t) platform
+  | let (y2, x2) = (y + yI, x + xI)
+    in y2 > 0 && y2 <= fst (snd $ bounds platform) && x2 > 0 && x2 <= snd (snd $ bounds platform)
+       && platform ! (y2, x2) == Empty = tilt (yI, xI) ((y + yI, x + xI): t) $ platform // [((y, x), Empty)]
+  | otherwise                          = tilt (yI, xI) t $ platform // [((y, x), Round)]

day14/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do platform <- parse
+          let part1Res = Part1.getLoads platform
+          print $ sum part1Res
+          let part2Res = Part2.getLoads platform
+          print $ sum part2Res

day14/Part1.hs

@@ -0,0 +1,11 @@
+module Part1 where
+
+import Commons
+import Data.Array (bounds, assocs)
+
+
+getLoads :: Platform -> [Int]
+getLoads platform =
+  let (yMax, _) = snd $ bounds platform
+      tiltedPlatform = tilt (-1, 0) (map fst $ filter (\ (_, r) -> r == Round) $ assocs platform) platform
+  in map (\ ((y, _), r) -> if r == Round then yMax + 1 - y else 0) $ assocs tiltedPlatform

day14/Part2.hs

@@ -0,0 +1,40 @@
+module Part2 where
+
+import Commons
+import Data.Array (bounds, assocs)
+import Data.List (sortBy, elemIndices)
+
+
+tiltNorth :: Platform -> Platform
+tiltNorth platform = tilt (-1, 0) (map fst $ filter (\ (_, r) -> r == Round) $ assocs platform) platform
+
+tiltWest :: Platform -> Platform
+tiltWest platform = tilt (0, -1) (sortBy (\ (y1, x1) (y2, x2) -> if x1 < x2 then LT else GT) $ map fst
+                    $ filter (\ (_, r) -> r == Round) $ assocs platform) platform
+
+tiltSouth :: Platform -> Platform
+tiltSouth platform = tilt (1, 0) (reverse $ map fst $ filter (\ (_, r) -> r == Round) $ assocs platform) platform
+
+tiltEast :: Platform -> Platform
+tiltEast platform = tilt (0, 1) (sortBy (\ (y1, x1) (y2, x2) -> if x1 > x2 then LT else GT) $ map fst
+                    $ filter (\ (_, r) -> r == Round) $ assocs platform) platform
+
+applyCycles :: [Platform] -> Platform -> [Platform]
+applyCycles history platform
+  | history /= [] && platform `elem` tail history = history
+  | otherwise = let newPlatform = tiltEast $ tiltSouth $ tiltWest $ tiltNorth platform
+                in applyCycles (newPlatform: history) newPlatform
+
+
+
+getExpectedIndex :: [Platform] -> Int
+getExpectedIndex history = let endIndex = length history
+                               startIndex = endIndex - last (elemIndices (head history) history)
+                           in endIndex - (((1000000000 - startIndex) `mod` (endIndex - startIndex)) + startIndex)
+
+getLoads :: Platform -> [Int]
+getLoads platform =
+  let (yMax, _) = snd $ bounds platform
+      cyclesHistory = applyCycles [] platform
+  in map (\ ((y, _), r) -> if r == Round then yMax + 1 - y else 0)
+     $ assocs (cyclesHistory !! getExpectedIndex cyclesHistory)