Общий алгоритм поиска в глубину с помощью 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 принимает f :: (a -> Set a), который возвращает Set a, а не [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]