Question: Given is haskell code for solving famouse eightPuzzle Problem. Sample solution provided import Data.List (sortBy) import Data.Function (on) main = putStrLn $ concat $ map
Given is haskell code for solving famouse eightPuzzle Problem. Sample solution provided
import Data.List (sortBy) import Data.Function (on) main = putStrLn $ concat $ map showState8 solution solution :: [[Int]] solution = aStar [2,8,3,1,6,4,7,0,5] [1,2,3,8,0,4,7,6,5] h'8 genStates8 aStar :: Eq a => a -> a -> (a->a->Int) -> (a->[a]) -> [a] aStar start goal h' genStates = expand [(h' start goal, [start])] where expand ((score, path):nodes) | head path == goal = reverse path | otherwise = expand $ sortBy (compare `on` fst) (nodes ++ newNodes) where newNodes = [(length path + h' state goal, state:path) | state [Int] -> Int h'8 state goal = length $ filter (\(x, y) -> x /= 0 && x /= y) (zip state goal) genStates8 :: [Int] -> [[Int]] genStates8 state = map newState $ swapLists!!(length $ takeWhile (/= 0) state) where swapLists = [[1,3],[0,2,4],[1,5],[0,4,6],[1,3,5,7],[2,4,8],[3,7],[6,4,8],[5,7]] newState pos = map (swap $ state!!pos) state swap p n = if n == p then 0 else if n == 0 then p else n showState8 :: [Int] -> String showState8 state = " +---+---+---+ | " ++ piece 0 ++ " | " ++ piece 1 ++ " | " ++ piece 2 ++ " | +---+---+---+ | " ++ piece 3 ++ " | " ++ piece 4 ++ " | " ++ piece 5 ++ " | +---+---+---+ | " ++ piece 6 ++ " | " ++ piece 7 ++ " | " ++ piece 8 ++ " | +---+---+---+ " where piece pos = if state!!pos == 0 then " " else show $ state!!pos
Please answer the following questions in haskell language
(a) The imperfection of the code is that the pattern matching for the expand function within aStar is incomplete. Clearly, it is not defined for an empty list, which it would encounter if there were no more nodes to expand, i.e., no solution was found for the given problem. So please write a new function aStar2 that fixes this problem and outputs an empty list if no solution was found.
(b) Unfortunately, you will notice that for an unsolvable problem (for example, try switching the first two numbers, 2 and 8, in the start state) you still do not receive an empty list. Depending on your compiler/interpreter and its parameters you will get a timeout, a stack overflow, or a desperate attempt to solve the problem that could take an eternity. It would in fact take a huge amount of time and space (memory resources) for the algorithm to determine that the problem has no solution. The issue here is that even though we avoid circuits during search, there are still too many nodes to be expanded. Not knowing at what depth to expect the solution, the algorithm searches deeper and deeper without success. You probably have an idea of how to tackle this problem: iterative deepening. First write a function aStar3 that is just like aStar2 but receives a fifth input maxDepth :: Int that indicates the maximum depth for the search. The idea is to not create any new nodes whose depth is greater than maxDepth. Now test the new function aStar3. Finally, write a function aStarID that receives the same inputs as aStar3 but performs iterative deepening. It starts with a maximum search depth of 0, and if it does not find a solution, it performs a search with maximum depth 1, then 2, 3, and so on. While aStarID formally receives the same inputs as aStar3, its input maxDepth has a different meaning in aStarID, so let's call that input maxDepthID.aStarID keeps calling aStar3 with maxDepth = 0, then maxDepth = 1, 2, 3, ... and so on, until maxDepth == maxDepthID. In other words, maxDepthID determines the maximum depth that we want to check when doing the iterative deepening process. If no solution is found once we've done that, aStarID should return the empty list.
This is the sample solutions provided by instructor, but please just see the idea and solve it in your own way.
sample answer for a : 
sample answer for b 
astar2 :: Eq a-> a-> a-> (a->a->Int) -> (a->[a]) -> [a] astar2 start goal h' genStates expand [ (h' start goal, [start])] where expand [] [] expand ((score, path) :nodes) I head pathgoal-reverse path | otherwise where newNodes [(length path + h' state goal, state : path) expand $ sortBy (compare on fst) (nodes ++ newNodes) state - genStates head path, state notElem path] astar2 :: Eq a-> a-> a-> (a->a->Int) -> (a->[a]) -> [a] astar2 start goal h' genStates expand [ (h' start goal, [start])] where expand [] [] expand ((score, path) :nodes) I head pathgoal-reverse path | otherwise where newNodes [(length path + h' state goal, state : path) expand $ sortBy (compare on fst) (nodes ++ newNodes) state - genStates head path, state notElem path]
Step by Step Solution
There are 3 Steps involved in it
Get step-by-step solutions from verified subject matter experts
