Implement Haskell Backtracking

Question

I have a problem with returning to Haskell, I know how to perform recursive functions, but I have problems when I try to get some solutions or better (reverse search).

There is a list with some lines, then I need to get solutions to go from line to line, changing one letter from a line, I will get a list, the first line and the last. If there is a solution, return the counter of the steps that he took; if there is no solution, it returns -1 . here is an example:

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

Then I have my list, and I need to start with "spice" and go to "stock" and the best solution is ["spice","slice","slick","stick","stock"] with four steps for transition from "spice" to "stock" . then it returns 4 .

Another solution is ["spice","smice","slice","slick","stick","stock"] with five steps to get to "stock" , then it returns `5. But this is the wrong decision, because there is another one that is better with fewer steps than this.

I'm having problems with the countdown to get a better solution, because I don’t know how to make my code look for other solutions and just not one.

Here is the code I tried to do, but I am getting some errors. By the way, I don’t know if my way to “roll back” is good, or if there are some errors that I don’t see.

  wordF :: [String] -> String -> String -> (String, String, Int) wordF [] ab = (a, b, -1) wordF list ab | (notElem a list || notElem b list) = (a, b, -1) | otherwise = (a, b, (wordF2 list ab [a] 0 (length list))) wordF2 :: [String] -> String -> String -> [String] -> Int -> Int -> Int wordF2 list ab 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 ab 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) 

My first wordF2 function gets a list, start, end, auxiliary list to get the current solution with the first element that will always be there ( [a] ), a counter with 0 and the maximum size of the counter ( length list ) ..

and the second function check_word2 checks if the word can go to another word, for example, "spice" - "slice" , if it does not match "spice" before "spoca" , it returns "ThisWRONG" .

This solution receives a pattern matching error

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

I tried with small cases and nothing, and I limit that I get the wrong position of the list with the score and the maximum value.

Or maybe I don’t know how to implement backtracking on haskell to get multiple solutions, a better solution, etc.

UPDATE: I made a decision, but did not return

 wordF :: [String] -> String -> String -> (String, String, Int) wordF [] ab = (a, b, -1) wordF list ab | (notElem a list || notElem b list) = (a, b, -1) | otherwise = (a, b, (wordF1 list ab)) wordF1 :: [String] -> String -> String -> Int wordF1 list ab | ((map length (wordF2 (subconjuntos2 (subconjuntos list) ab))) == []) = -1 | (calculo > 0) = calculo | otherwise = -1 where calculo = (minimum (map length (wordF2 (subconjuntos2 (subconjuntos list) ab))))-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 [] ab = [] subconjuntos2 (x:xs) ab | (length x <= 1) = subconjuntos2 xs ab | ((head x == a) && (last x == b)) = (x:subconjuntos2 xs ab) | ((head x /= a) || (last x /= b)) = (subconjuntos2 xs ab) subconjuntos :: [a] -> [[a]] subconjuntos [] = [[]] subconjuntos (x:xs) = [x:ys | ys <- sub] ++ sub where sub = subconjuntos xs 

Mmm may be ineffective, but at least he makes a decision. I look for all possible solutions, I compare head == "slice" and last == "stock", then filter those that are solution and print shorter ones, thanks, and if you guys suggest saying that :)

Answer 1

Not fully verified, but this will hopefully help:

 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 

Execution Example:

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

Haskell's list monad is usually described as a form of non-deterministic countdown. What the above code does allows the list monad to take responsibility for generating alternatives, checking whether they meet the criteria and rolling back from failure to the very last point of choice. Linking a monad list, for example. word <- words means "non-deterministically select one of the words . guard means" if the choice still does not satisfy this condition, back and makes another choice. The result of calculating the list monad is a list of all the results that follow from the options that did not violate any guard s.

If this seems like an understanding of lists, well, enumerated understandings are the same as a list of monads - I decided to express it as a monad instead of understanding.

Answer 2

Recently, several articles have been published about the challenges of finding brute force.

• Marc Dominus has posted a simple example of using lists for a simple, comprehensive search.
• Justin Le, with a small modification in a previous article, made it easy to keep track of the current state of the search.
• I considered an additional modification that allowed me to measure the profit from an early rejection of a part of the search tree.

Please note that the code in my article is rather slow because it measures the amount of work done and also does it. My article has good examples of how to quickly dismiss parts of the search tree, but this should only be considered as an illustration, not a production code.

Answer 3

Brute force approach using recursion:

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

Notes:

• This code calculates all possible solutions ( process ) and selects the shortest ( shortestSolution ), as Karl said, you might want to trim parts of the search tree for better performance.

• Using Maybe instead of returning -1 when the function may not return results is preferable.

---

Another way to use the width-search tree:

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