From 64286f54a74d6f45a25b5aa2e31742db90f20c75 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Thu, 30 Nov 2023 17:09:56 +0100 Subject: 2022-22 part 2 in haskell --- 2022/22-Monkey-Map/folding.excalidraw.svg | 21 +++++ 2022/22-Monkey-Map/second.hs | 143 ++++++++++++++++++++++++++++++ 2 files changed, 164 insertions(+) create mode 100644 2022/22-Monkey-Map/folding.excalidraw.svg create mode 100644 2022/22-Monkey-Map/second.hs diff --git a/2022/22-Monkey-Map/folding.excalidraw.svg b/2022/22-Monkey-Map/folding.excalidraw.svg new file mode 100644 index 0000000..2aa087e --- /dev/null +++ b/2022/22-Monkey-Map/folding.excalidraw.svg @@ -0,0 +1,21 @@ + + + eyJ2ZXJzaW9uIjoiMSIsImVuY29kaW5nIjoiYnN0cmluZyIsImNvbXByZXNzZWQiOnRydWUsImVuY29kZWQiOiJ4nO1dW1faWlx1MDAxN33vr+jgvFx1MDAxNs++X85cdTAwMWKgKIrgtYpfz3BcdTAwMDRcYphcdTAwMTJcdTAwMTIkQYGO/vdvXHUwMDA3LZdIQkJccoR61GFlJ/uauedcXGtlJf3x6fPnjDvq6Zl/Pmf0YUMzjWZfe8588cqf9L5j2JY6hCafXHUwMDFke9BvTM58cN2e88/ff89q7DXs7kst3dS7uuU66rz/qc+fP/+Y/J7rR+v37ZcuJsWzbjD0XHUwMDE3Vmxr0iOEgDFMXHUwMDE5xNMzXGZnX3Xl6k11uKWZjj474lx1MDAxNWWO7epgcObAr438QFx1MDAwZYe5wjGD17NeW4ZpXrojczJcIsdWs5hcdTAwMWRz3L7d0W+Mpvugjlx1MDAxMl95UK2+PWg/WLrjzVx1MDAxY0xL7Z7WMNyRN1x1MDAwNzAr1az2pI1ZyVB9XHUwMDEybPbZq4Hnarz0XbBNu+/1/Vx1MDAxN9S971nvda3RaashWM3pOW5fs5ye1ldXY3be8+us5rp60I32g7tY5uiThYVqyVx1MDAwMVx1MDAxMnPL7vXRKzUnl/ff2Wr2ta5e8mpYXHUwMDAz05xfXHUwMDEyq/m6JL9gMFx1MDAwM1x1MDAwMnot+TmbhHf+wVx1MDAxY4BmPVxmek3t5WJDXHUwMDBlIKZcdTAwMDRDibCcXHUwMDFlN1xyq+Pv3rRcdTAwMWKdJfhwXFyt7+ZccqtpWO3Fgb1idzKRTOdWz2LQv7g5cK/LxUP3tmrq+elCepO2XHUwMDFiXHUwMDAzb5RZsIfmittaz1x1MDAxYuWbyelWc3Wnw8G4VPlu3rVv9MtWXHTSc/78vbGs02h9mprjXHUwMDE27G7XcNXandmG5frXaLJcdTAwMTg5b0c+6FpzyfZUw1x1MDAwZTvc81x1MDAxYZ1tdu9r9tfnXHUwMDE5wCdcdTAwMWamf//7ZfXZbOXpWVx1MDAxNljh0/y/r+tcdTAwMTGdiIj0XHUwMDE3TolISEkg4XxGVauI6ECv1Fx1MDAxOFx1MDAwMPdnfcmt+uNcdTAwMTMv9nrZdFx1MDAxM1x1MDAxMfdcdTAwMTFcdTAwMTHdOlx1MDAxMUlcdTAwMDRcdTAwMThcdTAwMTZcdTAwMWPyXHUwMDBmSETHWWBcdTAwMWZcdTAwMWRcdTAwMTY0o1t4KFx1MDAxM/P0ZJA9rydNRIPTXG47sa/lqP3kortDzju5fes/XCLaMFx1MDAxMSHiL5xcdTAwMTKRXHUwMDE0XHUwMDFl9lx1MDAxMJohb1x1MDAxNVx1MDAxMek53C5oLtTkdavcqrVH3aNHN91ExMhcIlx1MDAxMZGtXHUwMDEzkZBMYo7BbNk/XHUwMDBlXHUwMDEx6XmQa1x1MDAxYWdAd3L5/fuLu0Gn1lx1MDAwMf9ZRFx1MDAxYiOi7GomYsFcdTAwMTV+j4lcdTAwMTj3XHUwMDE3/mJcIlx1MDAwNChTXHUwMDA2g+TRmag8yo7OXHUwMDFlTp+r4uzxmbF8rXVSdNLNRFx1MDAxYywyXHUwMDExXCLJMVx1MDAxMVxcRkVcYr31zlxipFx1MDAxYysh+JOtooUqkVx1MDAxOCNcdTAwMGVNkbniP4QyspAsVEBcdTAwMTFqMF+NXGJVwGJcdTAwMTX0bkzDsb9wavNQiZhgXGZFd76Oq+PjdnaA+tg5lFbpeth5XHUwMDFjldPNNDKFTIOAxJhRLj6i2Vx1MDAxMydcdTAwMTBcdTAwMTSFT1wikVhkp1x1MDAwZuzhXGJ97lx1MDAxOIf5+WjV+X7G2yZ/QSqCTSVcdTAwMDC4YrA5wV5FYH3eXHUwMDAwzXZlNFx1MDAxYVx1MDAxNd1a/bR4Vbint+kmMH/0XGIl6LTNk+OUwMgyXHUwMDAyXHUwMDAzXGZCXHUwMDAxUlx1MDAxOMlmXHUwMDE0K1mb+i5cdFx1MDAxMFhhwEy7V7qsXHUwMDFjlOmwWr/R9WPaWs4ldPNcdTAwMDEkjzXZwlx1MDAxN/9cdTAwMDNcdTAwMTktS+K6cllEYnbhq4DjW374/Vx1MDAxY0ZIWFx1MDAxMFxyMowoXHUwMDA2UtLILFgpsqpxXGIr7d5xNz+8xM1cdTAwMTPL1tPNgoL4WVx1MDAxMO9xgGc/iXFcIl7GiXSJ+yixIEgyNjOnU8SJiIjZxdqk+1x1MDAxOCPyTVx1MDAxOVZ6rszPl99vWGvxijNJ8a7TXHUwMDE48rHYm1x1MDAxOa5qwOecZlx1MDAwM5couIVFy1xyS7anQDz9WVnfz3mExm1cdTAwMDAtjoCAuKTZ11x1MDAxYu5cdTAwMGJrLCPOwEhcdTAwMWJcdTAwMTRcdTAwMThiJkT0JIhw5Y/Bm8hXvsFAW4LW4/xopkw5X/iLKZV9hlx1MDAwMXpcdTAwMTfrceHAXHUwMDFiSpxcdTAwMDLpx1x1MDAxY8CmuHH1oZuZh97rZe5cdTAwMWVke41cdTAwMWV7cM7zXHUwMDAz6+ng8qonrlx1MDAwYpnpeT+/LG82ioex0P9cdTAwMGKzzNr9XHUwMDA19mBcdTAwMWUnglx1MDAxM1x1MDAxNIfHQ/fNwvznt0xgyIgoemBcdTAwMWOx6Fx1MDAxMaPla7mhLVx1MDAwM9fbMpjv0cVNg5IzL1x1MDAxMH27Z+ZsvV9bXHUwMDA2XGKOOGbwXHUwMDFkXCJG4VsmXHUwMDE4fZRcdTAwMTKuvL51rIiWbbmXxvjFaV8oLWpdw1x1MDAxYy1cXN9cdCzVsuW+WfDLLNI8Kc+ZRtuDaKahxqv3XHUwMDE30OtcdTAwMWFccs2cntA1ms15RWiozjTD0vtRnLiM3TfahqWZV1x1MDAwMWNRc9ePplx1MDAxNLdcdTAwMDfp3PV3dO+od1x1MDAxOeH6soVcdTAwMDLNfUqAUMY+jn5/KDzilkrZXHUwMDEyaZQtQVx0hVx1MDAwNL2Dfb+OakXJw1xcwJdfXkJlKzyyv067q1TWxo7Qm6B2fFFcdTAwMWU7pTur43agXHUwMDExS1xyKVx1MDAwNFx1MDAxOIn5PZmIXHUwMDFhXHUwMDA2p9FyLlx0xZhEl8Plk061XHUwMDFjilx1MDAxNMohwohRXHUwMDA2+VbVkFwiTNaKM66lhvlvXHUwMDE2SkxcclcohF9ccv1jSVxcXHJxYFx1MDAwNiljiFxuwWT0LVx1MDAxOJ5cdTAwMDGTSjX0O3FJZrJHVUOJKIeEoMS34DbUMDy3b512V6mhZkNNXGas/eGdWX88q9/mTm/K93HUMP6N2/XUMDCcwqTkcIGTV+3E5XNOtVx1MDAxOL71XHLx1sVcdTAwMTBcbsJcdMREJm6YhqqhXHUwMDA0XHUwMDE4x0Df76lhwfPHYEJquEIh/GroXHUwMDFmS+JqSIJDmsogVZtcdTAwMTDHcFx1MDAwZcMzI3ZCXHUwMDBlk0xjjuxcdTAwMWNiJlx1MDAxMVx1MDAwM3Buy25BXHUwMDBmw1x1MDAxZo5ZQFjKvcNe11x1MDAxZO5/XHUwMDFkc/cgXzZcdTAwMWbl1f1JvV5Io1x1MDAxZVx1MDAwNnqHXFwgytQgoienLJ/zjukh2b5cdTAwMWUyJIGyTEXiWzFMXHUwMDBmmYAkTmzi9/TwwNMglJBcdTAwMWWukFxiv1x1MDAxZfrHkrhcdTAwMWXSwFgplIxTZVx1MDAxZPHouVx1MDAxMeHpzqnUQ5ZCPaRYSuWa03fIpV9fXHUwMDBl39+Ni/LAxTrtrpJD0OhcdTAwMTQ7XHUwMDA3mt10n++JUVx1MDAxYny9d0u5nZJDZZVSXCLkvDys2orLJ51qPWQp1EMuXHUwMDE4hfg9cs1/Q1xy8Zr5R2up4f43XHUwMDBiJKaGK1x1MDAwNMKvhv6xJK6GjPpcdTAwMGKnW1x1MDAxMCv3RFx1MDAwMFx1MDAxMCPjJTx7ayfUMMmn7aOqoSCeXHUwMDE5wvhW1TAp5/A3Ml5C21xyz1Jdp91VKnudXHUwMDFkl1x1MDAxMFx1MDAxZHVcXPNWiHubX8OT6vlOqSxcdTAwMDJcdTAwMDRRKSCIXHUwMDFlXHUwMDAwWj7pXHUwMDFkU1m6dZVVKy89XHUwMDBiJ/k9XHUwMDFlprPcS/TdmM5cdTAwMTY9bcNcdOnsXG7p8eusfyyJ62zwS21cdTAwMDAlkjNcdKM7nc3DWuHoUt5cdTAwMTPzqdY6XHUwMDFjXHUwMDFl2s7+RSXdMlx1MDAxYiexXHUwMDE0taROSOhcdTAwMGX8q45aqF5fsvuWPVL5RmBcdTAwMTmfvNGGbdHIfWfuXHUwMDBmz1x1MDAwZVx1MDAwYlx1MDAwNlx1MDAxZlXcXHUwMDBmlZ9cdTAwMTX9hniJKoOgXFxcdTAwMTk3aqftMTFwsajBu3SD703EQ2xcdTAwMTN8XHUwMDEyMClcdTAwMTncpoe1SfDhwPRgjoRn5uLoxHeKSvKmwY3Kw+H57Vx1MDAxM7i7sq9cdTAwMWVSfvcpjn+RPPagwIJcdTAwMDPyYcAngvNiMWBMklx1MDAxOFx1MDAwZlx1MDAwM9t0XGYrre/5bp2cZNtcdTAwMWFu6bRcZtNccj4uolx1MDAxM1x1MDAxZpRcdTAwMWM2UDj4NNpcdTAwMTSt1trgXHUwMDAzivdcdTAwMDCkbIt3WjZcdD5cdTAwMTlcdTAwMTha4VRcdTAwMTJcdTAwMTIrslIhV63izXOn/8z2z1xcfH1+0iizdIOP+cBHt1x1MDAwYj4lNlx1MDAwMFwilHw+djrAXHUwMDA3UfCbXFyw91x1MDAxMlx1MDAwNFxucXT46Vd357D/fI6P2NFwaJZ0Pro4STf8hFx1MDAwZn6hz1x1MDAwNCRcdTAwMGY/ovxccikkT/whtpTAXHUwMDBmg0D4XHQkXHUwMDE4UN/Rpbc4NvhcdTAwMDBcdTAwMTlurlmtXGZcbja7vmNP1Vx1MDAxZINfXGL76Vx1MDAwMENcZsPh12o1ZEOuXHUwMDBiP2V1corwe7zBdSfQR1x1MDAwMtHHJs+Lk1x1MDAxOO8yv6xn8zWM+T46Z1x1MDAxN6OrbsFcdTAwMDGjjd1XfFx1MDAxZrtcdTAwMGZvXHUwMDE1fJBQJbxcdTAwMTB8XHUwMDE46Z17zuNNsE9cdTAwMTEjgSyG5VdcdTAwMWHVXHUwMDBl+4V2vXbj3Gu5w2qve3tV3C34hWWYbFx1MDAwMH5SSuV5XHUwMDAw8EHcXHUwMDBlSIPfWyxcdTAwMDRlXHUwMDFjYlx1MDAxMl16b/KgX7s/g9XLQc88XHUwMDE0w/GtdpLyXHUwMDA0pzex5lx1MDAxMPZjnMCmXGaHX1x1MDAxM9Rb61t+XG59XHUwMDA0Syo+XG75yUDyQ5BwNaD5LK9V6KtiMixpXHUwMDFkWqKdgnhcdTAwMTJ3/dtbcZRy9MXwO3RBJWisID+trqhr/YBcdTAwMWZcdTAwMDCEkI/j9spA8kOAMUYxRdG1t3rTcoZcdTAwMTcjUqyx0eFQg19cdTAwMWLmuJNu+MV5XHUwMDE0flx1MDAwM/Dz3Dxlbyf/7pZ0wFx1MDAwZsHAW21cYjGBXGKNcaetXGZEc4yqJ7hwhonFndtyrmumXHUwMDFifW/udoQ5XHUwMDFlyaNcdTAwMGZcdTAwMTHsJTl8mKBcdTAwMGJcdTAwMGJ++akgROB5XHUwMDFieFx1MDAxNfog75/fVfFAa+/nSt+/Zq9uu/XT3UJfmN+xXHUwMDAxw48hTpX6flx1MDAxNLeDXHUwMDA3glx1MDAwZnovXHUwMDBlXHUwMDE3XHUwMDEykOjKW79cdTAwMWFccr5/zaPH8nNcdTAwMTbv48uaQa/X+u9S0vnYffLog0yxXHUwMDAxZztp+H16TZrMaL3epauazPx6YWTmydCf80tDXHUwMDA03peXfDlcdTAwMDGvXHUwMDA3XHUwMDEwffJqzJ+ffv5cdTAwMWabOqdcdTAwMDIifQ== + + + + + A1,0B2,0C1,1E1,2D0,2F0,3 \ No newline at end of file diff --git a/2022/22-Monkey-Map/second.hs b/2022/22-Monkey-Map/second.hs new file mode 100644 index 0000000..82752cd --- /dev/null +++ b/2022/22-Monkey-Map/second.hs @@ -0,0 +1,143 @@ +-- requires cabal install --lib megaparsec parser-combinators vector +module Main (main) where +import Control.Monad (void, when) +import Data.Functor +import Data.List qualified as L +import Data.Maybe +import Data.Vector qualified as V +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char +import System.Exit (die) + +exampleExpectedOutput = 5031 + +type Line = V.Vector Char +type Map = V.Vector Line +data Instruction = Move Int | L | R deriving Show +data Input = Input Map [Instruction] deriving Show + +type Parser = Parsec Void String + +parseMapLine :: Parser Line +parseMapLine = do + line <- some (char '.' <|> char ' ' <|> char '#') <* char '\n' + return $ V.generate (length line) (line !!) + +parseMap :: Parser Map +parseMap = do + lines <- some parseMapLine <* char '\n' + return $ V.generate (length lines) (lines !!) + +parseInstruction :: Parser Instruction +parseInstruction = (Move . read <$> some digitChar) + <|> (char 'L' $> L) + <|> (char 'R' $> R) + +parseInput' :: Parser Input +parseInput' = do + m <- parseMap + i <- some parseInstruction + void $ optional (char '\n') <* eof + return $ Input m i + +parseInput :: String -> IO Input +parseInput filename = do + input <- readFile filename + case runParser parseInput' filename input of + Left bundle -> die $ errorBundlePretty bundle + Right input' -> return input' + +data Heading = N | S | E | W deriving (Eq, Show) +data Cursor = Cursor Int Int Heading + +isOut :: Map -> Int -> Int -> Bool +isOut m x y = isNothing line || isNothing tile || tile == Just ' ' + where + line = m V.!? y + tile = fromJust line V.!? x + +stepOutside :: Map -> Int -> Int -> Int -> Heading -> Int -> Cursor +stepOutside m s x y h i | (t, h) == (a, N) = proceed fw (fn + rx) E + | (t, h) == (a, W) = proceed dw (ds - ry) E + | (t, h) == (b, N) = proceed (fw + rx) fs N + | (t, h) == (b, E) = proceed ee (es - ry) W + | (t, h) == (b, S) = proceed ce (cn + rx) W + | (t, h) == (c, W) = proceed (dw + ry) dn S + | (t, h) == (c, E) = proceed (bw + ry) bs N + | (t, h) == (d, N) = proceed cw (cn + rx) E + | (t, h) == (d, W) = proceed aw (as - ry) E + | (t, h) == (e, E) = proceed be (bs - ry) W + | (t, h) == (e, S) = proceed fe (fn + rx) W + | (t, h) == (f, W) = proceed (aw + ry) an S + | (t, h) == (f, S) = proceed (bw + rx) bn S + | (t, h) == (f, E) = proceed (ew + ry) es N + where + (tx, rx) = x `divMod` s + (ty, ry) = y `divMod` s + t = (tx, ty) + proceed :: Int -> Int -> Heading -> Cursor + proceed x' y' h' = case m V.! y' V.! x' of + '.' -> step m s (Cursor x' y' h') (Move $ i - 1) + '#' -> Cursor x y h + a = (ax, ay) + b = (bx, by) + c = (cx, cy) + d = (dx, dy) + e = (ex, ey) + f = (fx, fy) + (ax, ay) = (1, 0) + (bx, by) = (2, 0) + (cx, cy) = (1, 1) + (dx, dy) = (0, 2) + (ex, ey) = (1, 2) + (fx, fy) = (0, 3) + (an, as, aw, ae) = (ay * s, (ay+1)*s-1, ax *s, (ax+1)*s-1) + (bn, bs, bw, be) = (by * s, (by+1)*s-1, bx *s, (bx+1)*s-1) + (cn, cs, cw, ce) = (cy * s, (cy+1)*s-1, cx *s, (cx+1)*s-1) + (dn, ds, dw, de) = (dy * s, (dy+1)*s-1, dx *s, (dx+1)*s-1) + (en, es, ew, ee) = (ey * s, (ey+1)*s-1, ex *s, (ex+1)*s-1) + (fn, fs, fw, fe) = (fy * s, (fy+1)*s-1, fx *s, (fx+1)*s-1) + +step :: Map -> Int -> Cursor -> Instruction -> Cursor +step _ _ (Cursor x y N) L = Cursor x y W +step _ _ (Cursor x y S) L = Cursor x y E +step _ _ (Cursor x y E) L = Cursor x y N +step _ _ (Cursor x y W) L = Cursor x y S +step _ _ (Cursor x y N) R = Cursor x y E +step _ _ (Cursor x y S) R = Cursor x y W +step _ _ (Cursor x y E) R = Cursor x y S +step _ _ (Cursor x y W) R = Cursor x y N +step m _ c (Move 0) = c +step m s (Cursor x y h) (Move i) | isOut m x' y' = stepOutside m s x y h i + | tile == '.' = step m s (Cursor x' y' h) (Move $ i - 1) + | tile == '#' = Cursor x y h + where + (x', y') = case h of + N -> (x, y-1) + S -> (x, y+1) + E -> (x+1, y) + W -> (x-1, y) + tile = m V.! y' V.! x' + +compute :: Input -> Int +compute (Input m i) = 1000 * (y+1) + 4 * (x+1) + hv + where + xmin = length (V.filter (== ' ') (m V.! 0)) + startingCursor = Cursor xmin 0 E + s = length (m V.! 0) `div` 3 + Cursor x y h = L.foldl' (step m s) startingCursor i + hv = case h of + E -> 0 + S -> 1 + W -> 2 + N -> 3 + +main :: IO () +main = do + -- not doing the example, this solution is dependent on the shape of the input cube and sadly the example does not match it + -- example <- parseInput "example" + -- let exampleOutput = compute example + -- when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput) + input <- parseInput "input" + print $ compute input -- cgit v1.2.3