From c54a7357943099fa423c2445ed5d8b504ce2c6c1 Mon Sep 17 00:00:00 2001
From: Jordan Doyle <jordan@doyle.la>
Date: Thu, 21 Dec 2023 14:13:57 +0000
Subject: [PATCH] Add day 14

---
 2023/14.hs | 43 +++++++++++++++++++++++++++++++++++++++++++
 aoc.hs     | 27 ++++++++++++++++++++++++++-
 2 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100755 2023/14.hs

diff --git a/2023/14.hs b/2023/14.hs
new file mode 100755
index 0000000..963652e
--- /dev/null
+++ b/2023/14.hs
@@ -0,0 +1,43 @@
+#!/usr/bin/env nix-shell
+#!nix-shell --pure -i "runghc -- -i../" -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"
+
+import Aoc (parseMultiChoiceGrid, readAndParseStdin)
+import Data.List (findIndices, transpose)
+import Data.Maybe (isJust, isNothing)
+
+main = do
+  input <- readAndParseStdin parseMultiChoiceGrid
+  print $ part1 input
+  print $ part2 input
+
+part1 :: [[Maybe Bool]] -> Int
+part1 = countScore . tiltNorth
+
+part2 :: [[Maybe Bool]] -> Int
+part2 = countScore . spinCycle 1000
+  where
+    spinCycle 0 acc = acc
+    spinCycle n acc = spinCycle (n - 1) ((tiltEast . tiltSouth . tiltWest . tiltNorth) acc)
+
+countScore :: [[Maybe Bool]] -> Int
+countScore [] = 0
+countScore (x : xs) = length (filter (== Just True) x) * (length xs + 1) + countScore xs
+
+tiltNorth :: [[Maybe Bool]] -> [[Maybe Bool]]
+tiltNorth = transpose . map (move [] 0) . transpose
+  where
+    move :: [Maybe Bool] -> Int -> [Maybe Bool] -> [Maybe Bool]
+    move acc _ [] = acc
+    move acc lastSeenJust (x : xs)
+      | x == Just True = move (take lastSeenJust acc ++ x : drop lastSeenJust acc) (lastSeenJust + 1) xs
+      | x == Just False = move (acc ++ [x]) (length acc + 1) xs
+      | isNothing x = move (acc ++ [x]) lastSeenJust xs
+
+tiltWest :: [[Maybe Bool]] -> [[Maybe Bool]]
+tiltWest = transpose . tiltNorth . transpose
+
+tiltEast :: [[Maybe Bool]] -> [[Maybe Bool]]
+tiltEast = transpose . reverse . tiltNorth . reverse . transpose
+
+tiltSouth :: [[Maybe Bool]] -> [[Maybe Bool]]
+tiltSouth = reverse . tiltNorth . reverse
diff --git a/aoc.hs b/aoc.hs
index 55a9494..551e349 100644
--- a/aoc.hs
+++ b/aoc.hs
@@ -21,7 +21,7 @@ parseMultipleGrids = parseGrid `sepBy` string "\n"
 parseGrid :: Parser [[Bool]]
 parseGrid = parseGridRow `endBy` char '\n'
 
--- parse an incoming grow
+-- parse an incoming row
 parseGridRow :: Parser [Bool]
 parseGridRow = many1 parseGridTile
 
@@ -32,3 +32,28 @@ parseGridTile =
     [ True <$ char '#',
       False <$ char '.'
     ]
+
+-- parse an entire multichoice grid
+parseMultiChoiceGrid :: Parser [[Maybe Bool]]
+parseMultiChoiceGrid = parseMultiChoiceGridRow `endBy` char '\n'
+
+-- parse an incoming row
+parseMultiChoiceGridRow :: Parser [Maybe Bool]
+parseMultiChoiceGridRow = many1 parseMultiChoiceGridTile
+
+-- parse a single multi-choice tile on a grid
+parseMultiChoiceGridTile :: Parser (Maybe Bool)
+parseMultiChoiceGridTile =
+  choice
+    [ Just True <$ char 'O',
+      Just False <$ char '#',
+      Nothing <$ char '.'
+    ]
+
+-- debugging for multi-choice tile grids
+printMultiChoiceGrid :: [[Maybe Bool]] -> IO ()
+printMultiChoiceGrid xs = putStrLn $ unlines $ (map . map) multiChoiceGridTileChar xs
+  where
+    multiChoiceGridTileChar (Just True) = 'O'
+    multiChoiceGridTileChar (Just False) = '#'
+    multiChoiceGridTileChar Nothing = '.'
--
libgit2 1.7.2