在Haskell上实现回溯

Question

我在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]),一个计数器0,以及计数器的最大大小(length list).

和第二函数check_word2它检查是否一个字可以传递到另一个字,如"spice"以"slice"如果它不能像"spice"到"spoca"它返回"ThisWRONG".

此解决方案会出现模式匹配失败的错误

  Program error: pattern match failure: wordF2 ["slice","slick"] "slice" "slick" ["slice"] 0 1

我正在尝试一些小案例而且没有任何事情,而且我正在限制我在计数和最大值的位置得到错误的位置.

或者可能是我不知道如何在haskell上实现回溯以获得多种解决方案,最佳解决方案等.

更新:我做了一个解决方案,但它没有回溯

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, (wordF1 list a b))

wordF1 :: [String] -> String -> String -> Int
wordF1 list a b | ((map length (wordF2 (subconjuntos2 (subconjuntos list) a b))) == []) = -1
            | (calculo > 0) = calculo
            | otherwise = -1
             where
             calculo = (minimum (map length (wordF2 (subconjuntos2 (subconjuntos list) a b))))-1

wordF2 :: [[String]] -> [[String]]
wordF2 [[]] = []
wordF2 (x:xs) | ((length xs == 1) && ((check_word x) == True) && ((check_word (head xs)) == True)) = x:xs
          | ((length xs == 1) && ((check_word x) == False) && ((check_word (head xs)) == True)) = xs
          | ((length xs == 1) && ((check_word x) == True) && ((check_word (head xs)) == False)) = [x]
          | ((length xs == 1) && ((check_word x) == False) && ((check_word (head xs)) == False)) = []
          | ((check_word x) == True) = x:wordF2 xs
          | ((check_word x) == False ) = wordF2 xs

check_word :: [String] -> Bool
check_word [] = False
check_word (x:xs) | ((length xs == 1) && ((check_word2 x (head xs) 0) == True)) = True
              | ((length xs >1) && ((check_word2 x (head xs) 0) == True)) = True && (check_word xs)
              | otherwise = False 

check_word2 :: String -> String -> Int -> Bool
check_word2 word1 word2 dif | (dif > 1) = False
                        | ((length word1 == 1) && (length word2 == 1) && (head word1 == head word2)) = True
                        | ((length word1 == 1) && (length word2 == 1) && (head word1 /= head word2) && (dif<1)) = True
                        | ((head word1) == (head word2)) = check_word2 (tail word1) (tail word2) dif
                        | otherwise = check_word2 (tail word1) (tail word2) (dif+1)

subconjuntos2 :: [[String]] -> String -> String -> [[String]]
subconjuntos2 [] a b     = []
subconjuntos2 (x:xs) a b | (length x <= 1) = subconjuntos2 xs a b
                     | ((head x == a) && (last x == b)) = (x:subconjuntos2 xs a b)
                     | ((head x /= a) || (last x /= b)) = (subconjuntos2 xs a b)

subconjuntos :: [a] -> [[a]]
subconjuntos []     = [[]]
subconjuntos (x:xs) = [x:ys | ys <- sub] ++ sub
where sub = subconjuntos xs

Mmm可能是它的低效率,但至少它确实解决了..我搜索所有可行的解决方案,我比较head =="slice"和last =="stock",然后我过滤那些解决方案并打印较短的解决方案,谢谢,如果你们有任何建议说:)

Answer 1

尚未经过全面测试，但这有望帮助您：

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中的list monad通常被描述为一种不确定的回溯计算形式。上面的代码正在做的事情是让列表monad负责生成替代项，测试替代项是否满足条件，并在失败时回溯到最近的选择点。list monad的绑定，例如word <- words，表示“不确定地选择其中一个words。” guard表示“如果到目前为止选择不满足此条件，请回溯并进行其他选择。” list monad计算的结果是所有未违反任何guards的选择得出的所有结果的列表。

如果这看起来像列表推导，那么列表推导与列表单举是一回事—我选择用单举代替表达。