Created
December 9, 2023 14:58
-
-
Save skatenerd/d3afe28e1e86168490d3b6697717e167 to your computer and use it in GitHub Desktop.
Day Eight 2023 AOC
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment