feat(2024/Day14)

Author: goblivend

2024/Day14/Day14.hs

@@ -0,0 +1,58 @@
+module Main where
+
+import Data.List
+import Data.Set (Set)
+import Data.Set qualified as S
+import Data.Tuple.Extra
+import System.Environment
+import Text.Regex.TDFA ((=~))
+
+type Input = Set ((Int, Int), (Int, Int))
+
+type Output = Int
+
+parseInput :: String -> Input
+parseInput = S.fromList . map parseLine . lines
+  where
+    parseLine = (\[p, v] -> (read p, read v)) . map parseTuple . words
+    parseTuple s = (\[[_, t]] -> "(" ++ t ++ ")") $ ((s =~ "=(-?[0-9]+,-?[0-9]+)") :: [[String]])
+
+moveAround :: (Int, Int) -> Input -> Input
+moveAround (w, h) = S.map moveRobot
+  where
+    moveRobot ((px, py), (vx, vy)) = (((px + vx) `mod` w, (py + vy) `mod` h), (vx, vy))
+
+getQuadrant :: (Int, Int) -> (Int, Int) -> (Bool, Bool)
+getQuadrant (w, h) (x, y) = (x <= div w 2, y <= div h 2)
+
+part1 :: (Int, Int) -> Input -> Output
+part1 wh = product . map length . groupByQuadrants . notAtCenterLines . robotsPositions
+  where
+    robotsPositions = map fst . S.toList . (!! 100) . iterate (moveAround wh)
+    midX = (fst wh) `div` 2
+    midY = (snd wh) `div` 2
+    notAtCenterLines = filter (\(x, y) -> x /= midX && y /= midY)
+    groupByQuadrants = groupBy (\e1 e2 -> snd e1 == snd e2) . sortOn snd . map (second (getQuadrant wh) . dupe)
+
+display :: (Int, Int) -> Set (Int, Int) -> [String]
+display (w, h) inp = [[if (x, y) `S.member` inp then 'x' else '.' | x <- [0 .. w]] | y <- [0 .. h]]
+
+part2 :: (Int, Int) -> Input -> Output
+part2 wh = fst . head . filter (hasLongLine . snd) . zip [0 ..] . iterate (moveAround wh)
+  where
+    hasLongLine = (=~ "x{10}") . concat . display wh . S.map fst
+
+showAftern :: (Int, Int) -> Input -> Int -> String
+showAftern wh inp n = unlines . display wh . S.map fst . (!! n) $ iterate (moveAround wh) inp
+
+main :: IO ()
+main = do
+  args <- getArgs
+  content <- readFile (last args)
+  let input = parseInput content
+  let wh = (101, 103)
+
+  print $ part1 wh input
+  print $ part2 wh input
+
+-- putStrLn . showAftern wh input $ part2 wh input

2024/Day14/Makefile

@@ -0,0 +1,28 @@
+CONTAINER_NAME=haskell-aoc
+SRC=./Day14.hs
+TARGET=Day14
+all: $(TARGET)
+
+$(TARGET): $(SRC)
+	ghc -O3 $(SRC)
+
+profile: $(SRC)
+
+
+clean:
+	$(RM) ./Day14 ./Day14.o ./Day14.hi
+
+setup: $(SRC)
+	docker cp $(SRC) $(CONTAINER_NAME):/home/haskell/Main.hs
+	docker cp input.txt $(CONTAINER_NAME):/home/haskell/input.txt
+	docker cp shortinput.txt $(CONTAINER_NAME):/home/haskell/shortinput.txt
+
+profiling: setup
+	docker exec -it $(CONTAINER_NAME) cabal build --enable-profiling
+	docker exec -it $(CONTAINER_NAME) ./profile input.txt
+
+run: setup
+	docker exec -it $(CONTAINER_NAME) cabal build
+	docker exec -it $(CONTAINER_NAME) ./run input.txt
+
+.PHONY: all $(TARGET) clean setup profiling run