changeset 27:a316877ed3d9

week 11
author Markus Kaiser <markus.kaiser@in.tum.de>
date Wed, 09 Jan 2013 21:00:13 +0100
parents ce9610f08925
children e0ae5d8b55d3
files blatt11.pdf exercises/src/Exercise_11.hs exercises/src/Form.hs exercises/src/FormParser1.hs exercises/src/FormParser2.hs exercises/src/Html.hs exercises/src/Parser.hs exercises/src/RegEx.hs
diffstat 8 files changed, 272 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
Binary file blatt11.pdf has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/Exercise_11.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,88 @@
+module Exercise_11 where
+import Data.List
+import Parser
+import RegEx
+import Test.QuickCheck
+
+{- Library DO NOT CHANGE -}
+data Html = Text String | Block String [Html]
+    deriving (Eq, Show)
+data HtmlT = OpenT String | CloseT String | WordT String
+    deriving (Eq, Show)
+
+htmlP_ex1 = [WordT "hello", WordT "world"]
+htmlP_ex2 = [OpenT "sv", WordT "hej", WordT "vaerld", CloseT "sv"]
+htmlP_ex3 = [OpenT "a", CloseT "a", WordT "b"]
+htmlP_ex4 = [OpenT "a", WordT "foo", WordT "bar"]
+htmlP_ex5 = [OpenT "a", OpenT "b", WordT "c", CloseT "b", WordT "d", CloseT "a"]
+
+vocabs = ["i", "kyoto", "more", "now", "tokyo", "want", "won"]
+text1 = ["i", "want", "mroe"]
+text2 = ["and", "i", "tnaw", "it", "now"]
+text3 =["tokyo", "toyko", "kyoto"]
+{- End Library -}
+
+{---------------------------------------------------------------------}
+{- Aufgabe G11.1 -}
+
+safeUnscrambleWord :: [String] -> String -> Either (String, [String]) String
+safeUnscrambleWord vocabs word
+        | word `elem` vocabs = Right word
+        | otherwise = Left (word,
+                filter (\v -> sort v == sorted) vocabs)
+        where sorted = sort word
+
+
+safeUnscrambleWords :: [String] -> [String] -> [Either (String, [String]) String]
+safeUnscrambleWords vocabs words = map (safeUnscrambleWord vocabs) words
+
+
+
+{---------------------------------------------------------------------}
+{- Aufgabe G11.2, G11.3 -}
+
+-- siehe FormParser3.hs
+
+
+
+{---------------------------------------------------------------------}
+{- Aufgabe H11.1 -}
+
+nat :: Parser Char Int
+nat = undefined
+
+
+int :: Parser Char Int
+int = undefined
+
+
+double :: Parser Char Double
+double = undefined
+
+
+
+{---------------------------------------------------------------------}
+{- Aufgabe H11.2 -}
+
+htmlS :: Parser Char [HtmlT]
+htmlS = undefined
+
+
+infixr 5 ***=
+
+(***=) :: Parser a b -> (b -> Parser a c) -> Parser a (b,c)
+_ ***= _ = undefined
+
+
+htmlP :: Parser HtmlT Html
+htmlP = undefined
+
+
+
+{---------------------------------------------------------------------}
+{- Aufgabe H11.3 -}
+
+{-WETT-}
+regEx :: Parser Char RegEx
+regEx = undefined
+{-TTEW-}
--- a/exercises/src/Form.hs	Wed Jan 09 19:45:47 2013 +0100
+++ b/exercises/src/Form.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -15,7 +15,6 @@
   show (Not p) = par("~" ++ show p)
   show (p :&: q) = par(show p ++ " & " ++ show q)
   show (p :|: q) = par(show p ++ " | " ++ show q)
-  {- TODO -}
 
 par :: String -> String
 par s = "(" ++ s ++ ")"
@@ -30,7 +29,6 @@
 eval e (Not p) = not(eval e p)
 eval e (p :&: q) = eval e p && eval e q
 eval e (p :|: q) = eval e p || eval e q
-{- TODO -}
 
 vars :: Form -> [Name]
 vars F = []
@@ -39,10 +37,9 @@
 vars (Not p) = vars p
 vars (p :&: q) = nub (vars p ++ vars q)
 vars (p :|: q) = nub (vars p ++ vars q)
-{- TODO -}
 
 vals :: [Name] -> [Valuation]
-vals []	= [[]]
+vals [] = [[]]
 vals (x:xs) = [ (x,False):e | e <- vals xs ] ++ [ (x,True ):e | e <- vals xs ]
 
 satisfiable :: Form -> Bool
@@ -78,7 +75,6 @@
 isSimple (p :&: q)  =  isSimple p && isSimple q
 isSimple (p :|: q)  =  isSimple p && isSimple q
 isSimple p          =  True
-{- TODO -}
 
 simplify :: Form -> Form
 simplify (Not p)    =  pushNot (simplify p)
@@ -90,7 +86,6 @@
 simplify (p :&: q)  =  simplify p :&: simplify q
 simplify (p :|: q)  =  simplify p :|: simplify q
 simplify p          =  p
-{- TODO -}
 
 -- allow QuickCheck to generate arbitrary values of type Form
 instance Arbitrary Form where
@@ -108,7 +103,5 @@
              liftM Not (prop (n-1)),
              liftM2 (:&:) (prop(n `div` 2)) (prop(n `div` 2)),
              liftM2 (:|:) (prop(n `div` 2)) (prop(n `div` 2))]
-{- TODO -}
 
 prop_simplify p = isSimple(simplify p)
-{- TODO -}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/FormParser1.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,25 @@
+{- A simpleminded parser for a subset of formulas not containing | (or)
+   Does not allow spaces in formulas.
+-}
+
+module FormParser1 (form) where
+
+import Form
+import Parser
+
+form :: Parser Char Form
+form  =
+  form1 *** optional (item '&' *** form >>> snd) >>> andF
+  where andF(f1, Just f2) = f1 :&: f2
+        andF(f1, Nothing) = f1
+
+-- form1 does not allow &
+form1 :: Parser Char Form
+form1  =
+  item '~' *** form1 >>> (Not . snd) |||
+  item 'T' >>> const T |||
+  item 'F' >>> const F |||
+  identifier >>> Var |||
+  enclose '(' ')' form
+
+test = form "(x1&~T)&~a&~((F&d2)&~d2&d1)"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/FormParser2.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,60 @@
+{- A parser for a subset of formulas not containing | (or)
+   It is composed of two phases:
+   1. The scanner or tokenizer parses a string into a list of tokens.
+   2. The actual parser parses a token list into a formula.
+   Both phases are defined by parser combinators.
+-}
+
+module FormParser2 (formSP) where
+
+import Data.Char
+import Form
+import Parser
+
+-- The tokens of the syntax for formulas
+data Token = AndT | NotT | LPT | RPT | TT | FT | IdT String
+             deriving (Eq,Show)
+
+-- The 'scanner' or 'tokenizer'
+formS :: Parser Char [Token]
+formS = list (spaces *** formS' >>> snd) *** spaces >>> fst
+  where
+  spaces = list (item ' ')
+  formS' =
+    item '&' >>> const AndT |||
+    item '~' >>> const NotT |||
+    item '(' >>> const LPT |||
+    item ')' >>> const RPT |||
+    item 'T' >>> const TT |||
+    item 'F' >>> const FT |||
+    identifier >>> IdT
+
+-- The actual parsers
+
+formP :: Parser Token Form
+formP  =
+  form1P *** optional (item AndT *** formP >>> snd) >>> andF
+  where andF(f1, Just f2) = f1 :&: f2
+        andF(f1, Nothing) = f1
+
+-- form1P does not allow &
+form1P :: Parser Token Form
+form1P  =
+  item NotT *** form1P >>> (Not . snd) |||
+  item TT >>> const T |||
+  item FT >>> const F |||
+  one isIdT >>> var |||
+  enclose LPT RPT formP
+    where
+    var(IdT s) = Var s
+
+    isIdT(IdT _) = True
+    isIdT _ = False
+
+-- Composing scanner and parser
+formSP :: String -> Maybe (Form, [Token])
+formSP s = case formS s of
+             Just(ss,[]) -> formP ss
+             _ -> Nothing
+
+test = formSP " (x1 & ~ T)& ~a &~ ( (  F  & d2)&~d2&d1 ) "
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/Html.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,3 @@
+module Html
+
+import Parser
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/Parser.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,86 @@
+module Parser where
+
+import Data.Char
+
+infixr 5 ***
+infixr 4 >>>
+infixr 3 |||
+
+--
+-- The type of parsers.
+--
+type Parser a b = [a] -> Maybe(b,[a])
+
+success b xs = Just(b,xs)
+
+one :: (a -> Bool) -> Parser a a
+one pred (a:as) = if pred a then Just(a,as) else Nothing
+one _ [] = Nothing
+
+item :: Eq a => a -> Parser a a
+item a = one (== a)
+
+--
+-- Combining parsers
+--
+
+--
+-- p1 ||| p2 recognises anything recognised by p1 orelse by p2
+--
+(|||) :: Parser a b -> Parser a b -> Parser a b
+p1 ||| p2 = \as -> case p1 as of
+                     Nothing -> p2 as
+                     just -> just
+
+--
+-- Apply one parser then the second to the result(s) of the first.
+--
+
+(***) :: Parser a b -> Parser a c -> Parser a (b,c)
+p1 *** p2 = \xs ->
+  case p1 xs of
+    Nothing -> Nothing
+    Just(b,ys) -> case p2 ys of
+                    Nothing -> Nothing
+                    Just(c,zs) -> Just((b,c),zs)
+
+{- For friends of Monad, here are more compact versions of ***:
+p1 *** p2 = \xs -> p1 xs >>= \(b,ys) -> p2 ys >>= \(c,zs) -> Just((b,c),zs)
+p1 *** p2 = \xs ->
+  do (b,ys) <- p1 xs
+     (c,zs) <- p2 ys
+     return ((b,c),zs)
+-}
+
+--
+-- Transform the result of the parser by the function.
+--
+(>>>) :: Parser a b -> (b -> c) -> Parser a c
+p >>> f  =  \xs ->
+  case p xs of
+    Nothing -> Nothing
+    Just(b, ys) -> Just(f b, ys)
+
+--
+-- Recognise a list of objects.
+--
+--
+list :: Parser a b -> Parser a [b]
+list p  =  p *** list p >>> uncurry (:)  |||  success []
+
+-- A non-empty list of objects.
+--
+list1   :: Parser a b -> Parser a [b]
+list1 p = p *** list p >>> uncurry (:)
+
+-- Zero or one object.
+optional :: Parser a b -> Parser a (Maybe b)
+optional p  =  p >>> Just  |||  success Nothing
+
+-- Alphanumeric identifiers
+identifier :: Parser Char String
+identifier = list1(one isAlpha) *** list(one isDigit) >>> uncurry (++)
+
+-- Enclose in items
+enclose :: Eq a => a -> a -> Parser a b -> Parser a b
+enclose l r p  =  item l *** p *** item r >>> \ (_,(b,_)) -> b
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/exercises/src/RegEx.hs	Wed Jan 09 21:00:13 2013 +0100
@@ -0,0 +1,9 @@
+module RegEx where
+
+data RegEx =
+    Any |
+    One [(Char, Char)] |
+    Repeat RegEx (Int, Maybe Int) |
+    Concat RegEx RegEx |
+    Alt RegEx RegEx
+  deriving (Eq, Show)