migrate over 2016

Author: mstksg

2016/AOC2016.hs

@@ -0,0 +1,50 @@
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
+-- |
+-- Module      : AOC2016
+-- Copyright   : (c) Justin Le 2021
+-- License     : BSD3
+--
+-- Maintainer  : justin@jle.im
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Gather together all challenges and collect them into a single map.
+module AOC2016 (
+  module AOC,
+  challengeBundle2016,
+)
+where
+
+import AOC.Discover
+import AOC.Run
+import AOC.Run.Interactive
+import AOC2016.Day01 as AOC
+import AOC2016.Day02 as AOC
+import AOC2016.Day03 as AOC
+import AOC2016.Day04 as AOC
+import AOC2016.Day05 as AOC
+import AOC2016.Day06 as AOC
+import AOC2016.Day07 as AOC
+import AOC2016.Day08 as AOC
+import AOC2016.Day09 as AOC
+import AOC2016.Day10 as AOC
+import AOC2016.Day11 as AOC
+import AOC2016.Day12 as AOC
+import AOC2016.Day13 as AOC
+import AOC2016.Day14 as AOC
+import AOC2016.Day15 as AOC
+import AOC2016.Day16 as AOC
+import AOC2016.Day17 as AOC
+import AOC2016.Day18 as AOC
+import AOC2016.Day19 as AOC
+import AOC2016.Day20 as AOC
+import AOC2016.Day21 as AOC
+import AOC2016.Day22 as AOC
+import AOC2016.Day23 as AOC
+import AOC2016.Day24 as AOC
+import AOC2016.Day25 as AOC
+
+challengeBundle2016 :: ChallengeBundle
+challengeBundle2016 = CB 2016 $ mkChallengeMap $$(solutionList)

2016/AOC2016/Day01.hs

@@ -0,0 +1,67 @@
+-- |
+-- Module      : AOC2016.Day01
+-- License     : BSD3
+--
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Day 1.  See "AOC.Solver" for the types used in this module!
+module AOC2016.Day01 (
+  day01a,
+  day01b,
+) where
+
+import AOC.Common (firstRepeated)
+import AOC.Common.Point (Dir (..), Point, dirPoint, mannDist, parseDir)
+import AOC.Solver ((:~>) (..))
+import Data.List (foldl')
+import Text.Read (readMaybe)
+
+data Turtle = (:@)
+  { tLoc :: Point
+  , tDir :: Dir
+  }
+  deriving stock (Show)
+
+data Command
+  = CTurn Dir
+  | CGo
+  deriving stock (Show)
+
+stepper :: Turtle -> Command -> Turtle
+stepper (x :@ h) = \case
+  CTurn d -> (x + dirPoint h') :@ h'
+    where
+      h' = d <> h
+  CGo -> (x + dirPoint h) :@ h
+
+day01a :: [Command] :~> Int
+day01a =
+  MkSol
+    { sParse = parseCmd
+    , sShow = show
+    , sSolve =
+        Just
+          . mannDist 0
+          . tLoc
+          . foldl' stepper (0 :@ North)
+    }
+
+day01b :: [Command] :~> Int
+day01b =
+  MkSol
+    { sParse = parseCmd
+    , sShow = show
+    , sSolve =
+        fmap (mannDist 0)
+          . firstRepeated
+          . map tLoc
+          . scanl stepper (0 :@ North)
+    }
+
+parseCmd :: String -> Maybe [Command]
+parseCmd str = Just $ do
+  x : xs <- words . filter (/= ',') $ str
+  Just h <- pure $ parseDir x
+  Just n <- pure $ readMaybe xs
+  CTurn h : replicate (n - 1) CGo

2016/AOC2016/Day02.hs

@@ -0,0 +1,79 @@
+-- |
+-- Module      : AOC2016.Day02
+-- License     : BSD3
+--
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Day 2.  See "AOC.Solver" for the types used in this module!
+module AOC2016.Day02 (
+  day02a,
+  day02b,
+) where
+
+import AOC.Common.Point (Dir (..), Point, dirPoint, parseDir)
+import AOC.Solver ((:~>) (..))
+import Data.List (foldl', mapAccumL)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
+import Linear (V2 (..))
+
+stepper :: Map Point Char -> Point -> [Dir] -> (Point, Maybe Char)
+stepper mp x =
+  (\r -> (r, M.lookup r mp))
+    . foldl' move x
+  where
+    move p d
+      | p' `M.member` mp = p'
+      | otherwise = p
+      where
+        p' = p + dirPoint d
+
+keypadA :: Map Point Char
+keypadA =
+  M.fromList . flip zip ['1' ..] $
+    [ V2 (-1) 1
+    , V2 0 1
+    , V2 1 1
+    , V2 (-1) 0
+    , V2 0 0
+    , V2 1 0
+    , V2 (-1) (-1)
+    , V2 0 (-1)
+    , V2 1 (-1)
+    ]
+
+day02a :: [[Dir]] :~> String
+day02a =
+  MkSol
+    { sParse = Just . (map . mapMaybe) parseDir . lines
+    , sShow = id
+    , sSolve = sequence . snd . mapAccumL (stepper keypadA) 0
+    }
+
+keypadB :: Map Point Char
+keypadB =
+  M.fromList . flip zip (['1' .. '9'] ++ ['A' ..]) $
+    [ V2 0 2
+    , V2 (-1) 1
+    , V2 0 1
+    , V2 1 1
+    , V2 (-2) 0
+    , V2 (-1) 0
+    , V2 0 0
+    , V2 1 0
+    , V2 2 0
+    , V2 (-1) (-1)
+    , V2 0 (-1)
+    , V2 1 (-1)
+    , V2 0 (-2)
+    ]
+
+day02b :: [[Dir]] :~> String
+day02b =
+  MkSol
+    { sParse = Just . (map . mapMaybe) parseDir . lines
+    , sShow = id
+    , sSolve = sequence . snd . mapAccumL (stepper keypadB) (V2 (-2) 0)
+    }

2016/AOC2016/Day03.hs

@@ -0,0 +1,42 @@
+-- |
+-- Module      : AOC2016.Day03
+-- License     : BSD3
+--
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Day 3.  See "AOC.Solver" for the types used in this module!
+module AOC2016.Day03 (
+  day03a,
+  day03b,
+) where
+
+import AOC.Solver ((:~>) (..))
+import Data.List (sortBy, transpose)
+import Data.List.Split (chunksOf)
+import Text.Read (readMaybe)
+
+isTriangle :: [Int] -> Bool
+isTriangle (sortBy (flip compare) -> (x : xs)) = sum xs > x
+isTriangle _ = False
+
+day03a :: [[Int]] :~> Int
+day03a =
+  MkSol
+    { sParse = traverse (traverse readMaybe . words) . lines
+    , sShow = show
+    , sSolve = Just . length . filter isTriangle
+    }
+
+day03b :: [[Int]] :~> _
+day03b =
+  MkSol
+    { sParse = traverse (traverse readMaybe . words) . lines
+    , sShow = show
+    , sSolve =
+        Just
+          . length
+          . filter isTriangle
+          . concatMap transpose
+          . chunksOf 3
+    }

2016/AOC2016/Day04.hs

@@ -0,0 +1,57 @@
+-- |
+-- Module      : AOC2016.Day04
+-- License     : BSD3
+--
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Day 4.  See "AOC.Solver" for the types used in this module!
+module AOC2016.Day04 (
+  day04a,
+  day04b,
+) where
+
+import AOC.Common (caeser, firstJust, freqList)
+import AOC.Solver ((:~>) (..))
+import Control.Monad (guard)
+import Data.Finite (modulo)
+import Data.List (isInfixOf)
+import Data.List.Split (splitOneOf)
+import Data.Maybe (mapMaybe)
+import Text.Read (readMaybe)
+
+data Room = Room
+  { rName :: [String]
+  , rId :: Int
+  }
+  deriving stock (Show)
+
+parseRoom :: String -> Maybe Room
+parseRoom str = do
+  _ : c : n : rs <- Just . reverse . splitOneOf "-[]" $ str
+  guard
+    . all (uncurry (==))
+    . zip c
+    . map snd
+    . freqList
+    . concat
+    $ rs
+  Room (reverse rs) <$> readMaybe n
+
+day04a :: _ :~> _
+day04a =
+  MkSol
+    { sParse = Just . mapMaybe parseRoom . lines
+    , sShow = show
+    , sSolve = Just . sum . map rId
+    }
+
+day04b :: _ :~> _
+day04b =
+  MkSol
+    { sParse = Just . mapMaybe parseRoom . lines
+    , sShow = show
+    , sSolve = firstJust $ \(Room n i) ->
+        i <$ do
+          guard $ "north" `isInfixOf` (concatMap . map) (caeser (modulo (fromIntegral i))) n
+    }

2016/AOC2016/Day05.hs

@@ -0,0 +1,71 @@
+-- |
+-- Module      : AOC2016.Day05
+-- License     : BSD3
+--
+-- Stability   : experimental
+-- Portability : non-portable
+--
+-- Day 5.  See "AOC.Solver" for the types used in this module!
+module AOC2016.Day05 (
+  day05a,
+  day05b,
+) where
+
+import AOC.Common (foldMapParChunk, hexDigit, splitWord, _ListTup)
+import AOC.Solver ((:~>) (..))
+import Control.Lens (review, view)
+import qualified Crypto.Hash as H
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as BS
+import Data.ByteString.Lens (packedChars)
+import Data.Finite (Finite, strengthenN)
+import Data.Foldable (toList)
+import Data.List (find, scanl')
+import Data.List.Split (chunksOf)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (maybeToList)
+
+coolHash :: H.Context H.MD5 -> Int -> Maybe (Finite 16, Finite 16)
+coolHash ctx i = case concatMap (review _ListTup . splitWord) (BS.unpack hashed) of
+  0 : 0 : 0 : 0 : 0 : x : y : _ -> Just (x, y)
+  _ -> Nothing
+  where
+    hashed =
+      BA.convert
+        . H.hashFinalize
+        . H.hashUpdate ctx
+        . view (packedChars @BS.ByteString)
+        $ show i
+
+day05a :: H.Context H.MD5 :~> [Finite 16]
+day05a =
+  MkSol
+    { sParse = Just . H.hashUpdate H.hashInit . view (packedChars @BS.ByteString)
+    , sShow = map (review hexDigit)
+    , sSolve = \ctx ->
+        Just
+          . take 8
+          . (foldMap . foldMapParChunk 500_000)
+            (maybeToList . fmap fst . coolHash ctx)
+          $ chunksOf 10_000_000 [0 ..]
+    }
+
+coolHash2 :: H.Context H.MD5 -> Int -> Maybe (Finite 8, Finite 16)
+coolHash2 ctx i = do
+  (x, y) <- coolHash ctx i
+  k <- strengthenN x
+  pure (k, y)
+
+day05b :: H.Context H.MD5 :~> Map (Finite 8) (Finite 16)
+day05b =
+  MkSol
+    { sParse = Just . H.hashUpdate H.hashInit . view (packedChars @BS.ByteString)
+    , sShow = map (review hexDigit) . toList
+    , sSolve = \ctx ->
+        find ((== 8) . M.size)
+          . scanl' (\mp (k, x) -> M.insertWith (const id) k x mp) M.empty
+          . (foldMap . foldMapParChunk 500_000)
+            (maybeToList . coolHash2 ctx)
+          $ chunksOf 10_000_000 [0 ..]
+    }