From 38a19b321a0477663cb8066d511fc831bee8278b Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sun, 29 Dec 2024 10:25:27 +0000 Subject: [PATCH] Done day 24 --- advent24/Main.hs | 162 ++++++++++++++++++++++++++++++++++++++++++++-- advent24/notes.hs | 30 +++++++++ 2 files changed, 187 insertions(+), 5 deletions(-) create mode 100644 advent24/notes.hs diff --git a/advent24/Main.hs b/advent24/Main.hs index b33ddd0..17c5266 100644 --- a/advent24/Main.hs +++ b/advent24/Main.hs @@ -9,18 +9,23 @@ import Control.Applicative import qualified Data.Map.Strict as M import qualified Data.Set as S import Data.List -import Data.Bits (xor, (.&.), (.|.), (.<<.)) +import Data.Bits (xor, (.&.), (.|.), (.<<.), bit, testBit) +import Data.Tree +import Data.Maybe +import Data.Char type Wires = M.Map String Int -data GateType = And | Or | Xor - deriving (Show, Eq) +data GateType = And | Or | Xor + deriving (Show, Eq, Ord) data Gate = Gate { gType :: GateType, inputs :: [String], output :: String } - deriving (Show, Eq) + deriving (Show, Eq, Ord) type Device = [Gate] +type DeviceTree = Tree Gate + main :: IO () main = do dataFileName <- getDataFileName @@ -31,10 +36,30 @@ main = -- print $ simulate wires device -- print $ wiresOutput $ simulate wires device print $ part1 wires device + putStrLn part2 + +rd :: IO (Wires, Device) +rd = do + text <- TIO.readFile "../data/advent24.txt" + return $ successfulParse text + +rdn :: IO Device +rdn = do + text <- TIO.readFile "../data/advent24.txt" + let (_, device) = successfulParse text + let r1 = swapWires "vss" "z14" device + let r2 = swapWires "kdh" "hjf" r1 + let r3 = swapWires "z31" "kpp" r2 + let r4 = swapWires "z35" "sgj" r3 + return $ renamings r4 + part1 :: Wires -> Device -> Int part1 wires device = wiresOutput $ simulate wires device +part2 = intercalate "," $ sort ["vss", "z14", "kdh", "hjf", "z31", "kpp", "z35", "sgj"] + + simulate :: Wires -> Device -> Wires simulate wires device = wires' where (wires', []) = until (null . snd) simulateOnce (wires, device) @@ -65,6 +90,133 @@ wiresOutput wires = M.foldlWithKey' go 0 outWires outShift w = read $ drop 1 w go acc w v = acc .|. (v .<<. outShift w) +unfoldFromWire :: Device -> String -> DeviceTree +unfoldFromWire device wire = + unfoldTree unfoldDevice (device, fromJust $ gateForWire device wire) + +unfoldDevice :: (Device, Gate) -> (Gate, [(Device, Gate)]) +unfoldDevice (device, gate) = + ( gate + , fmap (\g -> (device, g)) feedGates + ) + where feedGates = sort $ catMaybes $ fmap (gateForWire device) gate.inputs + + +showFragment :: DeviceTree -> IO () +showFragment t = putStrLn $ unlines $ take 15 $ lines $ drawTree $ fmap show t + +gateForWire :: Device -> String -> Maybe Gate +gateForWire device wire = find ((== wire) . output) device + +setInputs :: Int -> Int -> Wires +setInputs x y = M.union (bitsOf "x" x) (bitsOf "y" y) + +bitsOf :: String -> Int -> Wires +bitsOf p n = M.fromList [(p ++ (show2d i), testBitI n i) | i <- [0..44]] + +testBitI n i + | testBit n i = 1 + | otherwise = 0 + +show2d :: Int -> String +show2d n | length (show n) == 1 = "0" ++ (show n) + | otherwise = show n + + +equivalentTree :: DeviceTree -> DeviceTree -> Bool +equivalentTree (Node (Gate g1 i1 _) []) (Node (Gate g2 i2 _) []) = + g1 == g2 && i1 == i2 +equivalentTree (Node (Gate g1 _ _) sub1@(_:_)) + (Node (Gate g2 _ _) sub2@(_:_)) = + g1 == g2 && ( (all (uncurry equivalentTree) $ zip sub1 sub2) + || (all (uncurry equivalentTree) $ zip sub1 (reverse sub2)) + ) +equivalentTree _ _ = False + + +makeAdder :: Int -> String -> Int -> DeviceTree +makeAdder 0 o _ = Node {rootLabel = Gate {gType = Xor, inputs = ["x00","y00"], output = o}, subForest = []} +makeAdder depth o n = Node {rootLabel = Gate {gType = Xor, inputs = [n0, n1], output = o}, subForest = [gAdd, gCarry]} + where gAdd = Node {rootLabel = Gate {gType = Xor, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n0}, subForest = []} + gCarry = makeCarry (depth-1) n1 (n + 2) + n0 = nonceStr n + n1 = nonceStr (n+1) + +makeCarry :: Int -> String -> Int -> DeviceTree +makeCarry 0 o _ = Node {rootLabel = Gate {gType = And, inputs = ["x00","y00"], output = o}, subForest = []} +makeCarry depth o n = Node {rootLabel = Gate {gType = Or, inputs = [n0, n1], output = o}, subForest = [c0, c1]} + where c0 = Node {rootLabel = Gate {gType = And, inputs = [n2, n3], output = n0}, subForest = [c2, c3]} + c1 = Node {rootLabel = Gate {gType = And, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n1}, subForest = []} + c2 = makeCarry (depth-1) n2 (n + 4) + c3 = Node {rootLabel = Gate {gType = Xor, inputs = ["x" ++ show2d depth,"y" ++ show2d depth], output = n3}, subForest = []} + n0 = nonceStr n + n1 = nonceStr (n+1) + n2 = nonceStr (n+2) + n3 = nonceStr (n+3) + +nonceStr :: Int -> String +nonceStr n = "n" ++ show n + +codeOfName :: String -> Int +codeOfName s -- = read . filter isDigit + | null ds = 1000 + | otherwise = read ds + where ds = filter isDigit s + +swapWires :: String -> String -> Device -> Device +swapWires w1 w2 = renameOutput "swap" w2 . renameOutput w2 w1 . renameOutput w1 "swap" + where renameOutput from to = fmap rename + where rename (Gate g i o) = Gate g i (renameName o) + renameName n | n == from = to + | otherwise = n + +renameWire :: String -> String -> Device -> Device +renameWire from to = fmap rename + where rename (Gate g i o) = Gate g (fmap renameName i) (renameName o) + renameName n | n == from = to + | otherwise = n + +existingOutput :: GateType -> String -> String -> Device -> Maybe String +existingOutput gType i1 i2 device + | null gates = Nothing + | otherwise = Just $ output $ head gates + where + f (Gate g i _o) = g == gType && i1 `elem` i && i2 `elem` i + gates = filter f device + +renameAll :: GateType -> String -> String -> String -> Device -> Device +renameAll gType i1 i2 newO device = + case mo of + Nothing -> device + Just o -> renameWire o newO device + where mo = existingOutput gType i1 i2 device + +renameAllN :: GateType -> String -> String -> String -> Int -> Device -> Device +renameAllN gType p1 p2 po n device = renameAll gType i1 i2 pn device + where i1 = p1 ++ show2d n + i2 = p2 ++ show2d n + pn = po ++ show2d n + +renameCarryI :: Int -> Device -> Device +renameCarryI n device = renameAll And ("xor" ++ show2d n) ("carry" ++ show2d (n-1)) ("int_carry" ++ show2d n) device + +renameCarry :: Device -> Int -> Device +renameCarry device n = d2 + where d1 = renameCarryI n device + d2 = renameAll Or ("int_carry" ++ show2d n) ("and" ++ show2d n) ("carry" ++ show2d n) d1 + +renamings :: Device -> Device +renamings device = d5 + where + d1 = foldr (renameAllN Xor "x" "y" "xor") device [0..44] + d2 = foldr (renameAllN And "x" "y" "and") d1 [0..44] + d3 = foldr (renameAllN Or "x" "y" "or") d2 [0..44] + d4 = renameWire "and00" "carry00" d3 + d5 = foldl renameCarry d4 [1..44] + +stf tree = putStrLn $ unlines $ take 15 $ lines $ drawTree $ fmap show tree + + -- parse the input file wiresDeviceP :: Parser (Wires, Device) @@ -84,7 +236,7 @@ nameP = many1 (letter <|> digit) deviceP = gateP `sepBy` endOfLine gateP = gateify <$> nameP <* space <*> gateTypeP <* space <*> nameP <* string " -> " <*> nameP - where gateify i1 g i2 o = Gate g [i1, i2] o + where gateify i1 g i2 o = Gate g (sort [i1, i2]) o gateTypeP = (And <$ "AND") <|> (Or <$ "OR") <|> (Xor <$ "XOR") diff --git a/advent24/notes.hs b/advent24/notes.hs new file mode 100644 index 0000000..15a6bec --- /dev/null +++ b/advent24/notes.hs @@ -0,0 +1,30 @@ +(wires, device) <- rd +putStrLn $ drawTree $ fmap show $ unfoldFromWire device "z01" +filter (not . snd) [(xi, (bit xi) == part1 (setInputs 0 (bit xi)) device) | xi <- [0..44] ] +equivalentTree (unfoldFromWire device "z01") (unfoldFromWire device "z01") + + +filter not [ (x + y) == part1 (setInputs x y) device | x <- [0..127] , y <- [0..127] ] + +equivalentTree ( unfoldFromWire device "z02") (makeAdder 2 "o1" 0) + +putStrLn $ drawTree $ fmap show $ (makeAdder 2 "o1" 0) + +[ (k, equivalentTree ( unfoldFromWire device ("z" ++ show2d k)) (makeAdder k "o1" 0)) | k <- [0..15] ] + +putStrLn $ unlines $ take 15 $ lines $ drawTree $ fmap show $ unfoldFromWire device "z14" +putStrLn $ unlines $ take 15 $ lines $ drawTree $ fmap show $ makeAdder 14 "o1" 0 + + +filter ((elem "carry01") . inputs) $ renamings device +filter ((== "vss") . output) $ renamings device + + + +ghci> putStrLn $ unlines $ fmap show $ sortOn (codeOfName . head . inputs) $ renamings $ swapWires "vss" "z14" device + +putStrLn $ unlines $ fmap show $ sortOn (codeOfName . head . inputs) $ device + + + + -- 2.34.1