Guillaume.B a écrit 79 commentaires

Quelques commentaires sur ce que j'ai fait.

Tout d'abord, par soucis de simplicité, je rajoute un symbole Operational (".") à la fin de la liste des sources.
Ensuite, je calcule un tableau nextOperational qui pour chaque index dans la liste des sources me renvoie l'index de la prochaine source opérationnelle. Ca se fait aisément en temps linéaire et ça me permet d'optimiser le temps de calcul dans la programmation dynamique.

Maintenant vient la programmation dynamique.
Je note springs et groups la liste des sources et des groupes respectivement.
J'essaie de résoudre récursivement le problème suivant:
étant donné pos et groupPos combien y a-t-il d'arrangemnts dans la sous liste springs[pos:] satisfaisant les contraintes groups[groupPos:]. Je note f une telle fonction.
Le cas de base est quand pos == taille(springs). Si groupPos = taille(groups), ça veut dire que les listes springs[pos:] et groups[groupPos:] sont vides. Ca match bien donc f(pos, groupPos) = 1. Sinon, f(pos, groupPos) = 0.
Dans le cas récursif, il y a deux possibilités (non mutuellement excluses).
Si la source à la position springs[pos] est opérationnelle ou inconnue alors je rajoute
f(pos, groupPos+1) à f(pos, groupPos).
L'autre cas est quand le bloc groups[groupPos] peut rentrer à la position pos.
Pour vérifier cela, j'utilise mon tableau nextOperational et le fait donc en temps constant.
Si le bloc rentre, je rajoute f(pos+groups[groupPos]+1, groupPos+1) à f(pos, groupPos).

Je ne vais pas rentrer dans les détails mais j'obtiens au final une complexité en O(|springs| . |groups|) et du coup une résolution en 30ms pour la partie 2.

Solution en Haskell par programmation dynamique.
La partie 1 prend 5ms et la partie 2 prend 30ms

import AOC.Prelude
import AOC (aoc)
import AOC.Parser (Parser, sepEndBy1, some, eol, decimal, hspace)
import qualified Data.Vector as V
import Data.Array (listArray, range, (!))
data Spring = Operational | Damaged | Unknown deriving (Eq, Show)
type Row = ([Spring], [Int])
parser :: Parser [Row]
parser = row `sepEndBy1` eol where
 row = (,) <$> some spring <* hspace <*> decimal `sepEndBy1` ","
 spring = Operational <$ "." <|> Damaged <$ "#" <|> Unknown <$ "?"
countArrangements :: Row -> Integer
countArrangements (springs, groups) = arr ! (0, 0) where
 vsprings = V.fromList (springs ++ [Operational])
 springsLength = V.length vsprings
 vGroups = V.fromList groups
 groupsLength = V.length vGroups
 nextOperational = V.generate springsLength \i ->
 if vsprings V.! i == Operational then i else nextOperational V.! (i+1)
 arr = listArray bds [
 let currentSpring = vsprings V.! pos
 currentGroupSize = vGroups V.! groupPos
 in
 if pos == springsLength then
 if groupPos == groupsLength then 1 else 0
 else
 let nextOp = nextOperational V.! pos
 pos' = pos + currentGroupSize
 x = if currentSpring /= Damaged then arr ! (pos + 1, groupPos) else 0
 y = if groupPos < groupsLength && nextOp >= pos' && vsprings V.! pos' /= Damaged
 then arr ! (pos' + 1, groupPos + 1)
 else 0
 in x + y
 | (pos, groupPos) <- range bds
 ]
 bds = ((0, 0), (springsLength, groupsLength))
part1 :: [Row] -> Integer
part1 = sum . map countArrangements
part2 :: [Row] -> Integer
part2 = sum . map (countArrangements . unfold) where
 unfold = bimap (intercalate [Unknown] . replicate 5) (concat . replicate 5)

Voici ma solution en Haskell.
La partie 1 utilise un BFS mais c'est un peu overkill.
La partie 2 repose sur des idées similaires à ce qu'a proposé Pierre.
Une partie non négligeable du code (la fonction getNiceInput) chercher à determiner quelle est la tuile adéquate pour remplacer la tuile Start.

import AOC.Prelude hiding (head)
import Data.List (head, maximum)
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import AOC (aoc)
import AOC.Parser (Parser, choice, eol, sepEndBy1, some)
import AOC.Search (bfs)
import AOC.Util (adjacentPoints, listTo2dMap)
import AOC.Tuple (thd3)
data Tile = NS | EW | NE | NW | SW | SE | Empty | Start deriving (Eq)
type Coord = (Int, Int)
type Input = [[Tile]]
type Matrix = HashMap Coord Tile
parser :: Parser Input
parser = some tile `sepEndBy1` eol where
 tile = choice [NS <$ "|", EW <$ "-", NE <$"L", NW <$ "J", SW <$ "7", SE <$ "F", Empty <$ ".", Start <$ "S"]
-- returns the start coordinate and the input where the start tile is replaced with the adequate tile 
getNiceInput :: Input -> (Input, Matrix, Coord)
getNiceInput tiles = (cleanedTiles, cleanedMat, start) where
 start = head [pos | (pos, Start) <- Map.toList mat]
 mat = listTo2dMap tiles
 adequateTile = case [start `elem` neighbors mat nbor | nbor <- neighbors mat start] of
 -- (x-1, y), (x+1, y), (x, y-1), (x, y+1)
 [True, True, False, False] -> NS
 [False, False, True, True] -> EW
 [True, False, False, True] -> NE
 [True, False, True, False] -> NW
 [False, True, False, True] -> SE
 [False, True, True, False] -> SW
 _ -> Empty -- cannot happen if the input is nice
 cleanedMat = Map.insert start adequateTile mat
 cleanedTiles = [ [ if tile == Start then adequateTile else tile | tile <- row] 
 | row <- tiles
 ]
neighbors :: Matrix -> Coord -> [Coord]
neighbors mat (i, j) = case mat Map.!? (i, j) of
 Just NS -> [(i-1, j), (i+1, j)]
 Just EW -> [(i, j-1), (i, j+1)]
 Just NE -> [(i-1, j), (i, j+1)]
 Just NW -> [(i, j-1), (i-1, j)]
 Just SW -> [(i+1, j), (i, j-1)]
 Just SE -> [(i, j+1), (i+1, j)]
 Just Start -> adjacentPoints (i, j)
 _ -> []
part1 :: Input -> Int
part1 tiles = maximum . map fst $ bfs (neighbors mat) start where 
 (_, mat, start) = getNiceInput tiles
part2 :: Input -> Int
part2 tiles = sum . map countRow $ cleanedTiles where
 (tiles', mat, start) = getNiceInput tiles
 loopSet = Set.fromList . map snd $ bfs (neighbors mat) start
 -- replace each tile not in the loop with an empty tile
 cleanedTiles = [ [ if (i, j) `Set.member` loopSet then tile else Empty
 | (j, tile) <- zip [0..] row
 ] 
 | (i, row) <- zip [0..] tiles'
 ]
 countRow = thd3 . foldl' go (False, False, 0)
 go (isInside, fromNorth, counter) = \case
 NS -> (not isInside, fromNorth, counter)
 NE -> (isInside, True, counter)
 SE -> (isInside, False, counter)
 NW -> (isInside == fromNorth, fromNorth, counter)
 SW -> (isInside /= fromNorth, fromNorth, counter)
 Empty -> (isInside, fromNorth, if isInside then counter+1 else counter)
 _ -> (isInside, fromNorth, counter)
solve :: Text -> IO ()
solve = aoc parser part1 part2

Hello tout le monde, c'est mon premier post sur linuxfr (même si je fréquente le site depuis longtemps).

Voici une solution en Haskell (pour ne pas faire comme tout le monde et accessoirement c'est mon langage préféré).
Pas de commentaire à faire la dessus. C'était un problème assez simple.

type Coord = (Int, Int)
type Grid = [[Bool]]
parser :: Parser Grid
parser = some isGalaxy `sepEndBy1` eol where
 isGalaxy = False <$ "." <|> True <$ "#"
manhattan :: Coord -> Coord -> Int
manhattan (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
gridToCoords :: Grid -> [Coord]
gridToCoords grid = [(i, j) | (i, row) <- zip [0..] grid, (j, True) <- zip [0..] row] 
countEmptyRows :: Grid -> Vector Int
countEmptyRows = V.fromList . drop 1 . scanl' (\acc row -> if all not row then acc+1 else acc) 0
solveWith :: Int -> Grid -> Int
solveWith expand grid = sum (manhattan <$> expGalaxies <*> expGalaxies) `div` 2 where
 galaxies = gridToCoords grid
 emptyRows = countEmptyRows grid
 emptyCols = countEmptyRows (transpose grid)
 expGalaxies = [(x + (expand - 1) * emptyRows V.! x, y + (expand - 1) * emptyCols V.! y) | (x, y) <- galaxies]
solve :: Text -> IO ()
solve = aoc parser (solveWith 2) (solveWith 1000000)