Search code examples
haskellhaskell-lens

Generating all ways of applying a function to a single element with lens


This question is based on to the 11th advent of code task. It basically is a more general version of the river crossing puzzle, you can go up and down floors while carrying one or two items each step. The goal is to bring up all items to the 4th floor.
This is fairly straightforward to solve with an A* search but finding the neighboring states is somewhat annoying.

When solving the puzzle originally I just created masks for all items on the current floor and then used the list monad to generate the combinations - slow and awkward but it works. I figured that there would be an elegant solution using lenses, though.

An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]


For the sake of reference, this is the best I could come up with so far, slightly simplified:

import Control.Lens
import Data.List (sort)
import Data.Set (fromList, Set)

type GenFloor = Int
type ChipFloor = Int
type State = [(GenFloor, ChipFloor)]

neighborStates :: Int -> State -> Set State
neighborStates currentFloor state = finalize $ createStatesTowards =<< [pred, succ]
  where
    createStatesTowards direction = traverseOf (traverse . both) (moveTowards direction) state
    moveTowards direction i
      | i == currentFloor = [direction i, i]
      | otherwise         = [i]

    finalize = fromList . map sort . filter valid
    valid = (&&) <$> validCarry <*> validFloors
    validCarry = (`elem` [1..2]) . carryCount 
    carryCount = length . filter (uncurry (/=)) . zip state
    validFloors = allOf (traverse . each) (`elem` [1..4])

Solution

  • An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]

    holesOf can do that. Quoting the relevant simplified signature from the documentation:

    holesOf :: Traversal' s a -> s -> [Pretext' (->) a s]
    

    Given a traversal, holesOf will generate a list of contexts focused on each element targeted by the traversal. peeks from Control.Comonad.Store can then be used to, from each context, modify the focused target and recreate the surrounding structure:

    import Control.Lens
    import Control.Comonad.Store
    
    -- allMoves :: Int -> Int -> State -> [State]
    allMoves :: (Traversable t, Eq a) => a -> a -> t (a, b) -> [t (a, b)]
    allMoves src dst its = peeks (changeFloor src dst) <$> holesOf traverse its
        where
        -- changeFloor :: Int -> Int -> (Int, Int) -> (Int, Int)
        changeFloor src dst = over both (\x -> if x == src then dst else x)
    
    GHCi> allMoves 1 2 [(1,0),(1,2)]
    [[(2,0),(1,2)],[(1,0),(2,2)]]