具有 Set 的通用深度优先搜索算法

Question

我正在尝试实现具有以下类型签名的通用深度优先搜索算法：

dfs :: (Ord a) => (a -> [a]) -> a -> [a]

我从这篇博文中得到了一个参考：

dfs2 :: (Ord a) => (a -> Set a) -> a -> [a]
dfs2 succ start = loop [start] (Set.singleton start) where
loop [] _ = []
loop (x:xs) visited = x : loop (Set.toList new ++ xs) (Set.union visited new)
where new = Set.difference (succ x) visited

它的工作原理是执行DFS，并且只访问同一元素一次。

f 1 = Set.fromList [2, 3]
f 2 = Set.fromList [3, 4, 5, 6]
f _ = Set.empty
ghci> dfs2 f 1
[1,2,4,5,6,3]

但是由于dfs2需要返回Set a而不是[a]f :: (a -> Set a)，因此我无法指定要访问的元素的顺序。

例如，如果f2定义如下：

f2 1 = Set.fromList [3, 2]
f2 2 = Set.fromList [6, 5, 4, 3]
f2 _ = Set.empty

它将返回相同的结果

ghci> dfs2 f2 1
[1,2,4,5,6,3]

但我想要的是[1,3,2,6,5,4]

我不知道如何对 dfs2 进行更改以使用类型签名实现

dfs :: (Ord a) => (a -> [a]) -> a -> [a]

这样，DFS 将仅按[a]指定的顺序访问每个元素一次。和

dfs f2 1 == [1,3,2,6,5,4]

有人有想法吗？

Answer 1

您可以根据一组来自左侧的访问节点和来自右侧的其余结果来编写dfs2。

本周我的头陷入了褶皱，所以首先我将定义一个折叠的概念，该折叠对来自左侧的严格左关联值和来自右侧的惰性右关联值进行操作; 写出dfs2的显式版本可能对您更有说明意义。

{-# LANGUAGE BangPatterns #-}
foldboth :: ((l, r) -> a -> (l, r)) -> (l, r) -> [a] -> (l, r)
foldboth f = go
where
go (l, r) [] = (l, r)
go (l, r) (x:xs) = (l'', r'')
where
(l', r'') = f (l, r') x
(l'', r') = go (l', r) xs
foldboth' :: ((l, r) -> a -> (l, r)) -> (l, r) -> [a] -> (l, r)
foldboth' f = foldboth f'
where
f' (!l, r) = f (l, r)

深度优先搜索可以通过折叠后续搜索来定义，跳过已经访问过的集合，并将未访问的集合添加到从左到右行进的集合和从右到左行进的结果中。

dfs2 :: (Ord a) => (a -> [a]) -> a -> [a]
dfs2 succ start = snd $ go (Set.empty, []) [start] where
go = foldboth' step
step (visited, remaining) x = 
if Set.member x visited
then (visited, remaining)
else (visited', x:remaining')
where
(visited', remaining') = go (Set.insert x visited, remaining) (succ x) 

这给出了所需的结果

> dfs2 f2 1
[1,3,2,6,5,4]