Avatar

gentooer

gentooer@programming.dev
Joined
2 posts • 321 comments
Direct message

Really going the extra mile looking for the original image, thanks!

permalink
report
parent
reply

Is this upscaled with AI? It’s full of very weird image artifacts.

permalink
report
reply

Naked Capitalism is a known mouthpiece for Russian propaganda (example).

permalink
report
reply
  1. Yes
  2. Cold-blooded is the default, different forms of warm-bloodedness developed independently of one another
  3. Yes
permalink
report
parent
reply

Haskell

Runs in 115 ms. Today’s pretty straight forward. Memoization feels like magic sometimes!

Code
import Control.Monad.Memo
import Data.List

splitX :: Eq a => [a] -> [a] -> [[a]]
splitX xs = go
    where
        go [] = [[]]
        go ys@(y : ys') = case stripPrefix xs ys of
            Just ys'' -> [] : go ys''
            Nothing   -> let (zs : zss) = go ys' in (y : zs) : zss

parse :: String -> ([String], [String])
parse s =
    let (patterns : _ : designs) = lines s
    in  (splitX ", " patterns, takeWhile (not . null) designs)

countPatterns :: (Eq a, Ord a) => [[a]] -> [a] -> Memo [a] Int Int
countPatterns yss = go
    where
        go [] = return 1
        go xs = sum <$> sequence
            [memo go xs' | Just xs' <- map (\ys -> stripPrefix ys xs) yss]

main :: IO ()
main = do
    (patterns, designs) <- parse <$> getContents
    let ns = startEvalMemo $ mapM (countPatterns patterns) designs
    print $ length $ filter (> 0) ns
    print $ sum ns
permalink
report
reply

Haskell

Not really happy with performance, binary search would speed this up a bunch, takes about 1.3 seconds.

Update: Binary search got it to 960 ms.

Code
import Data.Maybe
import qualified Data.Set as S

type Coord = (Int, Int)

parse :: String -> [Coord]
parse = map (read . ('(' :) . (++ ")")) . takeWhile (not . null) . lines

shortest :: Coord -> [Coord] -> Maybe Int
shortest (x0, y0) corrupted' = go $ S.singleton (x0 - 1, y0 - 1)
    where
        corrupted = S.fromList corrupted'
        inside (x, y)
            | x < 0     = False
            | y < 0     = False
            | x0 <= x   = False
            | y0 <= y   = False
            | otherwise = True
        grow cs = S.filter inside $ S.unions $ cs :
            [ S.mapMonotonic (\(x, y) -> (x + dx, y + dy)) cs
            | (dx, dy) <- [(-1, 0), (0, -1), (0, 1), (1, 0)]
            ]
        go visited
            | (0, 0) `S.member` visited = Just 0
            | otherwise                 = case grow visited S.\\ corrupted of
                visited'
                    | S.size visited == S.size visited' -> Nothing
                    | otherwise                         -> succ <$> go visited'

main :: IO ()
main = do
    rs <- parse <$> getContents
    let size = (71, 71)
    print $ fromJust $ shortest size $ take 1024 rs
    putStrLn $ init $ tail $ show $ last $ zipWith const (reverse rs) $
        takeWhile (isNothing . shortest size) $ iterate init rs
Faster (binary search)
import Data.Maybe
import qualified Data.Set as S

type Coord = (Int, Int)

parse :: String -> [Coord]
parse = map (read . ('(' :) . (++ ")")) . takeWhile (not . null) . lines

shortest :: Coord -> [Coord] -> Maybe Int
shortest (x0, y0) corrupted' = go $ S.singleton (x0 - 1, y0 - 1)
    where
        corrupted = S.fromList corrupted'
        inside (x, y)
            | x < 0     = False
            | y < 0     = False
            | x0 <= x   = False
            | y0 <= y   = False
            | otherwise = True
        grow cs = S.filter inside $ S.unions $ cs :
            [ S.mapMonotonic (\(x, y) -> (x + dx, y + dy)) cs
            | (dx, dy) <- [(-1, 0), (0, -1), (0, 1), (1, 0)]
            ]
        go visited
            | (0, 0) `S.member` visited = Just 0
            | otherwise                 = case grow visited S.\\ corrupted of
                visited'
                    | S.size visited == S.size visited' -> Nothing
                    | otherwise                         -> succ <$> go visited'

solve2 :: Coord -> [Coord] -> Coord
solve2 r0 corrupted = go 0 $ length corrupted
    where
        go a z
            | succ a == z = corrupted !! a
            | otherwise   =
                let x = (a + z) `div` 2
                in  case shortest r0 $ take x corrupted of
                        Nothing -> go a x
                        Just _  -> go x z

main :: IO ()
main = do
    rs <- parse <$> getContents
    let size = (71, 71)
    print $ fromJust $ shortest size $ take 1024 rs
    putStrLn $ init $ tail $ show $ solve2 size rs
permalink
report
reply

Haskell

Runs in 10 ms. I was stuck for most of the day on the bdv and cdv instructions, as I didn’t read that the numerator was still register A. Once I got past that, it was pretty straight forward.

Code
import Control.Monad.State.Lazy
import Data.Bits (xor)
import Data.List (isSuffixOf)
import qualified Data.Vector as V

data Instr =
        ADV Int | BXL Int | BST Int | JNZ Int | BXC | OUT Int | BDV Int | CDV Int
type Machine = (Int, Int, Int, Int, V.Vector Int)

parse :: String -> Machine
parse s =
    let (la : lb : lc : _ : lp : _) = lines s
        [a, b, c] = map (read . drop 12) [la, lb, lc]
        p = V.fromList $ read $ ('[' :) $ (++ "]") $ drop 9 lp
    in  (a, b, c, 0, p)

getA, getB, getC, getIP :: State Machine Int
getA  = gets $ \(a, _, _, _ , _) -> a
getB  = gets $ \(_, b, _, _ , _) -> b
getC  = gets $ \(_, _, c, _ , _) -> c
getIP = gets $ \(_, _, _, ip, _) -> ip

setA, setB, setC, setIP :: Int -> State Machine ()
setA  a  = modify $ \(_, b, c, ip, p) -> (a, b, c, ip, p)
setB  b  = modify $ \(a, _, c, ip, p) -> (a, b, c, ip, p)
setC  c  = modify $ \(a, b, _, ip, p) -> (a, b, c, ip, p)
setIP ip = modify $ \(a, b, c, _ , p) -> (a, b, c, ip, p)

incIP :: State Machine ()
incIP = getIP >>= (setIP . succ)

getMem :: State Machine (Maybe Int)
getMem = gets (\(_, _, _, ip, p) -> p V.!? ip) <* incIP

getCombo :: State Machine (Maybe Int)
getCombo = do
    n <- getMem
    case n of
        Just 4          -> Just <$> getA
        Just 5          -> Just <$> getB
        Just 6          -> Just <$> getC
        Just n | n <= 3 -> return $ Just n
        _               -> return Nothing

getInstr :: State Machine (Maybe Instr)
getInstr = do
    opcode <- getMem
    case opcode of
        Just 0 -> fmap        ADV  <$> getCombo
        Just 1 -> fmap        BXL  <$> getMem
        Just 2 -> fmap        BST  <$> getCombo
        Just 3 -> fmap        JNZ  <$> getMem
        Just 4 -> fmap (const BXC) <$> getMem
        Just 5 -> fmap        OUT  <$> getCombo
        Just 6 -> fmap        BDV  <$> getCombo
        Just 7 -> fmap        CDV  <$> getCombo
        _      -> return Nothing

execInstr :: Instr -> State Machine (Maybe Int)
execInstr (ADV n) = (getA >>= (setA . (`div` (2^n)))) *> return Nothing
execInstr (BDV n) = (getA >>= (setB . (`div` (2^n)))) *> return Nothing
execInstr (CDV n) = (getA >>= (setC . (`div` (2^n)))) *> return Nothing
execInstr (BXL n) = (getB >>= (setB . xor n)) *> return Nothing
execInstr (BST n) = setB (n `mod` 8) *> return Nothing
execInstr (JNZ n) = do
    a <- getA
    case a of
        0 -> return ()
        _ -> setIP n
    return Nothing
execInstr  BXC    = ((xor <$> getB <*> getC) >>= setB) *> return Nothing
execInstr (OUT n) = return $ Just $ n `mod` 8

run :: State Machine [Int]
run = do
    mInstr <- getInstr
    case mInstr of
        Nothing    -> return []
        Just instr -> do
            mOut <- execInstr instr
            case mOut of
                Nothing ->           run
                Just n  -> (n :) <$> run

solve2 :: Machine -> Int
solve2 machine@(_, _, _, _, p') = head [a | x <- [1 .. 7], a <- go [x]]
    where
        p = V.toList p'
        go as =
            let a = foldl ((+) . (* 8)) 0 as
            in  case evalState (setA a *> run) machine of
                    ns  | ns == p           -> [a]
                        | ns `isSuffixOf` p ->
                            concatMap go [as ++ [a] | a <- [0 .. 7]]
                        | otherwise         -> []

main :: IO ()
main = do
    machine@(_, _, _, _, p) <- parse <$> getContents
    putStrLn $ init $ tail $ show $ evalState run machine
    print $ solve2 machine
permalink
report
reply

Haskell

Runs in 12 ms. I was very happy with my code for part 1, but will sadly have to rewrite it completely for part 2.

Code
import Control.Monad.State.Lazy
import qualified Data.Map.Strict as M

type Coord = (Int, Int)
data Block = Box | Wall
type Grid = M.Map Coord Block

parse :: String -> ((Coord, Grid), [Coord])
parse s =
    let robot = head
            [ (r, c)
            | (r, row) <- zip [0 ..] $ lines s
            , (c, '@') <- zip [0 ..] row
            ]
        grid = M.fromAscList
            [ ((r, c), val)
            | (r, row) <- zip [0 ..] $ lines s
            , (c, Just val) <- zip [0 ..] $ map f row
            ]
    in  ((robot, grid), go s)
    where
        f 'O' = Just Box
        f '#' = Just Wall
        f _ = Nothing
        go ('^' : rest) = (-1,  0) : go rest
        go ('v' : rest) = ( 1,  0) : go rest
        go ('<' : rest) = ( 0, -1) : go rest
        go ('>' : rest) = ( 0,  1) : go rest
        go (_   : rest) =            go rest
        go [] = []

add :: Coord -> Coord -> Coord
add (r0, c0) (r1, c1) = (r0 + r1, c0 + c1)

moveBoxes :: Coord -> Coord -> Grid -> Maybe Grid
moveBoxes dr r grid = case grid M.!? r of
    Nothing   -> Just grid
    Just Wall -> Nothing
    Just Box  ->
        M.insert (add r dr) Box . M.delete r <$> moveBoxes dr (add r dr) grid

move :: Coord -> State (Coord, Grid) Bool
move dr = state $ \(r, g) -> case moveBoxes dr (add r dr) g of
    Just g' -> (True, (add r dr, g'))
    Nothing -> (False, (r, g))

moves :: [Coord] -> State (Coord, Grid) ()
moves = mapM_ move

main :: IO ()
main = do
    ((robot, grid), movements) <- parse <$> getContents
    let (_, grid') = execState (moves movements) (robot, grid)
    print $ sum [100 * r + c | ((r, c), Box) <- M.toList grid']
permalink
report
reply