如何为字符串列表编写 Haskell BFS 算法

Question

我尝试使用 Haskell 解决 "ladder" 问题。任务是在相同长度的两个单词之间的单词列表中找到最短路径（如果存在）。单词连接规则是

我们可以用一个替换（单词 -> 线）从另一个单词中获取一个单词
这个单词（在我的示例中 "cord"）应该在我们的单词列表中

所以，如果我们有列表[word, cord, wore] 并且我们需要一个从 wore 到 cord 的阶梯，答案将是 wear -> word -> cord。我尝试使用 bfs 算法来解决这个问题。为了获得单词的邻居，我使用下一个函数

--(x:xs) - letters
getChanged :: [String] -> [Char] -> [String] -> [String]
getChanged cont (x:xs) ans = 
    if length xs == 0
    then ans ++ [cont !! 0 ++ [x] ++ cont !! 1]
    else getChanged cont xs (ans ++ [cont !! 0 ++ [x] ++ cont !! 1])

--get for getChanged
divide :: String -> Int -> [String]
divide word index = [(take index word)] ++ [(drop (index + 1) word)]


--word alphabet indexToChange AnswerAcc Answer
getNeighbours :: String -> [Char] -> Int -> [String] -> [String]
getNeighbours word alphabet index answerAcc = 
    if index == length word
    then
        answerAcc
    else
        getNeighbours word alphabet (index + 1) (answerAcc ++ (getChanged (divide word index) alphabet []))

main = do
    putStrLn (unlines (getNeighbours "hello kitty" ['a', 'b', 'c'] 0 []))

梯子签名是这样的

ladder :: String -> String -> String -> IO()
ladder word1 word2 words = do
    content <- readFile words
    let words = lines content
    let myWords = Set.fromList (filter (\x -> length x == length word1) words)
    if not (Set.member word1 myWords) || not (Set.member word2 myWords)  
    then error "Path not found"
    else do
        let b = ["1"]
        putStrLn $ unlines b
        print $ length b

我尝试使用 HashSet 和 HashMap 但一无所获。现在我坚持这一点。我的问题是这个问题怎么写bfs？

Answer 1

所以 BFS 是早期编程中的一个常见问题，虽然它的解决方案并不特定于 Haskell，Haskell 的函数性质使事情变得有点棘手。那么让我们从 DFS 开始：

import Control.Monad (msum)

dfs target tree@(Tree value children)
  | value == target = Just tree
  | otherwise       = msum $ map (dfs target) children

这个很简单，因为我们可以直接在每个children上依次递归（map），然后取第一个成功的（msum）。但是，当我们进行 BFS 时，我们还需要通过线程 "context"，这意味着我们必须将 map 替换为我们自己的迭代器：

bfs target tree = go [tree] where
  go [] = Nothing
  go (tree@(Tree value children) : rest)
    | value == target = Just tree
    | otherwise       = go (rest ++ children)

这是一个有效的 BFS，但有一个主要缺陷：在 Haskell 中，++ 为将来的访问添加了一个条件操作，这里最终会导致 O(n²) 表现，因为他们会 "stack up"。这是因为列表本身是 "LIFO"（last-in 是 first-out）队列，而您需要 "FIFO"（first-in 是 first-out）队列。

在确定此缺陷明显之前，您仍应使用该解决方案。该缺陷的经典解决方案是使用两个列表摊销这些成本（接受 O(N) 成本，只要它们只发生 O(1/N) 的时间），但是有通过自己制作列表 spine-strict，在 Haskell 中也可以获得巨大的好处，这样您就不会构建大量的 thunks:

-- spine-strict linked-lists
data SL x = Nil | Cons x !(SL x) deriving (Eq, Ord, Read, Show)

rev sl = go sl Nil where -- reversal
    go Nil xs = xs
    go (Cons x xs) ys = go xs (Cons x ys)

-- finite fifo queues
data Fifo x = Fifo !(SL [x]) !(SL [x])

append x (Fifo l r) = Fifo l (Cons x r)
{-# INLINE append #-}

firstRest (Fifo Nil Nil) = Nothing
firstRest (Fifo Nil r) = let (Cons x l) = rev r in Just (x, Fifo l Nil)
firstRest (Fifo (Cons x l) r) = Just (x, Fifo l r)
{-# INLINE firstRest #-} 
-- ^ we can't get rid of `rev`, which is recursive, but hopefully this INLINE 
-- will eliminate the cost to make the Maybe terms and the Haskell pair. We
-- could also manually unroll this ourselves into the case analysis of the
-- method below.

bfs target tree = go [tree] Nil where
  go bufs [] = case firstRest bufs of
                 Nothing -> Nothing
                 Just (buf, bufs') -> go buf bufs'
  go bufs (tree@(Tree value children) : xs)
     | value == target = Just tree
     | otherwise       = go (append children bufs) xs

请注意，我们仍然允许节点具有 children 的无限列表，并注意通常应避免这种开销，因为这段代码的认知复杂度可能是早期代码的 4 倍，甚至可能对于小输入要慢很多（因为 ++ 的开销可能比检测 rev 步骤和构建新的 Fifos 的开销要轻。）首先以简单的方式做事，如果失败了，我们可以采用更难的方法。

如何为字符串列表编写 Haskell BFS 算法

How to write Haskell BFS algorithm for the list of strings

algorithm

haskell

breadth-first-search