Implementare il backtracking su Haskell

Question

Ho un problema nel fare Backtracking su Haskell, so come eseguire le funzioni ricorsive ma ho problemi quando cerco di ottenere più soluzioni o la migliore (backtracking).

C'è una lista con alcune stringhe, quindi ho bisogno di ottenere le soluzioni per passare da una stringa ad un'altra cambiando una lettera dalla stringa, otterrò la lista, la prima stringa e l'ultima. Se la soluzione restituisce il conteggio dei passaggi eseguiti, se non c'è soluzione restituisce -1. ecco un esempio:

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

allora ho la mia lista e ho bisogno di iniziare con "spice" e arrivare a "stock" e la soluzione migliore è ["spice","slice","slick","stick","stock"] con quattro passi per arrivare "spice"-"stock". quindi restituisce 4.

Un'altra soluzione è ["spice","smice","slice","slick","stick","stock"] con cinque passaggi per arrivare a "stock" quindi restituire `5. Ma questa è una soluzione sbagliata perché ce n'è un'altra migliore con passi minori di questa.

sto avendo problemi facendo un backtracking per ottenere la soluzione migliore, perché io non so come fare che la mia ricerca di codice di un altro soluzioni e non solo uno ..

Ecco un codice che ho provato a faccio ma ottengo alcuni errori, btw io non so se il mio modo di "fare" backtracking è buono o se ci sono alcuni errori che non im vedendo ..

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) 

la mia prima funzione wordF2 ottieni la lista, l'inizio , alla fine, un elenco ausiliario per ottenere la soluzione corrente con il primo elemento che sarà sempre lì ([a]), un contatore wi esimo 0, e la dimensione massima del contatore (length list) ..

e la seconda funzione check_word2 controlla se una parola può passare ad un'altra parola, come "spice"-"slice" se cant come "spice" per "spoca" ritorna "ThisWRONG".

Questa soluzione ottiene un errore di pattern match fallimento

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

Stavo cercando con piccoli casi e nulla, e mi sto limitando che ottengo una posizione sbagliata della lista con il conteggio e la max.

O può essere non so come implementare backtracking su Haskell per ottenere molteplici soluzioni, la migliore soluzione, ecc ..

UPDATE: ho fatto una soluzione, ma la sua non 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 potrebbe essere il suo inefficiente, ma almeno lo fa la soluzione .. ricerca tutte le soluzioni possibili, confronto head == "slice" e last == "stock", quindi filtro quelli che sono la soluzione e stampo il più corto, grazie e se voi ragazzi avete qualche suggerimento ditelo :)

Answer 1

Non accuratamente testati, ma questo si spera aiuterà:

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 

Esempio gestito:

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

La lista monad in Haskell è comunemente descritta come una forma di calcolo non deterministico, backtracking. Ciò che sta facendo il codice sta permettendo alla lista monad di assumersi la responsabilità di generare alternative, testare se soddisfano i criteri e tornare indietro nel caso in cui non si sia raggiunto il punto di scelta più recente. Il binding della lista monad, ad es. word <- words, significa "scegliere in modo non determinante uno degli words. guard significa" se le scelte finora non soddisfano questa condizione, tornare indietro e fare una scelta diversa. Il risultato di una lista di calcoli monad è l'elenco di tutti i risultati che derivano da scelte che non violano alcun guard s.

Se questo assomiglia alle list comprehensions, beh, le list comprehensions sono la stessa cosa della lista monad-ho scelto di esprimerlo con la monade invece che con le comprensioni.

Answer 2

Ci sono stati diversi articoli pubblicati recentemente sui classici problemi di ricerca di forza bruta.

• Mark Dominus ha pubblicato a simple example of using lists per una ricerca esaustiva semplice.
• Justin Le ha seguito con a small modification all'articolo precedente che ha semplificato il monitoraggio dello stato corrente della ricerca.
• Ho seguito con a further modification che ha consentito di misurare i guadagni dal rifiuto precoce di una parte dell'albero di ricerca.

Si noti che il codice nel mio articolo è piuttosto lento perché sta misurando la quantità di lavoro svolto oltre a farlo. Il mio articolo ha buoni esempi su come rifiutare rapidamente parti dell'albero di ricerca, ma dovrebbe essere considerato solo un'illustrazione, non un codice di produzione.

Answer 3

Un approccio forza bruta utilizzando la ricorsione:

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

Note:

• Questo codice calcola tutte le soluzioni Possibles (process) e selezionare il più breve (shortestSolution), come ha detto Carl, è potrebbe voler sfoltire parti dell'albero di ricerca per prestazioni migliori.

• L'utilizzo di Maybe invece di restituire -1 quando una funzione non riesce a restituire i risultati è preferibile.

---

Un altro modo con un albero con ampiezza di ricerca:

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