Discussion Session 10: Search¶
Haskell Syntax¶
Complicated Haskell programs can be built upon the following syntax.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | -- Elementary expression
a = 1
b = "abc"
c = (show a) ++ b
-- "let" expression
x = let
x = 1 -- binding
y = 2 -- binding
sum :: Int -> Int -> Int -- function declaration
sum a b = a + b -- function definition
in
sum x y
-- "if" expression
y = if x > 0 then 'a'
else
if x == 0 then 'b'
else 'c'
data IList =
Cons Int IList
| Nil
xs = Cons 1 (Cons 2 Nil)
-- "case" expression
z = case xs of
Cons _ _ -> 1 -- all clauses must be of the same indentation
Nil -> 2
-- "case" expression
z' = case y of
'a' -> "a"
'b' -> "b"
fz 'a' = "a"
fz 'b' = "b"
z'' = fz y
-- type of main is IO (), "IO" is a type constructor
main :: IO ()
main = do
let
a = 1 -- Indentation is important
b = let
c = 1
in
a + c
putStrLn (show z) -- The following two lines are of the same indentation.
putStrLn (show z)
|
Concept¶
- State
- Search Tree / Graph
- Strategy
- Solution / Best Solution
Code Example¶
8-Queen problem¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | module EightQueen where
data Cell = E | Q deriving (Show)
type Position = (Integer, Integer)
data Board = Board [Position]
data Graph =
Branch Board [Graph]
| Finish Board
instance Show Board where
show (Board xs) = let
show_line_loop cur pos len accu =
if cur >= len then accu
else if cur == pos then show_line_loop (cur + 1) pos len (accu ++ "Q ")
else show_line_loop (cur + 1) pos len (accu ++ ". ")
show_loop ((_, pos) : tail) accu = let
new_line = show_line_loop 0 pos 8 ""
in
show_loop tail (accu ++ new_line ++ "\n")
show_loop [] accu = accu
in
show_loop xs ""
nextMoves :: Board -> [Board]
nextMoves (Board xs) = let
row = toInteger (length xs)
cols = [0 .. 7]
candidates = [(row, y) | y <- cols]
conflict :: Position -> Position -> Bool
conflict (x1,y1) (x2,y2) = if y1 == y2 then True
else if abs(x1 - x2) == abs(y1 - y2) then True
else False
conflict_list :: Position -> [Position] -> Bool
conflict_list x (head : tail) = (conflict x head) || (conflict_list x tail)
conflict_list x [] = False
new_moves = [c | c <- candidates, (conflict_list c xs) == False]
new_boards = [Board (xs ++ [pos]) | pos <- new_moves]
in
new_boards
graph :: Board -> Graph
graph (Board xs) = if (length xs) >= 8 then Finish (Board xs)
else let
new_boards = nextMoves (Board xs)
in
if length(new_boards) == 0 then Finish (Board xs)
else let
new_graphs = [graph b | b <- new_boards]
in
Branch (Board xs) new_graphs
is_sol :: Board -> Bool
is_sol (Board xs) = (length xs) == 8
find_sol :: Graph -> [Board]
find_sol (Branch b gs) = let
bss = [find_sol g | g <- gs]
bs = foldl (\x -> \y -> x ++ y) [] bss
in
if is_sol b then b : bs
else bs
find_sol (Finish b) =
if is_sol b then [b]
else []
search_space = graph (Board [])
sol = find_sol (search_space)
show_boards (b : bs) = (show b) ++ "\n\n\n" ++ (show_boards bs)
show_boards [] = "\n"
main :: IO ()
main = do putStrLn (show_boards sol)
putStrLn $ "Total solutions found: " ++ show (length sol)
|
Solution:
eightqueens.hs
Makefile
Regular Expression Match¶
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | module RegExp where
data Regexp =
REnil
| REemp
| REany
| REchar Char
| REalt Regexp Regexp
| REcat Regexp Regexp
| REstar Regexp
string_regexp_match str reg = let
str_isempty :: String -> Bool
str_isempty [] = True
str_isempty _ = False
in
accept str reg str_isempty
accept str reg k =
case reg of
REnil -> False
REemp -> k str
REany -> (case str of
_ : cs -> k cs
[] -> False
)
REchar c -> (case str of
c' : cs -> if c == c' then k cs else False
[] -> False
)
REalt reg1 reg2 -> if accept str reg1 k then True
else accept str reg2 k
REcat reg1 reg2 -> let
k' xs = accept xs reg2 k
in
accept str reg1 k'
REstar reg0 -> if k str then True
else let
k' xs = if (length xs) == (length str) then False
else accept xs reg k
in
accept str reg0 k'
main = do
let
reg_a = REchar 'a'
reg_b = REchar 'b'
reg_ab = REalt reg_a reg_b
reg_abs = REcat reg_ab (REstar reg_ab)
reg_as = REstar reg_a
reg_ass = REstar reg_as
putStrLn $ show $ string_regexp_match "abaaab" reg_abs
putStrLn (show (string_regexp_match "ac" reg_abs))
putStrLn (show (string_regexp_match "aa" reg_ass))
|
Misc¶
Some syntax sugar first.
The followings are equivalent:
putStrLn (show (1 + 1))
putStrLn $ show $ 1 + 1
putStrLn . show $ 1 + 1
The $
sign is used to avoid parenthesis. Whatever on the right of it takes precedence. .
sign is used to chain functions. The output of RHS will be the input of LHS.
And here is a very good place to lookup useful functions in the Prelude module of Haskell. http://hackage.haskell.org/package/base-4.6.0.1/docs/Prelude.html