生成将函数应用于带透镜的单个元素的所有方法

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

本题基于11th代码任务的出现。它基本上是一个更一般版本的过河谜题,你可以在每一步携带一两个物品的情况下上下楼层。目标是把所有物品都带上4楼。
使用 A* 搜索可以很简单地解决这个问题,但是找到邻近的状态有点烦人。

最初解决这个难题时,我只是为当前楼层的所有项目创建掩码,然后使用列表 monad 生成组合 - 缓慢而笨拙,但它有效。不过,我认为使用镜头会有一个优雅的解决方案。

一个简单的解决方案可以使用 returns 将单个项目从 x 层移动到 y 层的所有选项的函数。有没有办法获得使用镜头将功能应用于单个元素的所有组合?即 f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]


为了便于参考,这是迄今为止我能想到的最好的,稍微简化了:

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])

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 可以做到。引用文档中的相关简化签名:

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

给定一个遍历,holesOf 将生成一个上下文列表,重点放在遍历所针对的每个元素上。 Control.Comonad.Store 中的 peeks 然后可用于从每个上下文修改聚焦目标并重新创建周围结构:

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)]]