You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
63 lines
2.1 KiB
Haskell
63 lines
2.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Days.Day05 (day05) where
|
|
|
|
import AOC (Solution (..))
|
|
import Data.Char
|
|
import Data.List qualified as L
|
|
import Data.List.Split qualified as S
|
|
import Data.Text qualified as T
|
|
|
|
-- 1. How many crates to move
|
|
-- 2. The stack to move crates from
|
|
-- 3. The stack to move crates to
|
|
type Instruction = (Int, Int, Int)
|
|
|
|
mapTuple :: (a -> b) -> (a, a, a) -> (b, b, b)
|
|
mapTuple f (a1, a2, a3) = (f a1, f a2, f a3)
|
|
|
|
replaceNth :: Int -> a -> [a] -> [a]
|
|
replaceNth _ _ [] = []
|
|
replaceNth n newVal (x : xs)
|
|
| n == 0 = newVal : xs
|
|
| otherwise = x : replaceNth (n - 1) newVal xs
|
|
|
|
day05 :: Solution
|
|
day05 = Solution parseInput part1 part2
|
|
|
|
parseInput :: T.Text -> ([String], [Instruction])
|
|
parseInput input = (cleanStacks, intInsts)
|
|
where
|
|
[crates, insts] = S.splitOn "\n\n" (T.unpack input)
|
|
inst = filter (not . null) $ map (filter isDigit) (words insts)
|
|
intInsts = map (\[one, two, three] -> mapTuple read (one, two, three)) (S.chunksOf 3 inst)
|
|
stacks = init $ lines crates
|
|
cleanStacks = map concat $ L.transpose $ map (map filtered . S.chunksOf 4) stacks
|
|
filtered xs = [xs !! 1 | xs !! 1 /= ' ']
|
|
|
|
part1 :: ([String], [Instruction]) -> String
|
|
part1 (stacks, instructions) = map head (foldl logic stacks instructions)
|
|
where
|
|
logic :: [String] -> Instruction -> [String]
|
|
logic stacks' (num, from, to) = replacedStacks
|
|
where
|
|
to' = to - 1
|
|
from' = from - 1
|
|
sFrom = stacks' !! from'
|
|
sTo = stacks' !! to'
|
|
taken = replaceNth from' (drop num sFrom) stacks'
|
|
replacedStacks = replaceNth to' (reverse (take num sFrom) ++ sTo) taken
|
|
|
|
part2 :: ([String], [Instruction]) -> String
|
|
part2 (stacks, instructions) = map head (foldl logic stacks instructions)
|
|
where
|
|
logic :: [String] -> Instruction -> [String]
|
|
logic stacks' (num, from, to) = replacedStacks
|
|
where
|
|
to' = to - 1
|
|
from' = from - 1
|
|
sFrom = stacks' !! from'
|
|
sTo = stacks' !! to'
|
|
taken = replaceNth from' (drop num sFrom) stacks'
|
|
replacedStacks = replaceNth to' (take num sFrom ++ sTo) taken
|