Question

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

我们可以通过一个替换（word - ＆gt; cord）来获得另一个单词
这个词（在我的例子中“cord”）应该在我们的单词列表中

所以，如果我们有列表[单词，绳子，穿着]，我们需要一个从穿到绳子的梯子，答案将会穿 - ＆gt;字 - ＆gt;线。我尝试使用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

这很简单，因为我们可以按顺序（map）直接递归每个孩子，然后取得第一次成功（msum）。但是当我们做BFS时，我们还需要对一个＆＃34; context＆＃34;通过，这意味着我们必须用我们自己的迭代器替换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 ²）性能，因为它们＆＃39; ll＆＃34;叠加＆＃34;。这是因为列表本身就是＆＃34; LIFO＆＃34; （后进先出）队列，而你想要一个＆＃34; FIFO＆＃34; （先进先出）队列。

在您确定此漏洞明显之前，您仍应使用该解决方案。这个缺陷的经典解决方案是摊销这些成本（接受O（N）成本，只要他们只发生O（1 / N）的时间）有两个列表，但是那里有＆＃39;通过使列表本身具有脊柱严格性，这也是Haskell获得的巨大好处，因此您不会构建大量的thunk：

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

请注意，我们仍然允许一个具有无限子项列表的节点，并注意通常应该避免这种开销，因为这段代码可能比早期代码复杂4倍，对于小代码来说可能要慢很多输入（因为++的开销可能比检测rev步骤和构建新Fifo的开销轻得多。）先做简单的事情，如果失败我们可以接近更难的方式。

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

1 个答案: