===== Lab 12: Monads in action =====
This lab will illustrate a complete Haskell program searching for the shortest path in a maze. We will see ''Maybe'' and ''IO'' monads in action.
It will be split into two parts. The first part deals with the breadth-first search and the second with parsing the file containing a maze.
Short fragments of code are left for you to fill.
Before you start, make sure that you have the following imports in your source file:
import Data.Char
import Control.Applicative
We are going to need these libraries for our parser.
==== Data structures ====
As building blocks for a maze, we introduce the following data type:
data Block = W | F | S deriving (Eq,Show)
The values ''W'', ''F'', ''S'' represent respectively a wall, a free space, and a star that we will use to depict solutions.
A data type capturing mazes can be defined as follows:
data Maze = M [[Block]]
maze :: Maze -- a testing maze
maze = M [[W,W,W,W,W],
[W,F,W,F,W],
[W,F,W,W,W],
[W,F,F,F,W],
[W,W,W,W,W]]
To display a maze we make ''Maze'' into an instance of ''Show''.
instance Show Maze where
show (M []) = ""
show (M (r:rs)) = map dispBlock r ++ "\n" ++ show (M rs)
where dispBlock W = '#'
dispBlock F = ' '
dispBlock S = '*'
Finally, we represent a position in a maze by a tuple of integers. A path can be represented as a list of positions and a planning task
is a triple consisting of start and goal positions and a maze.
type Pos = (Int, Int)
type Path = [Pos]
type Task = (Pos,Pos,Maze)
==== Manipulations with maze ====
We will need to extract a block on a given position and conversely set a block on a given position. To see ''Maybe'' monad in action,
we implement these functions to be safe. E.g., if we provide a position outside the maze, it will return ''Nothing''. We will start by implementing
such safe functions for lists.
Suppose we have an index ''n'', an element ''x :: a'' and a list ''xs :: [a]''. We want to implement a function that replaces the element of index
''n'' in ''xs'' by ''x'' provided that ''n'' is within the range of indexes of ''xs''. If ''n'' is outside this range, it returns ''Nothing''.
safePut :: Int -> a -> [a] -> Maybe [a]
...
++++ Code|
safePut :: Int -> a -> [a] -> Maybe [a]
safePut n x xs | 0 <= n && n < length xs = Just $ take n xs ++ [x] ++ drop (n+1) xs
| otherwise = Nothing
++++
Similarly, try to implement the function ''safeGet'' that extract the element of index ''n'' provided it exists:
safeGet :: Int -> [a] -> Maybe a
...
++++ Code|
safeGet :: Int -> [a] -> Maybe a
safeGet n xs | n `elem` [0..length xs-1] = Just $ xs !! n
| otherwise = Nothing
++++
Now we can use the above functions to implement functions extracting and setting a block in a maze.
To extract a block, we first safely extract a row of a maze. If it is successful, we can extract the block from the row.
Using the fact that ''Maybe'' is a monad, we don't have to test every time if the computation was successful.
++++ Code|
getBlock :: Pos -> Maze -> Maybe Block
getBlock (x,y) (M xss) = do row <- safeGet y xss
block <- safeGet x row
return block
++++
Examples:
> getBlock (1,0) maze
Just W
> getBlock (10,10) maze
Nothing
Using ''safeGet'' and ''safePut'', try to implement a function that takes
a block ''b'', a maze ''m'', a position ''(x,y)'' and returns a new maze created by replacing
the block on ''(x,y)'' by ''b''.
setBlock :: Block -> Pos -> Maze -> Maybe Maze
...
++++ Code|
setBlock :: Block -> Pos -> Maze -> Maybe Maze
setBlock b (x,y) (M xss) = do row <- safeGet y xss
row' <- safePut x b row
xss' <- safePut y row' xss
return (M xss')
++++
Example:
> setBlock S (1,2) maze
Just #####
# # #
#*###
# #
#####
Finally, if we have a path (i.e., a list of positions), we can set recursively all its positions in a maze. Again using the fact that ''Maybe'' is a monad.
++++ Code|
setPath :: Maze -> Path -> Maybe Maze
setPath m [] = Just m
setPath m (p:ps) = do m' <- setBlock S p m
m'' <- setPath m' ps
return m''
++++
You might note that this is, in fact, a kind of monadic ''foldr''. There is, of course, a generic monadic ''foldr'' called ''foldrM''.
If you import ''Data.Foldable'', then you can rewrite the above function as follows:
setPath = foldrM (setBlock S)
As ''setPath'' returns a value of type ''Maybe Maze'', we can extract it from the ''Maybe'' context by pattern matching.
++++ Code|
drawSol :: Maze -> Path -> Maze
drawSol m ps = case setPath m ps of
Nothing -> m
Just m' -> m'
++++
==== Breadth-first search (BFS) ====
To find a path leading from a start position into the goal position, we need a function taking a position and returning all possible successive positions.
Assume that there are at most eight possible moves. All possibilities are generated by the function ''neighbs''. We have to filter only those leading to a free block out of these possibilities. Moreover, it is necessary to check that the input position is permissible as well.
neighbs :: Pos -> [Pos]
neighbs (x,y) = [(x-1,y), (x+1,y), (x,y-1), (x,y+1),
(x-1,y-1), (x-1,y+1), (x+1,y-1), (x+1,y+1)]
nextPos :: Pos -> Maze -> [Pos]
nextPos p m = case getBlock p m of -- is the input position admissible?
Just F -> [ p' | p' <- neighbs p, getBlock p' m == Just F] -- if yes, take all possibilities and filter admissible positions
_ -> []
> nextPos (1,1) maze
[(1,2)]
Using ''nextPos'', implement the following function taking a path, a maze and returning all its possible extensions. For efficiency reasons
we will represent paths in BFS in the reversed order. Thus extend a given path using the operator ''(:)''.
++++ Code|
extend :: Path -> Maze -> [Path]
extend [] _ = []
extend path@(p:_) m = map (:path) $ nextPos p m
> extend [(1,2),(1,1)] maze
[[(1,1),(1,2),(1,1)],[(1,3),(1,2),(1,1)],[(2,3),(1,2),(1,1)]]
++++
Now we can quickly implement BFS. Recall that in BFS, we use a queue storing partial solutions. We will implement this queue naively as a list.
In addition, we have to keep information about already visited positions. We define the function ''solve'' as just a wrapper for
the ''bfs'' function implementing BFS. The function ''bfs'' takes several arguments. The first is a list of already visited positions.
The second is the queue of partial solutions. The third is the goal position and the last one is the maze.
solve :: Task -> Maybe Path
solve (p,q,m) = bfs [] [[p]] q m
bfs :: [Pos] -> [Path] -> Pos -> Maze -> Maybe Path
bfs _ [] _ _ = Nothing
bfs visited (path@(p:_):paths) q m -- consider the first path in the queue and its head p
| p == q = Just $ reverse path -- is path a solution? If yes, return the reversed solution
| p `elem` visited = bfs visited paths q m -- does path end in an already visited position? If yes, disregard it
| otherwise = bfs (p:visited) (paths ++ extend path m) q m -- add p to visited positions and extend path by all possible positions
> solve ((1,2),(3,3),maze)
Just [(1,2),(2,3),(3,3)]
> solve ((3,1),(3,3),maze)
Nothing
==== Type constructor Parser ====
As a next task, we must create a user interface for the BFS solver. We have to allow the user to specify a maze together with a start and goal
positions. The user provides a string containing all the necessary data via the standard input. It might look as follows:
start = (1,1)
goal = (28,4)
#########################################
# # # #
# # # #
########### ####### ########### #
# # # # #
# ##################### #
#### # # # #
# ########## ################ #
# #
# # # #
#########################################
Our program is supposed to parse this input and display its solution provided it exists:
#########################################
#********* # # #
# * # # #
###########* ####### ########### #
# * # # **** # #
# * #####################* #
#### * # # # ***** #
# *########## ################* #
# ****************************** #
# # # #
#########################################
We will use the type constructor ''Parser'' that I explained in the lecture. Below you can find its definition and definitions of all its instances
for ''Functor'', ''Applicative'', ''Monad'' and ''Alternative''. So you can directly copy them into your source file.
Let me recall the info on ''Parser'' shortly. A parser over type ''a'' is a function taking an input string, consuming a part of it, and returning
the parsed value of type ''a'' and the remaining unused input string. The parsing can fail. That's why it returns a value of type
''Maybe (a, String)''. For instance, if you want to parse an integer and the input string starts with a letter, the parsing fails.
The accessor function ''parse'' just helps us to remove the data constructor ''P''. So if you want to apply a parser ''p'' to an input ''inp'', call
''parse p inp''.
As we want to make ''Parser'' an instance of ''Monad'' so that we can sequence parsers, we have to define also instances for super-classes
''Applicative'' and ''Functor''. Functor instances over data type ''a'' implements a function ''fmap'' allowing to lift
a map ''f :: a -> b'' to a map of type ''Parser a -> Parser b''. The function ''fmap'' always
keeps the functor structure untouched only changes values of type parameter ''a''. So for ''Parser a'' it just keeps the parsing
function the same expect of modifying the output value ''v :: a'' by ''f v''.
Functors allow lifting unary maps to the functorial context. E.g. we can lift ''(+1)'' to ''Parser Int'' but we cannot lift binary ''(+)''.
If we lift ''(+) :: Int -> Int -> Int'' to ''Parser Int'' by ''fmap'', we obtain a function
''Parser Int -> Parser (Int -> Int)''. However, to lift ''(+)'', we need type
''Parser Int -> Parser Int -> Parser Int''. Applicative functors implement ''<*>'' that can transform
''Parser (Int -> Int)'' to ''Parser Int -> Parser Int''.
The function ''pure'' just wraps a value into the ''Parser'' context. It is, in fact, a synonym for the monadic ''return''.
The monad instance for ''Parser'' has to define the bind operator ''>>=''. Its implementation first parses a value ''v :: a''.
If the parsing fails, then the whole parsing fails. Otherwise, we apply ''f v'' obtaining the next parser applied to the unused
input ''out''.
Finally, we define the instance of ''Alternative''. It consists of ''empty'' and ''<|>''. The first is the always failing parser.
The second operator allows trying two parsers for the same input, and the first successful returns its result.
newtype Parser a = P { parse :: String -> Maybe (a, String) }
instance Functor Parser where
-- fmap :: (a -> b) -> Parser a -> Parser b
fmap f p = P (\inp -> case parse p inp of
Nothing -> Nothing
Just (v,out) -> Just (f v, out))
instance Applicative Parser where
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
pg <*> px = P (\inp -> case parse pg inp of
Nothing -> Nothing
Just (g,out) -> parse (fmap g px) out)
pure v = P (\inp -> Just (v,inp))
instance Monad Parser where
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
p >>= f = P (\inp -> case parse p inp of
Nothing -> Nothing
Just (v,out) -> parse (f v) out)
instance Alternative Parser where
-- empty :: Parser a
empty = P (\_ -> Nothing)
-- (<|>) :: Parser a -> Parser a -> Parser a
p <|> q = P (\inp -> case parse p inp of
Nothing -> parse q inp
Just (v,out) -> Just (v,out))
==== Parsing ====
Now we are ready to implement the parser for our BFS application. We start with simple parsers, out of which we compose the final one.
The structure of the input '''' is specified by the following grammar. The first line contains a definition of the start position
and the second one defines the goal position. The start definition starts with ''"start"'' followed possibly by spaces,
then ''"="'', again possibly followed by spaces, and then a position followed by the new-line character ''"\n"''.
The goal definition is analogous. The position is just a tuple of numbers in parentheses separated by a comma and possibly by spaces.
The maze ''