Abhinav 🧭
@abnv.me
70 followers 7 following 296 posts
Programming languages aficionado, occasional runner, quantified-self enthusiast, and fervent napper. Works as senior software engineer at Google on […] 🌉 bridged from ⁂ fantastic.earth/@abnv, follow @ap.brid.gy to interact
![Haskell code:
main :: IO ()
main = AoC.main solvePart1 solvePart2 $ \input ->
let (stripes : _ : patterns) = lines input
in (BS.pack stripes & BS.split ',' & map (BS.strip >>> (,())) & Trie.fromList, patterns)
where
solvePart1 (t, patterns) = patterns & filter (countCombs t >>> (/= 0)) & length
solvePart2 (t, patterns) = patterns & map (countCombs t) & sum
countCombs t = memoFix $ \f pattern -> case pattern of
[] -> 1
_ -> pattern & BS.pack & Trie.matches t & map (thd3 >>> BS.unpack >>> f) & sum](https://cdn.bsky.app/img/feed_thumbnail/plain/did:plc:gckksq3w47mvvljzgyrt4pj2/bafkreigq4462ucb7sqoqmaxapkx6ajazu5nasdak5xfkhytdplxkzuaw5e)
![Haskell code:
main :: IO ()
main = AoC.main solvePart1 solvePart2 parse
where
solvePart1 = sum . mapMaybe solveAStar
solvePart2 =
sum . mapMaybe (solveLinear . (\(Machine a b p) -> Machine a b (p + 10000000000000)))
data Machine = Machine !(V2 Integer) !(V2 Integer) !(V2 Integer)
deriving (Show)
parse :: String -> [Machine]
parse input = case P.readP_to_S (P.sepBy1 machine newline <* P.eof) input of
[(parsed, "")] -> parsed
xs -> error $ "No parse: " <> show xs
where
machine = Machine <$> (move 'A' <* newline) <*> (move 'B' <* newline) <*> (prize <* newline)
move c =
V2
<$> (P.string "Button " *> P.char c *> P.string ": X+" *> digits)
<*> (P.string ", Y+" *> digits)
prize = V2 <$> (P.string "Prize: X=" *> digits <* P.string ", Y=") <*> digits
digits = read <$> P.readS_to_P lexDigits
newline = P.char '\n'
solveAStar :: Machine -> Maybe Int
solveAStar (Machine a b prize) = fmap fst . flip (astar (V2 0 0) prize) (const 400) $ \cur ->
if cur < prize then [(cur + a, 3), (cur + b, 1)] else []
solveLinear :: Machine -> Maybe Int
solveLinear (Machine a b prize) =
let V2 (V1 aMoves) (V1 bMoves) =
inv22 (transpose $ fmap fromIntegral <$> V2 a b) !*! transpose (V1 $ fromIntegral <$> prize)
in if isPositiveInteger aMoves && isPositiveInteger bMoves
then Just $ round $ 3 * aMoves + bMoves
else Nothing
where
isPositiveInteger x = x > 0 && denominator (approxRational x 0.0001) == 1](https://cdn.bsky.app/img/feed_thumbnail/plain/did:plc:gckksq3w47mvvljzgyrt4pj2/bafkreiepojly527onec6vxiifxslug7jnxl77u3mlix5tmraij7f5wemhm)
![Haskell code:
main :: IO ()
main = AoC.main solvePart1 solvePart2 parse
where
solvePart1 = pathsToTop >>> map (ordNub >>> length) >>> sum
solvePart2 = pathsToTop >>> map length >>> sum
parse =
lines
>>> zip [0 ..]
>>> map (\(i, row) -> zipWith (\j c -> ((j, i), digitToInt c)) [0 ..] row)
>>> (\rows -> (Map.fromList $ concat rows, length (head rows), length rows))
pathsToTop (grid, width, height) =
Map.assocs grid
& filter ((== 0) . snd)
& Tree.unfoldForest (id &&& nexts)
& map (Tree.levels >>> (!! 9))
where
nexts ((x, y), alt) =
[ (point', alt')
| (x', y') <- [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)],
x' >= 0 && x' < width && y' >= 0 && y' < height,
let point' = (x', y'); alt' = grid Map.! point',
alt' == alt + 1
]](https://cdn.bsky.app/img/feed_thumbnail/plain/did:plc:gckksq3w47mvvljzgyrt4pj2/bafkreig6agi7zviqfvv57qu2psq6qalqatq4w5dit7f2afsirqin3tah74)