From 5d2559af06957d610d0eb12f556cc9a727a6375e Mon Sep 17 00:00:00 2001 From: germax26 Date: Tue, 3 Dec 2024 04:45:27 +1100 Subject: [PATCH] 2015 Day 07 in Haskell --- 2015/day07/day07.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++ aoc.hs | 23 +++++++++++++++++----- 2 files changed, 66 insertions(+), 5 deletions(-) create mode 100644 2015/day07/day07.hs diff --git a/2015/day07/day07.hs b/2015/day07/day07.hs new file mode 100644 index 0000000..ba042d4 --- /dev/null +++ b/2015/day07/day07.hs @@ -0,0 +1,48 @@ +import Aoc +import Data.Char ( isDigit ) +import Data.Bits + +data Op = AND | OR | SHIFTL | SHIFTR | NOT | CONST + deriving (Show, Eq) + +parseFile :: [String] -> [(String, (Op, String, String))] -- [(out, (op, arg1, arg2))] +parseFile = map (\line -> + let (expr, ["->", out]) = lastSplit 2 $ words line in + (out, case expr of + [arg1, "AND", arg2] -> (AND, arg1, arg2) + [arg1, "OR", arg2] -> (OR, arg1, arg2) + [arg1, "LSHIFT", arg2] -> (SHIFTL, arg1, arg2) + [arg1, "RSHIFT", arg2] -> (SHIFTR, arg1, arg2) + ["NOT", arg] -> (NOT, arg, "") + [arg] -> (CONST, arg, ""))) + +eval :: Op -> Int -> Int -> Int +eval OR = (.|.) +eval AND = (.&.) +eval SHIFTR = shiftR +eval SHIFTL = shiftL +eval CONST = const +eval NOT = \a _-> complement a + +eval' :: Op -> Int -> Int -> Int +eval' op arg1 arg2 = (.&. 0xFFFF) $ eval op arg1 arg2 + +eval'' :: [(String, (Op, String, String))] -> [(String, Int)] -> String -> (Int, [(String, Int)]) +eval'' wires memos label = case lookup label memos of + Just value -> (value, memos) + Nothing -> case lookup label wires of + Just (op, arg1, arg2) -> + let (val1, memos1) = eval'' wires memos arg1 in + let (val2, memos2) = eval'' wires memos1 arg2 in + let val = eval' op val1 val2 in + (val, (label, val):memos2) + Nothing -> (if all isDigit label then read label else undefined, memos) -- if null label then 0 else + +part1 :: [(String, (Op, String, String))] -> Int +part1 wires = fst $ eval'' wires [] "a" + +part2 :: [(String, (Op, String, String))] -> Int -> Int +part2 wires part1Answer = fst $ eval'' wires [("b", part1Answer)] "a" + +main :: IO () +main = aocMain' parseFile (passthrough . part1) part2 \ No newline at end of file diff --git a/aoc.hs b/aoc.hs index d88ed29..57c327d 100644 --- a/aoc.hs +++ b/aoc.hs @@ -1,12 +1,22 @@ module Aoc where -aocMain :: Show p => ([String] -> p) -> (p -> Int) -> (p -> Int) -> IO () -aocMain parseFile part1 part2 = do +aocMain' :: (Show p, Show a) => ([String] -> p) -> (p -> (a, c)) -> (p -> c -> a) -> IO () +aocMain' parseFile part1 part2 = do contents <- readFile "input.txt" let input = parseFile $ lines contents - -- putStrLn $ "Input: " ++ show input - putStrLn $ "Part 1: " ++ show (part1 input) - putStrLn $ "Part 2: " ++ show (part2 input) + let (part1Answer, data') = part1 input + putStrLn $ "Part 1: " ++ show part1Answer + let part2Answer = part2 input data' + putStrLn $ "Part 2: " ++ show part2Answer + +passthrough :: a -> (a, a) +passthrough a = (a, a) + +aocMain :: Show p => ([String] -> p) -> (p -> Int) -> (p -> Int) -> IO () +aocMain parseFile part1 part2 = aocMain' parseFile ((,()) . part1) (const' part2) + +const' :: (a -> b) -> a -> c -> b +const' f a _ = f a enumerate :: [a] -> [(Int, a)] enumerate xs = zip [0..length xs] xs @@ -25,3 +35,6 @@ single as = let [a] = as in a both :: (a -> b) -> (a, a) -> (b, b) both f (a, b) = (f a, f b) + +lastSplit :: Int -> [a] -> ([a], [a]) +lastSplit n as = splitAt (length as - n) as \ No newline at end of file