142 lines
5.5 KiB
Haskell
142 lines
5.5 KiB
Haskell
-- 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
|