我在Haskell上制作Backtracking有问题，我知道如何做递归函数但是当我尝试获得多个解决方案或最好的解决方案（回溯）时会遇到麻烦。
有一个包含一些字符串的列表，然后我需要获得从字符串到另一个字符串的解决方案，从字符串中更改一个字母，我将获得列表，第一个字符串和最后一个字符串。如果有解决方案返回它所执行的步骤计数，如果没有解决方案则返回-1。这是一个例子：
wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock"
然后我有我的列表，我需要从"spice"开始，然后转到"stock"
最佳解决方案是["spice","slice","slick","stick","stock"]，有四个步骤可以从"spice"转到"stock"。然后它返回4。
另一个解决方案是["spice","smice","slice","slick","stick","stock"]，有五个步骤到达"stock"然后它返回`5。但这是一个错误的解决方案，因为还有一个更好的步骤，而不是这个步骤。
我正在制作回溯以获得最佳解决方案时遇到麻烦，因为我不知道如何让我的代码搜索其他解决方案，而不是一个...
这是我试图制作的代码，但是我得到了一些错误，顺便说一句，我不知道我的“制作”回溯方式是否良好，或者是否有一些我没有看到的错误..
wordF :: [String] -> String -> String -> (String, String, Int)
wordF [] a b = (a, b, -1)
wordF list a b | (notElem a list || notElem b list) = (a, b, -1)
| otherwise = (a, b, (wordF2 list a b [a] 0 (length list)))
wordF2 :: [String] -> String -> String -> [String] -> Int -> Int -> Int
wordF2 list a b list_aux cont maxi | (cont==maxi) = 1000
| (a==b) = length list_aux
| (a/=b) && (cont<maxi) && notElemFound && (checkin /= "ThisWRONG") && (wording1<=wording2) = wording1
| (a/=b) && (cont<maxi) && notElemFound && (checkin /= "ThisWRONG") && (wording1>wording2) = wording2
| (a/=b) && (checkin == "ThisWRONG") = wordF2 list a b list_aux (cont+1) maxi
where
checkin = (check_word2 a (list!!cont) (list!!cont) 0)
wording1 = (wordF2 list checkin b (list_aux++[checkin]) 0 maxi)
wording2 = (wordF2 list checkin b (list_aux++[checkin]) 1 maxi)
notElemFound = ((any (==(list!!cont)) list_aux) == False)
check_word2 :: String -> String -> String -> Int -> String
check_word2 word1 word2 word3 dif | (dif > 1) = "ThisWRONG"
| ((length word1 == 1) && (length word2 == 1) && (head word1 == head word2)) = word3
| ((length word1 == 1) && (length word2 == 1) && (head word1 /= head word2) && (dif<1)) = word3
| ((head word1) == (head word2)) = check_word2 (tail word1) (tail word2) word3 dif
| otherwise = check_word2 (tail word1) (tail word2) word3 (dif+1)
我的第一个函数wordF2获取列表，开始，结束，一个辅助列表，以获取当前解决方案，其中第一个元素始终存在（[a]），一个计数器{ {1}}，以及计数器的最大尺寸（0）..
和第二个函数length list它检查一个单词是否可以传递给另一个单词，如check_word2到"spice"，如果它不能"slice"到"spice"它返回"spoca"。
此解决方案出现模式匹配失败错误
"ThisWRONG"我正在尝试一些小案例而且没有任何事情，而且我正在限制我在列表中的错误位置计数和最大值。
或者我可能不知道如何在haskell上实现回溯以获得多种解决方案，最佳解决方案等。
更新：我做了一个解决方案，但它没有回溯
Program error: pattern match failure: wordF2 ["slice","slick"] "slice" "slick" ["slice"] 0 1
嗯可能效率不高但至少可以解决问题.. 我搜索所有可行的解决方案，我比较head ==“slice”和last ==“stock”，然后我过滤那些解决方案并打印较短的解决方案， 谢谢，如果你们有任何建议说：）
答案 0 :(得分：3)
最近发表了几篇关于经典蛮力搜索问题的文章。
请注意，我的文章中的代码非常慢，因为它会测量完成的工作量以及执行的工作量。我的文章有很好的例子来说明如何快速拒绝搜索树的部分内容，但它应该只是一个例子 - 而不是生产代码。
答案 1 :(得分：3)
未经过彻底测试，但希望这会有所帮助：
import Data.Function (on)
import Data.List (minimumBy, delete)
import Control.Monad (guard)
type Word = String
type Path = [String]
wordF :: [Word] -> Word -> Word -> Path
wordF words start end =
start : minimumBy (compare `on` length) (generatePaths words start end)
-- Use the list monad to do the nondeterminism and backtracking.
-- Returns a list of all paths that lead from `start` to `end`
-- in steps that `differByOne`.
generatePaths :: [Word] -> Word -> Word -> [Path]
generatePaths words start end = do
-- Choose one of the words, nondeterministically
word <- words
-- If the word doesn't `differByOne` from `start`, reject the choice
-- and backtrack.
guard $ differsByOne word start
if word == end
then return [word]
else do
next <- generatePaths (delete word words) word end
return $ word : next
differsByOne :: Word -> Word -> Bool
differsByOne "" "" = False
differsByOne (a:as) (b:bs)
| a == b = differsByOne as bs
| otherwise = as == bs
示例运行：
>>> wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock"
["spice","slice","slick","stick","stock"]
Haskell中的列表monad通常被描述为一种非确定性的回溯计算形式。上面的代码正在做的是允许列表monad负责生成备选方案，测试它们是否满足标准，以及回溯到最近选择点的失败。列表monad的绑定，例如word <- words，表示＆＃34;不确定地选择其中一个words。 guard表示＆＃34;如果到目前为止的选择不满足此条件，则回溯并做出不同的选择。列表monad计算的结果是所有结果的列表，这些结果源于未违反任何guard的选择。
如果这看起来像列表推导，那么列表推导与列表monad相同 - 我选择用monad而不是理解来表达它。
答案 2 :(得分：1)
使用递归的强力方法：
import Data.List (filter, (\\), reverse, delete, sortBy)
import Data.Ord (comparing)
neighbour :: String -> String -> Bool
neighbour word = (1 ==) . length . (\\ word)
process :: String -> String -> [String] -> [(Int, [String])]
process start end dict =
let
loop :: String -> String -> [String] -> [String] -> [(Int,[String])] -> [(Int,[String])]
loop start end dict path results =
case next of
[] -> results
xs ->
if elem end xs
then (length solution, solution) : results
else results ++ branches xs
where
next = filter (neighbour start) dict'
dict' = delete start dict
path' = start : path
branches xs = [a | x <- xs, a <- loop x end dict' path' results]
solution = reverse (end : path')
in
loop start end dict [] []
shortestSolution :: Maybe Int
shortestSolution = shortest solutions
where
solutions = process start end dict
shortest s =
case s of
[] -> Nothing
xs -> Just $ fst $ head $ sortBy (comparing fst) xs
start = "spice"
end = "stock"
dict = ["spice","stick","smice","slice","slick","stock"]
注意：
此代码计算所有可能的解决方案（process）并选择最短的解决方案（shortestSolution），正如Carl所说，您可能希望修剪搜索树的某些部分以获得更好的性能。
首选函数无法返回结果时，使用Maybe而不是返回-1。
另一种使用广度优先搜索树的方法：
import Data.Tree
import Data.List( filter, (\\), delete )
import Data.Maybe
node :: String -> [String] -> Tree String
node label dict = Node{ rootLabel = label, subForest = branches label (delete label dict) }
branches :: String -> [String] -> [Tree String]
branches start dict = map (flip node dict) (filter (neighbour start) dict)
neighbour :: String -> String -> Bool
neighbour word = (1 ==) . length . (\\ word)
-- breadth first traversal
shortestBF tree end = find [tree] end 0
where
find ts end depth
| null ts = Nothing
| elem end (map rootLabel ts) = Just depth
| otherwise = find (concat (map subForest ts)) end (depth+1)
result = shortestBF tree end
tree :: Tree String
tree = node start dict
start = "spice"
end = "stock"
dict = ["spice","stick","smice","slice","slick","stock"]