codice:
import Data.Maybe
-- State definition
data State = State {state :: (Int, Int), route :: [(Int, Int)]} deriving (Show)
instance Eq State where
State s1 r1 == State s2 r2 = s1 == s2
-- Initial state and final state
s0 :: [State]
solution :: State
s0 = [ (State (0,0) []) ]
solution = State (2,0) []
-- Applies a rule to a state
applyTo :: State -> ( State -> Maybe State ) -> Maybe State
applyTo state rule = rule state
-- BFS Search
u :: [(Int, Int)]
u = [ (x,y) | x <- [1..4], y <- [1..3] ]
search :: (Int, Int) -> [(State -> Maybe State)] -> (Int, Int) -> Maybe State
search (x0,y0) rules (x',y') =
bfs [(State (x0,y0) [])] [] rules (State (x',y') [])
bfs :: [State] -> [State] -> [(State -> Maybe State)] -> State -> Maybe State
bfs [] _ _ _ = Nothing
bfs (sc:ss) visited rules sln
| sc == sln = Just sc
| otherwise = bfs searchSpace visitedSpace rules sln where
visitedSpace = sc : (listrm1 visited sc)
searchSpace = listrm (ss ++ newStates) visitedSpace where
newStates = catMaybes (map (applyTo sc) rules)
-- listrm
listrm :: (Eq a) => [a] -> [a] -> [a]
listrm [] _ = []
listrm ls [] = ls
listrm ls (y:ys) = listrm1 (listrm ls ys) y
listrm1 :: (Eq a) => [a] -> a -> [a]
listrm1 [] _ = []
listrm1 (x:xs) y
| x == y = g
| otherwise = x : g where
g = listrm1 xs y
----- Rules -----
rules :: [ State -> Maybe State ]
rules = [rule1, rule2, rule3, rule4, rule5, rule6, rule7, rule8, rule9, rule10]
rule1 :: State -> Maybe State
rule1 (State (x, y) parents)
| x < 4 = Just (State (4, y) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule2 (State (x, y) parents)
| y < 3 = Just (State (x, 3) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule3 (State (x, y) parents)
| x > 0 = Just (State (0, y) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule4 (State (x, y) parents)
| y > 0 = Just (State (x, 0) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule5 (State (x, y) parents)
| ((x + y) >= 4 && (y > 0)) = Just (State (4, y-(4-x)) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule6 (State (x, y) parents)
| ((x + y) >= 3 && (x > 0)) = Just (State (x-(3-y), 3) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule7 (State (x, y) parents)
| ((x + y) <= 4 && (y > 0)) = Just (State (x + y, 0) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule8 (State (x, y) parents)
| ((x + y) <= 3 && (x > 0)) = Just (State (0, x + y) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule9 (State (x, y) parents)
| (x,y) == (0,2) = Just (State (2, 0) (parents ++ [(x,y)]) )
| otherwise = Nothing
rule10 (State (x, y) parents)
| (x,y) == (2,y) = Just (State (0, y) (parents ++ [(x,y)]) )
| otherwise = Nothing