2015/day07/day07.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
-
 import Aoc
 import Data.Char ( isDigit )
 import Data.Bits
@@ -24,27 +22,27 @@ eval AND = (.&.)
 eval SHIFTR = shiftR
 eval SHIFTL = shiftL
 eval CONST = const
-eval NOT = const' complement
+eval NOT = \a _-> complement a
 
-evalM :: [(String, (Op, String, String))] -> MemoF String Int
-evalM wires = memoise $ \values label ->
-    case lookup label wires of
+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 
-                (arg1', values') = evalM wires values arg1 
-                (arg2', values'') = evalM wires values' arg2
-            in
-                (eval op arg1' arg2' .&. 0xFFFF, values'')
-        Nothing ->
-            if all isDigit label 
-                then (read label, values)
-                else error label
+            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 = unmemo (evalM wires) "a"
+part1 wires = fst $ eval'' wires [] "a"
 
 part2 :: [(String, (Op, String, String))] -> Int -> Int
-part2 wires part1Answer = fst $ evalM wires [("b", part1Answer)] "a"
+part2 wires part1Answer = fst $ eval'' wires [("b", part1Answer)] "a"
 
 main :: IO ()
 main = aocMain' parseFile (dup . part1) part2

2024/day05/day05.hs

@@ -1,45 +0,0 @@
-import Aoc
-import Data.List.Split ( splitOn )
-import Control.Arrow ( second, first )
-import Data.List ( nub, partition, sort )
-import Data.Maybe ( fromMaybe )
-
-parseFile :: [String] -> ([(Int, [Int])], [[Int]])
-parseFile lines =
-    let 
-        [rules, pages] = splitOn [""] lines
-        rules' = map (pair . map read . splitOn "|") rules
-        mentioned = nub $ concatMap unpair rules'
-        getAll a = map snd $ filter ((==a) . fst) rules' 
-    in
-    (zip mentioned (map getAll mentioned), map (map read . splitOn ",") pages)
-    
-takeMiddle :: [a] -> a
-takeMiddle xs = xs !! (length xs `div` 2)
-
-isSafe :: [(Int, [Int])] -> [Int] -> Bool
-isSafe rules = fst . foldl isSafe' (True, [])
-    where
-        isSafe' (False, prev) _ = (False, prev)
-        isSafe' (True, prev) a = (fromMaybe True $ not . any (`elem` prev) <$> lookup a rules, a:prev)
-
-part1 :: ([(Int, [Int])], [[Int]]) -> (Int, [[Int]])
-part1 (rules, pages) = first (sum . map takeMiddle) $ partition (isSafe rules) pages
-
-part2 :: ([(Int, [Int])], [[Int]]) -> [[Int]] -> Int
-part2 (rules, _) = sum . map (takeMiddle . reorder)
-    where
-        getPosM rules = memoise $ \values n ->
-            let ns = fromMaybe [] $ lookup n rules in
-            if null ns 
-                then (0, values)
-                else
-                    let (ns', values') = memoMap (getPosM rules) values ns in
-                    (maximum ns' + 1, values')
-
-        reorder ns =
-            let rules' = map (second $ filter (`elem` ns)) $ filter ((`elem` ns) . fst) rules in
-            map snd $ sort $ zip (unmemo (memoMap $ getPosM rules') ns) ns
-
-main :: IO ()
-main = aocMain' parseFile part1 part2

aoc.hs

@@ -60,8 +60,6 @@ starsAndBars 0 b = [replicate (b+1) 0]
 starsAndBars n 0 = [[n]]
 starsAndBars n b = map (0:) (starsAndBars n (b-1)) ++ map (\xs -> head xs + 1 : tail xs) (starsAndBars (n-1) b)
 
--- Kernel
-
 kernelMapRow' :: ([[a]] -> b) -> Maybe a -> [a] -> [a] -> [a] -> [b]
 kernelMapRow' kernel x
     (a:r0@(b:c:_))
@@ -83,23 +81,3 @@ kernelMap' kernel Nothing [_, _] = []
 kernelMap :: ([[a]] -> b) -> Maybe a -> [[a]] -> [[b]]
 kernelMap kernel (Just x) as = kernelMap' kernel (Just x) ((map (const x) (head as)):as)
 kernelMap kernel Nothing as = kernelMap' kernel Nothing as
-
--- Memoisation
-
-type MemoF' a b a' b' = Eq a' => [(a', b')] -> a -> (b, [(a', b')])
-type MemoF a b = MemoF' a b a b
-
-memoise :: Eq a => MemoF a b -> MemoF a b
-memoise f values a = case lookup a values of
-    Just b -> (b, values)
-    Nothing -> let (b, values') = f values a in (b, (a, b):values')
-
-memoMap :: MemoF' a b a' b' -> MemoF' [a] [b] a' b'
-memoMap f values [] = ([], values)
-memoMap f values (a:as) =
-    let (b, values') = f values a in
-    let (bs, values'') = memoMap f values' as in
-    (b:bs, values'')
-
-unmemo :: Eq a' => MemoF' a b a' b' -> a -> b
-unmemo f = fst . f []