Thực hiện Backtracking trên Haskell

Question

Tôi gặp sự cố khi tạo Backtracking trên Haskell, tôi biết cách thực hiện các hàm đệ quy nhưng tôi gặp khó khăn khi cố gắng lấy nhiều giải pháp hoặc giải pháp tốt nhất (backtracking).

Có danh sách với một số chuỗi, sau đó tôi cần lấy các giải pháp để lấy từ chuỗi này sang chuỗi khác thay đổi một chữ cái từ chuỗi, tôi sẽ nhận danh sách, chuỗi đầu tiên và chuỗi cuối cùng. Nếu có giải pháp trả về số bước mà nó đã làm, nếu không có giải pháp, nó trả về -1. đây là một ví dụ:

wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock" 

Sau đó, tôi có danh sách của tôi và tôi cần phải bắt đầu với "spice" và nhận được để "stock" và giải pháp tốt nhất là ["spice","slice","slick","stick","stock"] với bốn bước để có được "spice"-"stock". sau đó nó trở về 4.

Một giải pháp khác là ["spice","smice","slice","slick","stick","stock"] với năm bước để truy cập "stock" sau đó trả về `5. Nhưng đây là một giải pháp sai vì có một giải pháp khác tốt hơn với các bước nhỏ hơn so với bước này.

Tôi đang gặp khó khăn thực hiện một tùy ý để có được những giải pháp tốt nhất, bởi vì tôi không biết làm thế nào để làm cho rằng tìm kiếm mã của tôi khác các giải pháp và chỉ cần không phải là một ..

Dưới đây là một mã mà tôi đã cố gắng để làm nhưng tôi nhận được một số lỗi, btw i dont biết nếu tôi cách nào để "làm cho" quay lui là tốt hay nếu có một số sai lầm mà im không nhìn thấy ..

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) 

chức năng đầu tiên của tôi wordF2 có được danh sách, khi bắt đầu , cuối cùng, một danh sách phụ trợ để có được giải pháp hiện tại với phần tử đầu tiên luôn ở đó ([a]), một truy cập wi thứ 0, và kích thước tối đa của bộ đếm (length list) ..

và chức năng thứ hai check_word2 nó sẽ kiểm tra nếu một từ có thể vượt qua để từ khác, như "spice"-"slice" nếu nó không thể thích "spice" để "spoca" nó trả "ThisWRONG".

Giải pháp này được một lỗi thất bại mô hình phù hợp

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

Tôi đã cố gắng với trường hợp ít và không có gì, và tôi đang hạn chế mà tôi có được một vị trí sai của danh sách với số lượng và tối đa.

Hoặc có thể là tôi không biết làm thế nào để thực hiện thụt lùi trên Haskell để có được nhiều giải pháp, giải pháp tốt nhất, vv ..

UPDATE: Tôi đã làm một giải pháp nhưng không thụt lùi

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 có thể không hiệu quả nhưng ít nhất là giải pháp .. tôi tìm kiếm tất cả các giải pháp khả thi, tôi so sánh head == "slice" và last == "stock", sau đó tôi lọc những giải pháp và in ngắn hơn, cảm ơn và nếu các bạn có đề xuất hãy nói điều đó :)

Answer 1

Không kiểm tra kỹ lưỡng, nhưng điều này hy vọng sẽ giúp:

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 

Ví dụ chạy:

>>> wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock" 
["spice","slice","slick","stick","stock"] 

Danh sách đơn nguyên trong Haskell thường được mô tả như một hình thức không xác định, backtracking tính toán. Những gì mã ở trên đang làm là cho phép đơn vị danh sách đảm trách việc tạo ra các lựa chọn thay thế, kiểm tra xem chúng có đáp ứng các tiêu chí hay không và ngược lại khi không có điểm lựa chọn gần đây nhất. Liên kết của danh sách đơn lẻ, ví dụ: word <- words, có nghĩa là "nondeterministically chọn một trong các words. guard có nghĩa là" nếu sự lựa chọn cho đến nay không đáp ứng điều kiện này, quay lại và thực hiện một sự lựa chọn khác nhau. Kết quả của việc tính toán danh sách đơn là danh sách tất cả các kết quả xuất phát từ các lựa chọn không vi phạm bất kỳ guard s nào.

Nếu đây trông giống như comprehensions danh sách, tốt, danh sách comprehensions là những điều tương tự như danh sách các đơn nguyên-I đã chọn để thể hiện nó với đơn nguyên thay vì comprehensions.

Answer 2

Đã có một số bài viết được xuất bản gần đây về các vấn đề tìm kiếm bạo lực cổ điển.

• Mark Dominus xuất bản a simple example of using lists để tìm kiếm toàn diện đơn giản.
• Justin Lê theo dõi với a small modification đến bài viết trước đó đơn giản hóa việc theo dõi tình trạng hiện thời của tìm kiếm.
• tôi theo dõi với a further modification cho phép đo lường lợi ích từ chối sớm một phần của cây tìm kiếm.

Lưu ý rằng mã trong bài viết của tôi khá chậm vì nó đo lường số lượng công việc đã hoàn thành cũng như thực hiện. Bài viết của tôi có các ví dụ tốt về cách nhanh chóng từ chối các phần của cây tìm kiếm, nhưng nó chỉ nên được xem là một minh hoạ - không phải là mã sản xuất.

Answer 3

Một cách tiếp cận brute force sử dụng đệ quy:

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

Ghi chú:

• Mã này tính tất cả các giải pháp possibles (process) và chọn ngắn nhất một (shortestSolution), như Carl nói, bạn có thể muốn cắt tỉa các phần của cây tìm kiếm để có hiệu suất tốt hơn.

• Sử dụng Maybe thay vì trả lại -1 khi một hàm có thể không trả về kết quả được ưu tiên.

---

Một cách khác để sử dụng một cây với tìm kiếm theo chiều rộng:

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