diff --git a/Y2022.cabal b/Y2022.cabal index da75c4b..d408b26 100644 --- a/Y2022.cabal +++ b/Y2022.cabal @@ -56,8 +56,11 @@ library Days.D19 Days.D20 Days.D21 + Days.D24 + Days.D25 build-depends: - bytestring + array + , bytestring , either , hashable , hashtables ^>=1.3.1 @@ -67,9 +70,11 @@ library , monad-loops ^>=0.4.3 , mtl , parser-combinators - , scanf ^>=0.1.0.0 + , scanf ^>=0.1.0.0 , text , vector ^>=0.13.0.0 + , wide-word + executable Y2022 import: warnings, defaults diff --git a/app/Main.hs b/app/Main.hs index 1d696fa..027d422 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,6 +5,8 @@ module Main where import Lib import System.Environment (getArgs) +import Data.List (uncons) +import Data.Maybe (mapMaybe) paths :: [FilePath] paths = @@ -29,10 +31,19 @@ paths = , "./data/19.in" , "./data/20.in" , "./data/21.in" + , "" + , "" + , "./data/24.in" + , "./data/25.in" ] solutions :: [(Int, Day, FilePath)] -solutions = zip3 [1 ..] (map head days) paths +solutions = + let maybeSolutions = zip3 [1 ..] days paths + available (num, daySolutions, filepath) = do + (firstSolution, _) <- uncons daySolutions + return (num, firstSolution, filepath) + in mapMaybe available maybeSolutions runAll :: [(Int, Day, FilePath)] -> IO () runAll = mapM_ (\(dayNum, day, path) -> run day path >>= printDR dayNum) diff --git a/bench/Bench.hs b/bench/Bench.hs index faea1d6..dee4d2d 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -28,6 +28,10 @@ paths = , "./data/19.in" , "./data/20.in" , "./data/21.in" + , "" + , "" + , "./data/24.in" + , "./data/25.in" ] solutions :: [(Integer, [Day], FilePath)] diff --git a/data/24.in b/data/24.in new file mode 100644 index 0000000..0211afa --- /dev/null +++ b/data/24.in @@ -0,0 +1,37 @@ +#.#################################################################################################### +#<>^^^>v.<<^.v>^v>v>>vv<.>>>^^v>^.><^>>v<>>>>v^^^.v^v<>^^v><^vvv<^v>><<^.<<^>^<># +#>^v<^^>.<<^>>>^^>v>^^>v>^><^>^>vv^>vv>.^^<>.>>vv<^>.<v<^># +#.^<.>v^>.>>>.<>^>^^v^<<^<>v>>vv^<..vv>><<..v>>.v><^>v>^>^>^^><.<^<>>vv># +#>v^<<^v>vv<<.>>^<<<><>v>vv.<>v^vv<>v^^.<>vvv>^<<<>v^><>v<^.^^^.<>^v>>.v<<<^v<>.^v<>>vv<^v^><# +#.<><<>vv>><>.><<.>><>v>v^v^vv>.^^v>>>^v.><>>>>v^v^<^.v>^v>><<^<>^v>..<<>^^<>><.<^v^v.^><># +#><..v^v><<<<<>.<>v<<^^v>^^vvv^v^<<><.v><..>vv^v<<^<^^^># +#<>^>^>.v<>>v^^v>^>v^>.>><<>vv^^v>>v><^v><<>>>^.^.^^<.^>.><<<^v^>v..^^>^v<^.# +#>^^.v^v<>.>><>vv>.<>><>>><<>v><.v<^^^<>v>^v><^^<^.v.>>>v>v.vv>v>>v^.>.^>v^^<>>v>^v^<.v>^.>v><^># +#<^<<>..<>.vvv>>^.vv<>><>^<<>v.<.^v>v>^><>^^<><>^^.vv.>^v>^^v<><># +#><.>^v><>..v>vv<^<>>^.^v<^vv<^>>^vvvv>^^>>^^><# +#<^<>vvv>^.>v>>.><>>^.>v<>v^v^<^<^^><>>v^><^>.^v^v<^^v><>>v^^<<>>^><<<^v><>^^^.v<# +#.^^.>v.>^.v<^.^.^vv^<>>.v>^<>v>^v><^v>vvv^^^<>^<>^>vv>vvv.<>vv>^<.v>.<>.vv<>>.>vvv<># +#<^^<.^>>v><><^v<.<.><v>>v>v^.<.v<.v.v<.>><^>^v<<^^<^^^.^.>>.v>^><<^>^.>^v^^>v^v<>^>^<.>.><# +#<.^v>>>.v<<<^.v.>v^^<^>v<^v^v^.^<>>^v>^v.^><^.v>><>vvv^^<<^>.^vv.^v.vv<..<# +#.v^v>>v^vv^v>v.vv>^<<..v<<>>vv^<<^^<<<<^>v>vv^<^v^vv><.^^>v^>^>^>^v># +#<>.>^vv<>v^^><>><^^>v<<^^>^>.^^<.v><>v^^v>>^>>.>>.<>vv><^^<^<<>><^vv>>v>^^.^><.^v^<^<><<^vv>>>.v<>^v^^<<><>v>^v^v>^^^vvv>>v^>>v>><>><>>^..v<>><^v^>><.>^<<# +#>^^<^>.<^>>>v<vv^^><vvvv^>^>vv<^<.v<<<>>^v>>..>^.># +#>>v>^<.>.v^>>>.>v.vv^>^>v>^<>^.^^^^>><>..^.>v>^v.v.^<><<><>><# +#<>v>>.v>.^>^<<><^v<.>^vv.>^..>v<<^^>^>>vv<>^v.<^v<^>><<<<^^v^v<<^^v.<>^vvv>^><<>^>^<# +#<><^><^.v<>^vv>v>^>^^<.>^^^^vv<>v<^.vvv.^v^>>^.v>>.>v^v<.><>.>>v>v<>>>v^<^<# +#<^<<^v>v><^v.>>^.vv>>^v<.vv^v<^v^.^^.<.vv>>v>>^<^<<.>>><<<<>vv>^.vv><^^>^>^v^>v>.<>>^v^<>^^^^v^v>>v<<<^v^>>^v^vvv>v>.><<^^>^<><><<<^vv<<<^<>>^^v># +#<><<<>v><^>vv<^><><>^<<^^>^.^^><.vvv<^<>^v^v^v>><>^<^>>><.v<^^>>^vvv^^^v<.>vv^v>v^<<>v.^<.>v<# +#.>>vv<.v^^v>v>..^<<^^>><^<>v>.>>.<^>><><>v^<^^^v^>v^v>^<><<^>><^<..v><>>^<# +#>v.>v>v^^v.v><>.<^v>^^<>^^>v^^>>..v^.v<>v>^v>..><^<<>^>^^<^v>.v..>v^v^^..><# +#<^v<><^^<.>><<>^^<><.<.>^.vv>^vv>>.<><>^^>>>v<^^v.><<>><>^^<^><<><>>>>^.# +#><^<>v<^><><<<><^>^<^>^^v<><<<<>>><>.^.>vv>v>^^<<>^>.<^># +#.v<<<.v<^>>^<>>v<>v.><>^^v>vv<<^.v<^^v>.v>^v>^..^<<.<..^>^.^.v^^><>>>^..^vv># +#<>^>>^^v^>>>.>v^v<^^<<^<>v>>.>><<<><^v.v<>v><>^v>>>^^v<^>vv^v>^v>^.<<# +#>vvvv.>vvvvv^.<<<><^^v<<>^^.<^>v<^v>.^><>>v.<^.<<.^^.>vv<<<<^.>^^v>>><<# +#<^>.<<^^^<<>.<>v^^^v<<^>>vv<^.<>>v.^v<^^.v<>^^v>>v.^>vv<<<<>vvv<<.^>v>v<^v^vv^<^.^>v.>^.>^^<# +#<><^<><.>>^^>>v><^<^^v>>^>>^>^<>^>v<^><.<>v^<^v^<<..<..v^>>>v>v<<>..<>>>vvv><<# +#<>>vv>v.^v>.^<><>.v..<<^v>v^v>^^><.>>><<^>v^^^^vv.<>v.vv>>^<^.>^<>.<^>^<<^v^^v>^>vv>^<>.# +#>^>>v>v<>^<.<.>><^^<.vvv<<<.vv^>^>^^vv<^>^>vvv^^^.v<<<^^<>v<<>># +####################################################################################################.# diff --git a/data/25.in b/data/25.in new file mode 100644 index 0000000..ac24512 --- /dev/null +++ b/data/25.in @@ -0,0 +1,107 @@ +21211-122 +1=--02-10=-=00=-0 +1=-2 +1-1-1-===2=0--1- +1211= +1=22=-= +1-0-=0210 +2-0-02 +1=1--1=-0210---=-1 +200-0=02--2 +20112=02 +1201--=-022 +1-100== +1- +1=-1=22===200101-2 +1==0010221-=22--0-02 +1002=11022 +1=02 +222=---112-=21=02= +21==10--=01-1-=1 +1===--11=102 +2==2=0022=1=102 +101221=-2-=-00-12 +10=12220==--- +1-2 +2--01112 +11=01-=1002- +1==-00-=10 +10=2==-= +10-1=-=20-2-= +1=1 +2120- +2-2-=-0==- +1-2-22=001-=-000 +21222-2222=102-2-- +101010 +1=0110 +1-21 +10 +1=022==2- +102-21==010 +20=-2- +1==-== +1=-0212===101 +111202220=12-1-=-2 +1-11110-==0=0-0=2 +2=2-0=0=02-2=-0-0=0 +10=22=11-1-1-21-021 +1212 +20=1=00202-==2-- +1==2 +100-- +122=- +2=220010 +202-222=212100-110 +20021=222==1--==-= +1==2212=- +1=-11--221===1== +21=21021-=1 +2- +11=02-=-----1=0= +10=2-00200 +111- +12=1=12121==-=-=- +1==0- +2--2-0=0-=2=21 +1==02-0=022-1=2- +1-112 +1--01--2=2= +221=1=20-=0-== +1=2-0-21-- +1=11 +1120-=00-==2= +1-=1-02101-02 +221-1= +1---=-=1211 +22= +221-=21=2010 +2-2102= +2--121=11-011 +1-1-01-1=2=001 +2-=-=22-=01-- +1-0=20=22 +2002122211=02 +1-2-21-21211012= +2=0200201= +2=-102- +1==202=-2==1= +1=0=010120= +2==1100-01==-0 +1220112102111=0 +1=10=1-=-2= +1=-200020=-1001 +11=11-=2 +1==01=11=0=2-2== +2=0-0-1=11-222= +1221=0-1= +1-=1-022 +10-1=22---021=1 +1011-1-=22-12 +1=0-122=-1== +2111-0=20= +1==01100-= +200111102 +12=0-2=2112--121=1 +2=01 +1==221=2211--2011 diff --git a/src/Days/D24.hs b/src/Days/D24.hs new file mode 100644 index 0000000..d3bdd74 --- /dev/null +++ b/src/Days/D24.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Days.D24 where + +import Common +import Control.Monad (foldM_) +import Control.Monad.ST (ST, runST) +import Data.Bits +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Vector.Storable qualified as UnVector +import Data.Vector.Storable.Mutable qualified as MUnVector +import Data.WideWord.Word128 + +data Input = Input + { width :: Int, + height :: Int, + horizontal :: UnVector.Vector Word128, + vertical :: UnVector.Vector Word128 + } + deriving (Show) + +parse :: Text -> Either String Input +parse text = + let inner = tail . init . map (Text.tail . Text.init) . Text.lines $ text + height = length inner + width = Text.length (head inner) + [l, r, u, d] = map (`construct` inner) ['<', '>', '^', 'v'] + hMerge time lrow rrow = + let left_ = (lrow `shiftL` time) .|. (lrow `shiftR` (width - time)) + right = (rrow `shiftR` time) .|. (rrow `shiftL` (width - time)) + in left_ .&. right + horizontal = + UnVector.fromList $ + concatMap (\time -> zipWith (hMerge time) (UnVector.toList l) (UnVector.toList r)) [0 .. width - 1] + vertical = + UnVector.fromList + [ let up__ = u UnVector.! ((row + time) `mod` height) + down = d UnVector.! ((row - time) `mod` height) + in up__ .&. down + | time <- [0 .. height - 1], + row <- [0 .. height - 1] + ] + in Right (Input {width, height, horizontal, vertical}) + where + setBitIf bitmap bool = (bitmap `shiftL` 1) .|. (if bool then 0 else 1) + construct char = UnVector.fromList . map (foldl setBitIf 0 . map (char ==) . Text.unpack) + +type Restart = forall s. MUnVector.MVector s Word128 -> ST s Bool + +explore :: Restart -> Input -> Int -> Int +explore restart (Input {..}) initTime = runST $ MUnVector.replicate (height + 1) 0 >>= flip go initTime + where + go :: MUnVector.MVector s Word128 -> Int -> ST s Int + go state time = + restart state >>= \case + True -> return time + False -> do + () <- + foldM_ + ( \prevRow row -> + do + curRow <- MUnVector.read state row + nextRow <- MUnVector.read state (row + 1) + + let newOpts = curRow .|. (curRow `shiftL` 1) .|. (curRow `shiftR` 1) .|. prevRow .|. nextRow + let pruned = + newOpts + .&. (horizontal UnVector.! (height * (time `mod` width) + row)) + .&. (vertical UnVector.! (height * (time `mod` height) + row)) + + MUnVector.write state row pruned + + return curRow + ) + 0 + [0 .. height - 1] + + go state (time + 1) + +restartStart :: Input -> Restart +restartStart Input {..} state = do + start <- MUnVector.read state 0 + MUnVector.write state 0 (setBit start (width - 1)) + flip testBit 0 <$> MUnVector.read state (height - 1) + +restartEnd :: Input -> Restart +restartEnd Input {..} state = do + start <- MUnVector.read state (height - 1) + MUnVector.write state (height - 1) (start .|. 1) + flip testBit (width - 1) <$> MUnVector.read state 0 + +part1 :: Input -> Int +part1 input = explore (restartStart input) input 0 + +part2 :: Input -> Int +part2 input = + explore (restartStart input) input + . explore (restartEnd input) input + . explore (restartStart input) input + $ 0 + +day :: Day +day = + TextDay + ( \text -> do + input <- parse text + return (definitive $ part1 input, definitive $ part2 input) + ) diff --git a/src/Days/D25.hs b/src/Days/D25.hs new file mode 100644 index 0000000..8487f7b --- /dev/null +++ b/src/Days/D25.hs @@ -0,0 +1,37 @@ +module Days.D25 where + +import Common + +snafu :: Int -> String +snafu = reverse . encode + where + encode 0 = [] + encode n = + let (d, m) = (n + 2) `divMod` 5 + in ( case m of + 0 -> '=' + 1 -> '-' + 2 -> '0' + 3 -> '1' + 4 -> '2' + _ -> error "unreachable" + ) + : encode d + +decimal :: String -> Maybe Int +decimal = fmap (foldl ((+) . (5 *)) 0) . mapM fromDigit + where + fromDigit :: Char -> Maybe Int + fromDigit '=' = Just (-2) + fromDigit '-' = Just (-1) + fromDigit '0' = Just 0 + fromDigit '1' = Just 1 + fromDigit '2' = Just 2 + fromDigit _ = Nothing + + +part1 :: String -> Maybe String +part1 = fmap (snafu . sum) . mapM decimal . lines + +day :: Day +day = StringDay (\string -> Right (Answer <$> part1 string, definitive "MERRY CHRISTMAS")) diff --git a/src/Lib.hs b/src/Lib.hs index 0ee28b6..aebad73 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -33,6 +33,8 @@ import Days.D18 qualified as D18 import Days.D19 qualified as D19 import Days.D20 qualified as D20 import Days.D21 qualified as D21 +import Days.D24 qualified as D24 +import Days.D25 qualified as D25 import Data.ByteString.Char8 qualified as BS import Data.Text.IO qualified as T @@ -66,4 +68,8 @@ days = , [D19.day] , [D20.day] , [D21.day] + , [] + , [] + , [D24.day] + , [D25.day] ] diff --git a/src/Print.hs b/src/Print.hs index 6d68b57..9756b0e 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -4,14 +4,14 @@ import Common import Text.Printf (printf) printHeader :: IO () -printHeader = putStrLn "[ Day ]-------(1)------+-------(2)------" +printHeader = putStrLn "[ Day ]-----------(1)----------+-----------(2)----------" printFooter :: IO () -printFooter = putStrLn "[-----]----------------+----------------" +printFooter = putStrLn "[-----]------------------------+------------------------" printDR :: Int -> DayResult -> IO () printDR day (Left errorString) = printf "[ %2d ] ====== PARSER ERROR =======\n%s" day errorString printDR day (Right (sol1, sol2)) = let r1 = maybe "unsolved" show sol1 r2 = maybe "unsolved" show sol2 - in printf "[ %2d ] %14s | %14s\n" day r1 r2 + in printf "[ %2d ] %22s | %22s\n" day r1 r2