Solution en Haskell

Problème intéressant, il me rappelle le jour 17 de 2022.
J'ai écrit une fonction tilt qui fait tomber les briques vers l'ouest.
Pour cela, pour chaque ligne, je split la ligne selon # et pour chaque morceau du split, je sépare les O et les "." et je reconcatène tout en mettant les O d'abord et les "." ensuite.

Ensuite j'ai une fonction tiltInDirection qui se ramène à tilt en faisant des rotate et des reverse selon le cas de figure.

Pour la partie 2, je génère une suite infinie cyclique de North, West, South, East
et à partir de celle ci, je génère une liste infinie des différentes configurations après avoir effectué les tilts dans la direction donnée.
Dans cette liste, je cherche les indices x et y de la même configuration (fonction findRepetition) et la configuration qui nous intéresse est celle à l'indice x + (1000000000 - x) mod (y - x).

La partie 2 tourne en 600ms. Pas très satisfait mais ça reste raisonnable.

Voici le code

import AOC.Prelude hiding (empty)
import Data.List ((!!))
import AOC (aoc)
import qualified Data.HashMap.Strict as Map
import AOC.Parser (Parser, sepEndBy1, eol, some)
import AOC.Util (flattenWithIndex, splitWhen)
data Rock = Empty | Round | Cube deriving (Eq, Enum)
data Direction = West | East | North | South
type Grid = [[Rock]]
instance Hashable Rock where
 hashWithSalt s rock = s `hashWithSalt` fromEnum rock
parser :: Parser Grid
parser = some rock `sepEndBy1` eol where
 rock = Empty <$ "." <|> Round <$ "O" <|> Cube <$ "#"
-- tilt to West
tilt :: Grid -> Grid
tilt = map perRow where
 perRow = intercalate [Cube] . map go . splitWhen (==Cube)
 go xs = rounded ++ empty where (rounded, empty) = partition (==Round) xs
tiltInDirection :: Direction -> Grid -> Grid
tiltInDirection = \case
 West -> tilt
 East -> map reverse . tilt . map reverse
 North -> transpose . tilt . transpose
 South -> reverse . transpose . tilt . transpose . reverse
-- return the first two indices of the same element in a infinite list of elements
findRepetition :: Hashable a => [a] -> (Int, Int)
findRepetition = go Map.empty . zip [0..] where
 go m ((i, x) : xs) =
 case m Map.!? x of
 Just j -> (j, i)
 Nothing -> go (Map.insert x i m) xs
 go _ [] = error "findRepetition: not an infinite list"
-- compute the laod of a grid
load :: Grid -> Int
load grid = sum . map score $ flattenWithIndex grid where
 score (i, _, Round) = len - i
 score _ = 0
 len = length grid
part1 :: Grid -> Int
part1 = load . tiltInDirection North
part2 :: Grid -> Int
part2 grid = load (grids !! y') where 
 (x, y) = findRepetition grids
 y' = x + (1000000000 - x) `mod` (y-x)
 grids = scanl' (flip tiltInDirection) grid directions
 directions = cycle [North, West, South, East]
solve :: Text -> IO ()
solve = aoc parser part1 part2