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
-- 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)
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)
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")
projects / advent-of-code-24.git / commitdiff