Guillaume.B a écrit 54 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)