Implementacja śledzenia wstecznego na Haskell

Question

Mam problem z nawracaniem na Haskell, wiem, jak wykonywać funkcje rekursywne, ale pojawia się problem, gdy próbuję uzyskać wiele rozwiązań lub najlepszy (cofanie).

Istnieje lista z pewnymi ciągami, a następnie muszę uzyskać rozwiązania, aby uzyskać ciąg od innego do zmieniającego jedną literę z ciągu, otrzymam listę, pierwszy ciąg i ostatni. Jeśli istnieje rozwiązanie zwraca liczbę kroków, które zrobił, jeśli nie ma rozwiązania, zwraca -1. Oto przykład:

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

Wtedy mam listę i muszę zacząć "spice" i dostać się do "stock" i najlepszym rozwiązaniem jest ["spice","slice","slick","stick","stock"] z czterech kroków, aby dostać się z "spice" do "stock". następnie zwraca 4.

Kolejne rozwiązanie to ["spice","smice","slice","slick","stick","stock"] z pięcioma krokami, aby uzyskać "stock", a następnie zwraca `5. Ale jest to niewłaściwe rozwiązanie, ponieważ istnieje inny, który jest lepszy przy mniejszych krokach niż ten.

Mam kłopoty dokonywania Backtracking aby uzyskać najlepsze rozwiązanie, bo nie wiedzą, jak sprawić, że moje wyszukiwanie kodu innego rozwiązania i nie tylko jeden ..

Oto kod, który próbowałem zrobić, ale ja dostać jakieś błędy, btw ja nie wiem, czy mój sposób, żeby „zrobić” wycofywania jest dobre lub jeśli istnieją pewne błędy, które im nie widząc ..

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) 

Moja pierwsza funkcja wordF2 uzyskać listę, początek , koniec, lista pomocnicza, aby uzyskać aktualne rozwiązanie z pierwszym elementem, który zawsze będzie tam ([a]), licznik wi p 0, a maksymalny rozmiar licznika (length list) ..

i drugiej funkcji check_word2 sprawdza czy słowo może przejść do innego słowa, jak "spice" do "slice" jeśli cant jak "spice" do "spoca" powraca "ThisWRONG".

To rozwiązanie staje się naruszenia wzór meczu awarii

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

Próbowałam z małych spraw i nic, a ja ograniczając że dostanę złą pozycję na liście z obliczeniem i max.

Albo może być nie wiem jak zaimplementować wycofywania Haskell dostać wiele rozwiązań najlepszym rozwiązaniem, etc ..

UPDATE: Zrobiłem rozwiązaniem, ale jej nie backtracking

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 może być jego nieefektywnym rozwiązaniem, ale przynajmniej rozwiązuje ... Przeszukuję wszystkie możliwe rozwiązania, porównuję głowę == "plaster" i ostatnią == "zapasy", a następnie filtruję te, które są rozwiązaniem i wypiszę krótszy, dzięki a jeśli macie jakieś sugestie, to powiedzcie:

Answer 1

Nie gruntownie przetestowany, ale mam nadzieję, że pomoże:

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 

przykład uruchomić:

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

Monada listy w Haskell jest powszechnie opisywana jako forma niedeterministycznego obliczania nawrotów. Powyższy kod robi to, aby monada listy wzięła na siebie odpowiedzialność za generowanie alternatyw, testowanie, czy spełniają kryteria, i wycofywanie w przypadku niepowodzenia w najnowszym punkcie wyboru. Wiązanie monada listy, np. word <- words, oznacza "niedeterministycznie wybrać jeden z words. guard oznacza" jeśli wybory do tej pory nie spełniają tego warunku, z powrotem do tyłu i dokonać innego wyboru. Wynikiem obliczenia monad listy jest lista wszystkich wyników, które wynikają z wyborów, które nie naruszyły żadnych guard s.

Jeśli to wygląda na spisane rozumowanie, no cóż, rozumienie listowe to to samo, co monada z listy - zdecydowałem się wyrazić ją monadą zamiast rozumienia.

Answer 2

Ostatnio opublikowano kilka artykułów na temat klasycznych problemów z wyszukiwaniem brutalnych sił.

• Mark Dominus opublikował a simple example of using lists dla prostego wyczerpującego wyszukiwania.
• Justin Le skontaktował się z a small modification do poprzedniego artykułu, który uprościł śledzenie obecnego stanu wyszukiwania.
• Połączyłem się z a further modification, który umożliwił pomiar zysków z wcześniejszego odrzucenia części drzewa wyszukiwania.

Należy zauważyć, że kod w moim artykule jest dość wolny, ponieważ mierzy ilość wykonanej pracy i jej wykonanie. Mój artykuł zawiera dobre przykłady szybkiego odrzucania części drzewa wyszukiwania, ale należy go traktować jedynie jako ilustrację - a nie kod produkcyjny.

Answer 3

brute podejście siła użyciem rekurencji:

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

Uwagi:

• Ten kod wylicza wszystkie possibles rozwiązań (process) i wybierz najkrótsza (shortestSolution), jak Carl powiedziałem, może chcieć wyczyścić części drzewa wyszukiwania w celu zwiększenia wydajności.

• Korzystanie z Maybe zamiast zwracania -1, gdy funkcja może nie zwrócić wyników, jest preferowane.

---

Innym sposobem, za pomocą drzewa z wszerz wyszukiwania:

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