Day Eight 2023 AOC

day_eight_2023.hs

{-# LANGUAGE OverloadedStrings #-}
module DayEight (module DayEight) where

import qualified Data.Text as T
import qualified Data.List as L
import qualified Text.Read as TR
import qualified Data.Maybe as M
import qualified Data.Map as DM
import qualified Data.Set as DS
import qualified Safe as S
import qualified Control.Monad as CM
import Data.Range((+=+))
import qualified Data.Range as R
import Lib (operateOnFile)

data Node = Node { leftChild :: Node, rightChild :: Node, nodeName :: T.Text }

instance Ord Node where
  left `compare` right = (nodeName left) `compare` (nodeName right)

instance Eq Node where
  a == b = (nodeName a == nodeName b)
  a /= b = (nodeName a /= nodeName b)

data InputFact = InputFact { inputName :: T.Text, leftChildName :: T.Text, rightChildName :: T.Text } deriving (Show, Eq)

data Instruction = GoLeft | GoRight deriving (Show, Eq)
parseInstruction 'L' = GoLeft
parseInstruction 'R' = GoRight

buildTree :: [InputFact] -> T.Text -> Node
buildTree facts name = buildNode name
  where findFact name = S.findJust (\fact -> (inputName fact) == name) facts
        cache :: DM.Map T.Text Node
        cache = DM.fromList $ map (\name -> (name, buildNode name)) allNames
        allNodes = map buildNode allNames
        allNames = map inputName facts
        buildNode name = Node { nodeName=name, leftChild= cache `unsafeLookup` (leftChildName found), rightChild=cache `unsafeLookup` (rightChildName found)}
          where found = findFact name
        unsafeLookup map key = M.fromJust $ DM.lookup key map

applyInstruction GoLeft n = leftChild n
applyInstruction GoRight n = rightChild n

treepath (head:rest) n = n:(treepath rest (applyInstruction head n))

treepathByName instructions facts name = treepath (cycle instructions) $ buildTree facts name


-- gives the period and offset
--cycleDescribe instructions facts name = (secondOccurrence - firstOccurrence, firstOccurrence)
--  where indexed = zip path allNums
--        allNums = cycle $ enumFromTo 0 (length instructions - 1)
--        path = map nodeName $ treepathByName instructions facts name
--        fde = firstDuplicatedEntry (DS.fromList []) indexed
--        firstOccurrence:(secondOccurrence:[]) = take 2 $ L.elemIndices fde indexed
--
--cheapPath instructions facts name = (take offset expensive) ++ (cycle (take cycleLength (drop offset expensive)))
--  where expensive = map nodeName $ treepathByName instructions facts name
--        (cycleLength, offset) = cycleDescribe instructions facts name
--
--firstDuplicatedEntry seenSoFar (head:rest)
--  | head `elem` seenSoFar = head
--  | otherwise = firstDuplicatedEntry (DS.insert head seenSoFar) rest

countStepsToEnd (instruction:rest) currentLocation
  | nodeName currentLocation == "ZZZ" = 0
  | otherwise = 1 + (countStepsToEnd rest) (applyInstruction instruction currentLocation)

testInput :: [T.Text]
testInput = ["LLR",
  "",
  "AAA = (BBB, BBB)",
  "BBB = (AAA, ZZZ)",
  "ZZZ = (ZZZ, ZZZ)"]

parseLines :: [T.Text] -> ([Instruction], [InputFact])
parseLines lines = (instructions, facts)
  where firstLine:(blank:factLines) = lines
        instructions = map parseInstruction $ T.unpack firstLine
        facts = map parseFactLine factLines
        parseFactLine line = InputFact self left right
          where self:(left:(right:_)) = filter (/= "") $ T.split (not . (`Prelude.elem` ('A' `enumFromTo` 'Z'))) line

partOne input = countStepsToEnd (cycle instructions) (buildTree facts "AAA")
  where (instructions, facts) = parseLines input


partTwo instructions facts = foldl1 lcm indices
  where startNodes = filter (\s -> T.last s == 'A') $ map inputName facts
        check startName = head $ L.findIndices (\a -> T.last a == 'Z') $ map nodeName (treepathByName  instructions facts startName)
        indices = map check startNodes