advent-of-haskell-2022/solutions/Days/Day05.hs

{-# 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