diff --git a/2024/24-Crossed_Wires/adder.drawio.svg b/2024/24-Crossed_Wires/adder.drawio.svg new file mode 100644 index 0000000..da8dd19 --- /dev/null +++ b/2024/24-Crossed_Wires/adder.drawio.svg @@ -0,0 +1,4 @@ + + + +
x00
y00
z00
x01
y01
kjs
z01
hjp
y00
x00
xi
yi
Carry-bit-0
Carry-bit-prev
zi
Sum-bit
Carry-bit-1
Carry-bit-next
 \ No newline at end of file diff --git a/2024/24-Crossed_Wires/second.hs b/2024/24-Crossed_Wires/second.hs new file mode 100644 index 0000000..bc391d3 --- /dev/null +++ b/2024/24-Crossed_Wires/second.hs @@ -0,0 +1,142 @@ +-- requires cabal install --lib megaparsec parser-combinators heap vector +module Main (main) where + +import Control.Monad (void, when) +import Data.Functor +import qualified Data.List as L +import qualified Data.Map as M +import Data.Maybe +import Data.Ord (comparing) +import qualified Data.Set as S +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char + +import Debug.Trace + +type In = (String, Bool) +data Op = And | Or | Xor deriving (Eq, Ord, Show) +type Gate = (String, Op, String, String) +data Input = Input [In] [Gate] deriving Show + +type Parser = Parsec Void String + +parseIn :: Parser (String, Bool) +parseIn = (,) <$> some alphaNumChar <* string ": " + <*> (char '1' $> True <|> char '0' $> False) + +parseOp :: Parser Op +parseOp = string "AND" $> And + <|> string "OR" $> Or + <|> string "XOR" $> Xor + +parseGate :: Parser Gate +parseGate = (,,,) <$> some alphaNumChar <* space + <*> parseOp <* space + <*> some alphaNumChar <* string " -> " + <*> some alphaNumChar + +parseInput' :: Parser Input +parseInput' = Input <$> some (parseIn <* eol) <* eol + <*> some (parseGate <* eol) <* eof + +parseInput :: String -> IO Input +parseInput filename = do + input <- readFile filename + case runParser parseInput' filename input of + Left bundle -> error $ errorBundlePretty bundle + Right input' -> return input' + +exec And = ( && ) +exec Or = ( || ) +exec Xor = ( /= ) + +intToStringPad2 :: Int -> String +intToStringPad2 i | i < 10 = '0':show i + | otherwise = show i + +--type GatesMap = M.Map String (String, Op, String) +type GatesMap = M.Map (String, Op, String) String + +-- The gates could be in the wrong order around the operation +get :: GatesMap -> (String, Op, String) -> (GatesMap, String) +get gates g@(a, op, b) = case M.lookup g gates of + Just o -> (M.delete g gates, o) + Nothing -> let g' = (b, op, a) in case M.lookup g' gates of + Just o -> (M.delete g' gates, o) + Nothing -> trace ("gate not found: " ++ show g) undefined + +type SignalsMap = M.Map String String + +getXYs :: String -> Op -> (GatesMap, SignalsMap) -> (GatesMap, SignalsMap) +getXYs prefix op acc = L.foldl' getXY acc [0..44] + where + getXY :: (GatesMap, SignalsMap) -> Int -> (GatesMap, SignalsMap) + getXY (gates, signals) i = let is = intToStringPad2 i + (gates', s) = get gates ('x':is, op, 'y':is) + in (gates', M.insert (prefix ++ is) s signals) + +getSmbs :: (GatesMap, SignalsMap) -> (GatesMap, SignalsMap) +getSmbs = getXYs "smb" Xor + +getCarryBit0s :: (GatesMap, SignalsMap) -> (GatesMap, SignalsMap) +getCarryBit0s = getXYs "cb0" And + +solve :: (GatesMap, SignalsMap) -> (GatesMap, SignalsMap) +solve acc = L.foldl' solveOne acc [1..44] + where + solveOne :: (GatesMap, SignalsMap) -> Int -> (GatesMap, SignalsMap) + solveOne (gates, signals) i = let is = intToStringPad2 i + js = intToStringPad2 $ i - 1 + cbp = signals M.! ("cb" ++ js) + smb = signals M.! ("smb" ++ is) + cb0 = signals M.! ("cb0" ++ is) + (gates', cb1) = get gates (cbp, And, smb) + signals' = M.insert ("cb1" ++ is) cb1 signals + (gates'', cbn) = get gates' (cb1, Or, cb0) + signals'' = M.insert ("cb" ++ is) cbn signals' + in (gates'', signals'') + +swapSignals :: [Gate] -> String -> String -> [Gate] +swapSignals gates x y = let gm = M.fromList $ map (\(a, op, b, out) -> (out, (a, op, b))) gates + xo = gm M.! x + yo = gm M.! y + gm' = M.insert x yo $ M.insert y xo gm + in map (\(out, (a, op, b)) -> (a, op, b, out)) $ M.toList gm' + +-- I build the adder from the available gates, following the structure in the +-- svg file along this code. The swapSignals arguments have been determined by +-- rerunning manually this program 4 times. +-- +-- When I got a 'gate not found: ("z11",Or,"dpf")' error, I ran: +-- ``` +-- grep z11 input (base) +-- gkc AND qqw -> z11 +-- ``` +-- followed by +-- ``` +-- grep dpf input (base) +-- wpd OR dpf -> dtq +-- y11 AND x11 -> dpf +-- ``` +-- +-- The only OR operation is the oen between wpd and dpf, with dpf as a common +-- signal. The two signals to swap are therefore z11 and wpd which I add bellow. +-- Rince and repeat until all four swaps are identified. +compute :: Input -> String +compute (Input _ gates) = trace (show $ gs''') $ L.intercalate "," $ L.sort ["z11", "wpd", "skh", "jqf", "z19", "mdd", "z37", "wts"] + where + gates' = swapSignals gates "z11" "wpd" + gates'' = swapSignals gates' "skh" "jqf" + gates''' = swapSignals gates'' "z19" "mdd" + gates'''' = swapSignals gates''' "z37" "wts" + gatesMap = M.fromList $ map (\(a, op, b, out) -> ((a, op, b), out)) gates'''' + (gm, gs) = getSmbs (gatesMap, M.empty) + (gm', gs') = getCarryBit0s (gm, gs) + gs'' = M.insert "cb00" (gs' M.! "cb000") gs' + (gm'', gs''') = solve (gm', gs'') + +main :: IO () +main = do + input <- parseInput "input" + print $ compute input