days 20-24 (day 24 excluded for input confidentiality)

.gitignore

@@ -1,3 +1,4 @@
 **/input.txt
 **/input2.txt
 6/day-six
+24/*

20/solution.hs

@@ -38,10 +38,10 @@ toSquare 'S' = Just Square {visited=False, distance=Nothing, start=True,  end=Fa
 toSquare 'E' = Just Square {visited=True,  distance=Just 0,  start=False, end=True}
 toSquare _ = Nothing
 
---partial!
 splitInput :: String -> [[Char]]
 splitInput = split "\n"
 
+--partial!
 buildArray :: [[Char]] -> (Array (Int, Int) Square)
 buildArray grid = listArray ((0, 0), ((length grid)-1, (length (grid!!0))-1)) . concat . map (map (fromJust . toSquare)) $ grid
 

21/solution.hs

@@ -0,0 +1,107 @@
+import Data.List
+import Data.Maybe
+import Data.Array
+import Debug.Trace
+import Data.Function.Memoize
+
+traceOut :: Show a => a -> a
+traceOut x = (traceShow x x)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = ([x] ++ y) : ys
+
+split :: Eq a => [a] -> [a] -> [[a]]
+split _ [] = []
+split delims (x:xs)
+  | elem x delims = [[]] ++ split delims xs
+  | otherwise     = addFirst (split delims xs) x
+
+--    y ->
+-- x
+-- |
+-- v
+
+data Direction = DNothing | DUp | DDown | DLeft | DRight deriving (Enum, Eq, Ord, Ix, Bounded)
+instance Show Direction where
+    show DNothing = "A"
+    show DUp = "^"
+    show DDown = "v"
+    show DLeft = "<"
+    show DRight = ">"
+instance Memoizable Direction where memoize = memoizeFinite
+
+pathAvoid :: (Int, Int) -> (Int, Int) -> (Int, Int) -> [[Direction]]
+pathAvoid (a, b) (c, d) (x, y) = if (x == c) && (abs(d-y) <= abs(d-b)) then [(take (abs (c-a)) $ repeat dx) ++ (take (abs (d-b)) $ repeat dy)]
+                            else if (y == d) && (abs(c-x) <= abs(c-a)) then [(take (abs (d-b)) $ repeat dy) ++ (take (abs (c-a)) $ repeat dx)]
+                            else nub [(take (abs (c-a)) $ repeat dx) ++ (take (abs (d-b)) $ repeat dy), (take (abs (d-b)) $ repeat dy) ++ (take (abs (c-a)) $ repeat dx)]
+    where xcomp = compare a c
+          ycomp = compare b d
+          dx = case xcomp of
+              EQ -> DNothing
+              LT -> DUp
+              GT -> DDown
+          dy = case ycomp of
+              EQ -> DNothing
+              LT -> DLeft
+              GT -> DRight
+
+numpad = array ('0', 'A') [('0', (3, 1)),
+                           ('1', (2, 0)),
+                           ('2', (2, 1)),
+                           ('3', (2, 2)),
+                           ('4', (1, 0)),
+                           ('5', (1, 1)),
+                           ('6', (1, 2)),
+                           ('7', (0, 0)),
+                           ('8', (0, 1)),
+                           ('9', (0, 2)),
+                           ('A', (3, 2))]
+
+dirpad = array (DNothing, DRight) [(DNothing, (0, 2)),
+                                   (DUp,      (0, 1)),
+                                   (DDown,    (1, 1)),
+                                   (DLeft,    (1, 0)),
+                                   (DRight,   (1, 2))]
+
+memopath = memoize3 pathAvoid
+
+--partial!
+path :: Ix a => (Int, Int) -> Array a (Int, Int) -> a -> [a] -> [[Direction]]
+path _ _ _ [] = []
+path avoid pad a (x:[]) = map (++[DNothing]) $ memopath (pad!x) (pad!a) avoid
+path avoid pad a (x:y:xs) = [p ++ [DNothing] ++ q | p <- memopath (pad!x) (pad!a) avoid, q <- path avoid pad x (y:xs)]
+
+memopath2 = memoize (path (0, 0) dirpad DNothing)
+
+path' :: Int -> [Direction] -> Int
+path' 0 = length
+path' n = sum . map (min1 . map (memopath' (n-1)) . memopath2) . map (\x -> x ++ [DNothing]) . memosplit
+
+memosplit = memoize (split [DNothing])
+
+splitInput :: String -> [String]
+splitInput = split "\n"
+
+--partial!
+min1 :: Ord a => [a] -> a
+min1 xs = foldl1 (\a b -> if a < b then a else b) xs
+
+solve1 :: [(Int, [[Direction]])] -> Int
+solve1 [] = 0
+solve1 ((x, dirs):xs) = (min1 $ map length $ foldl (.) id (take 2 $ repeat (concat . map (path (0, 0) dirpad DNothing))) dirs)*x  + solve1 xs
+
+solve2 :: [(Int, [[Direction]])] -> Int
+solve2 = sum . map (\(x, dirs) -> x*(min1 $ map (memopath' 25) dirs))
+
+memopath' = memoize2 path'
+
+main :: IO()
+main = do
+       fileinp <- readFile "input.txt"
+       let parsed = splitInput fileinp
+       let dirs :: [(Int, [[Direction]])] = map (\x -> (read $ init x, path (3, 0) numpad 'A' x)) parsed
+       let solved1 = solve1 dirs
+       let solved2 = solve2 dirs
+       print solved1
+       print solved2

22/solution.hs

@@ -0,0 +1,74 @@
+import Data.List
+import Data.Bits
+import Data.Maybe
+import Data.Function.Memoize
+import Debug.Trace
+import Control.Parallel.Strategies
+
+traceOut :: Show a => a -> a
+traceOut x = (traceShow x x)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = ([x] ++ y) : ys
+
+split :: [Char] -> String -> [String]
+split _ [] = []
+split delims (x:xs)
+  | elem x delims = [[]] ++ split delims xs
+  | otherwise     = addFirst (split delims xs) x
+
+splitInput :: String -> [Integer]
+splitInput = map read . split "\n"
+
+evolve :: Integer -> Integer
+evolve x = c 
+    where a = ((x*64) `xor` x) `mod` 16777216 
+          b = ((a `div` 32) `xor` a) `mod` 16777216
+          c = ((b*2048) `xor` b) `mod` 16777216
+
+memoEvolve = memoize evolve
+
+firstNumbers :: Int -> Integer -> [Integer]
+firstNumbers 0 _ = []
+firstNumbers n x = x : (firstNumbers (n-1) (memoEvolve x))
+
+prices :: Integer -> [Integer]
+prices = map (`mod` 10) . firstNumbers 2000
+
+patterns :: Num a => [a] -> [(a, (a, a, a, a))]
+patterns (a:b:c:d:e:xs) = (e, (b-a, c-b, d-c, e-d)) : (patterns (b:c:d:e:xs))
+patterns _ = []
+
+sellPrice :: Eq a => (a, a, a, a) -> [(b, (a, a, a, a))] -> Maybe b
+sellPrice _ [] = Nothing
+sellPrice pattern ((a, x):xs)
+  | pattern == x = Just a
+  | otherwise    = sellPrice pattern xs
+
+solve1 :: [Integer] -> Integer
+solve1 = sum . withStrategy (parListChunk 64 rdeepseq) . map (last . firstNumbers 2000)
+
+mapPar :: NFData b => Int -> (a -> b) -> [a] -> [b]
+mapPar n f xs = (map f xs) `using` parListChunk n rdeepseq
+
+solve2 :: [Integer] -> Integer
+solve2 inits = foldl (\a b -> if a > b then a else b) 0 $ mapPar 64 (\p -> sum $ mapPar 128 (\h -> case (sellPrice p h) of
+        Nothing -> 0
+        Just x -> x
+    ) hists) ps
+    where hists = map (patterns . prices) inits
+
+test = \x -> (x <= 9) && (-9 <= x)
+
+ps = [(a, b, c, d) | a <- xs, b <- xs, c <- xs, d <- xs, test (a+b), test (b+c), test (c+d), test (a+d), test (a+b+c), test (b+c+d), test (a+b+c+d)]
+    where xs = [-9..9]
+
+main :: IO()
+main = do
+       fileinp <- readFile "input.txt"
+       let parsed = splitInput fileinp
+       let solved1 = solve1 parsed
+       let solved2 = solve2 parsed
+       print solved1
+       print solved2

23/solution.hs

@@ -0,0 +1,73 @@
+import Data.List
+import Data.Maybe
+import Data.Array
+import Debug.Trace
+
+traceOut :: Show a => a -> a
+traceOut x = (traceShow x x)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = ([x] ++ y) : ys
+
+split :: [Char] -> String -> [String]
+split _ [] = []
+split delims (x:xs)
+  | elem x delims = [[]] ++ split delims xs
+  | otherwise     = addFirst (split delims xs) x
+
+type Chars = (Char, Char)
+
+--partial!
+splitInput :: String -> [(Chars, Chars)]
+splitInput = concat . map (\(a:b:[]) -> [(toTuple $ a, toTuple $ b), (toTuple $ b, toTuple $ a)]) . map (split "-") . split "\n"
+
+--partial!
+toTuple :: [a] -> (a, a)
+toTuple (a:b:_) = (a, b)
+
+getEdges :: Eq a => [(a, a)] -> a -> [a]
+getEdges [] _ = []
+getEdges ((a, b):edges) x = if x == a then b:remainder 
+                       else if x == b then a:remainder 
+                       else                  remainder
+    where remainder = getEdges edges x
+
+buildArray :: [(Chars, Chars)] -> Array Chars [Chars]
+buildArray edges = array (('a', 'a'), ('z', 'z')) [((x, y), getEdges edges (x, y)) | x <- chars, y <- chars]
+    where chars = ['a'..'z']
+
+beginsT :: Chars -> Bool
+beginsT ('t', _) = True
+beginsT _ = False
+
+solve1 :: Array Chars [Chars] -> Int
+solve1 arr = (`div` 6) $ length $ nub $ filter (\(a, x, y) -> beginsT a || beginsT x || beginsT y) $ filter (\(a, x, y) -> (inArray arr y) && (elem x (arr!y))) $ concat $ map (\(a, xs) -> [(a, x, y) | x <- xs, y <- xs]) $ assocs arr
+
+maximalCliques :: Ix a => Array a [a] -> [[a]]
+maximalCliques arr = f [] (indices arr) []
+    where f = \r p x -> case (p, x) of
+              ([], []) -> [r]
+              _ -> g r p x
+          g = \r p x -> case p of
+              [] -> []
+              (v:vs) -> (f (nub (v:r)) (filter (\x -> elem x (arr!v)) p) (filter (\x -> elem x (arr!v)) x)) ++ (g r vs (nub (v:x)))
+
+inArray :: Ix a => Array a b -> a -> Bool
+inArray arr x = elem x (indices arr)
+
+maxBy :: Ord b => (a -> b) -> a -> [a] -> a
+maxBy f i xs = foldl (\a b -> if (f a) > (f b) then a else b) i xs
+
+solve2 :: Array Chars [Chars] -> String
+solve2 arr = concat $ intersperse "," $ map (\(a, b) -> [a, b]) $ sort $ maxBy length [] $ maximalCliques arr
+
+main :: IO()
+main = do
+       fileinp <- readFile "input.txt"
+       let parsed = splitInput fileinp
+       let arr = buildArray parsed
+       let solved1 = solve1 arr
+       let solved2 = solve2 arr
+       print solved1
+       putStrLn solved2