🏡 index : ~doyle/aoc.git

c54a7357943099fa423c2445ed5d8b504ce2c6c1 [patch]

0ce8bc7fc4e1c6f51ef9fda0cde6df34788555bb

a5804b6f392062589674387ee31cc67855efcb3d

c54a7357943099fa423c2445ed5d8b504ce2c6c1.tar.gz

Add day 14

Diff

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

diff --git a/aoc.hs b/aoc.hs
index 55a9494..551e349 100644
--- a/aoc.hs
+++ a/aoc.hs
@@ -21,7 +21,7 @@
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 @@
    [ 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 = '.'
diff --git a/2023/14.hs b/2023/14.hs
new file mode 100755
index 0000000..963652e 100755
--- /dev/null
+++ a/2023/14.hs
@@ -1,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