Lights Out (1)

--Converts a move into a bitmask
naiveMove :: Int -> Int --Size of the grid
          -> Int -> Int --Coordinates of the move
          -> Integer    --Resulting grid data
naiveMove width height moveX moveY = foldl set 0 $ (moveX, moveY) : neighbors where
    set bits (x, y)
        | x < 0 || y < 0 || x >= width || y >= height = bits
        | otherwise                                   = bits `setBit` ((y * width) + x)
    neighbors = [(moveX + i, moveY + j) | i <- [-1..1], j <- [-1..1], abs i + abs j == 1]

Lights Out (2)

lightsOut :: [String] -> Int
lightsOut (validateGrid -> g)
    | null solutions = error "No solution" 
    | otherwise      = snd outcome 
    where
        (width, height) = (length g, length $ head g)
        stringToBits str = foldl (\i (s, c) -> if c == '1' then i `setBit` s else i) 0 $ zip [0..] (concat str)
        --The input field as an integer (bits representing lights)
        initial = stringToBits g
        --Get the indices of ones in a number
        ones moves = filter (testBit moves) [0..width - 1] 
        --All possible plays in the first row
        openings = (initial, 0) : map (playRow initial 0 . ones &&& popCount) [(0 :: Integer)..2 ^ width - 1] 
        maskGen = naiveMove width height
        --A vector of all possible moves (for quick lookups)
        moveMasks = V.fromList [maskGen x y | y <- [0..height - 1], x <- [0..width - 1]]
        --Click the lights specified by "moves" in the row "row"
        playRow field row moves = foldl xor field masks where
            masks = map (\i -> moveMasks V.! (row * width + i)) moves
        --Click the lights below every turned-on light in the row above
        chaseRow n (field, m) = (playRow field (n + 1) moves, m + length moves) where
            moves = filter (testBit field . (n * width +)) [0..width - 1]
        --Eliminate lights row by row
        chaseLights field openMoves = foldl (flip chaseRow) (field, openMoves) [0..height - 2]
        --All solutions for which the resulting field is all zeroes
        solutions = filter ((== 0) . fst) $ map (uncurry chaseLights) openings
        --The minimal number of moves to turn off all the lights
        outcome = minimumBy (comparing snd) solutions