zhaw-fup/Exercises/exercise-3/Regex.hs

183 lines
4.5 KiB
Haskell
Raw Permalink Normal View History

2024-06-15 19:27:05 +00:00
{- Syntax
Implementieren Sie den AST (abstract syntax tree) entsprechend den Vorgaben
auf dem Übungsblatt.
-}
data Regex
= Empty
| Epsilon
| Symbol Char
2024-06-15 20:59:46 +00:00
| Sequence Regex Regex
| Star Regex
| Choice Regex Regex
2024-06-15 19:27:05 +00:00
-- | Sequence, Star, Choice fehlen noch.
deriving Show
{- Semantik
Ziel ist es die Funktion 'match :: Regex -> String -> Bool' zu implementieren,
die überprüft ob ein gegebener String zu einer gegebenen Regex passt. Im
folgenden werden dafür zuerst drei Hilfsfunktionen implementiert, die Sie dann
für 'match' verwenden können.
-}
{- Helper function 1:
Given a predicate and a string this function returns all (proper) tails
of the string that are obtained by removing an initial segment that
satisfies the predicate.
Examples:
tails (\s -> length s == 1) "abcde" == ["bcde"]
tails (\s -> length s >= 1) "abcde" == ["bcde","cde","de","e",""]
-}
tails :: (String -> Bool) -> String -> [String]
2024-06-15 20:59:46 +00:00
tails f s = concatMap
(\x -> if f (take x s) then [(drop x s)] else [])
[0..(length s)]
-- >>> tails (\s -> length s >= 1) "abcde"
-- ["bcde","cde","de","e",""]
--
2024-06-15 19:27:05 +00:00
{- Helper function 2:
By repeatedly calling the tails function, this function checks if
it is possible to partition a given string into consecutive segments
each of which satisfies the predicate.
Examples:
segmentable (\s -> length s == 2) "abcde" == False
segmentable (\s -> length s == 2) "abcd" == True
-}
segmentable :: (String -> Bool) -> String -> Bool
segmentable f s
| s == "" = True
| "" `elem` leads = True
| leads == [] = False
2024-06-15 20:59:46 +00:00
| otherwise = or (map (\x -> segmentable f x) leads)
where
leads = tails f s
-- >>> segmentable (\s -> length s == 2) "abcde"
-- False
--
-- >>> segmentable (\s -> length s == 2) "abcd"
-- True
--
2024-06-15 19:27:05 +00:00
{- Helper function 3:
Given two predicates and a string, this function checks if it is
possible to partition the string into a prefix and a suffix such that
the prefix satisfies the first predicate and the suffix satisfies the
second predicate.
Examples:
combinable (\s -> length s == 2) (\s -> length s == 3) "12345" == True
combinable (\s -> length s == 2) (\s -> length s == 3) "1234" == False
combinable (\s -> length s == 2) (\s -> length s == 3) "123456" == False
-}
combinable :: (String -> Bool) -> (String -> Bool) -> String -> Bool
2024-06-15 20:59:46 +00:00
combinable f g s =
or (
map
(\x -> f (take x s) && g (drop x s))
(reverse [0..len])
)
where
len = length s
-- >>> combinable (\s -> length s == 2) (\s -> length s == 3) "12345"
-- >>> combinable (\s -> length s == 2) (\s -> length s == 3) "1234"
-- >>> combinable (\s -> length s == 2) (\s -> length s == 3) "123456"
-- True
-- False
-- False
--
2024-06-15 19:27:05 +00:00
{-
Matching a particular string to a regex a regex now simply means to check
to cover the base cases and use the helper functions.
-}
match :: Regex -> String -> Bool
match r s = case r of
2024-06-15 20:59:46 +00:00
Empty -> s == ""
Epsilon -> False
Symbol c -> s == [c]
Choice r1 r2 -> (match r1 s || match r2 s)
Sequence r1 r2 -> combinable (match r1) (match r2) s
Star r1 -> segmentable (match r1) s
2024-06-15 19:27:05 +00:00
{-
Examples/test-cases
-}
-- (ab*|ac*)*
r1 :: Regex
r1 = Star
( Choice
( Sequence
( Symbol 'a')
( Star (Symbol 'b'))
)
(Sequence
(Symbol 'a')
(Star (Symbol 'c'))
)
)
-- (ab*|ac*)*x*
r2 :: Regex
r2 = Sequence r1 (Star (Symbol 'x'))
-- ab
r3 :: Regex
r3 = Sequence (Symbol 'a') (Symbol 'b')
-- a(a|b)*
r4 :: Regex
r4 = Sequence (Symbol 'a') $ Star $ Choice (Symbol 'a') (Symbol 'b')
shouldBeTrue1 :: Bool
shouldBeTrue1 = match r1 "abbbbaccca"
2024-06-15 20:59:46 +00:00
-- >>> match r1 "abbbbaccca"
-- True
--
2024-06-15 19:27:05 +00:00
shouldBeFalse1 :: Bool
shouldBeFalse1 = match r1 "abbcc"
2024-06-15 20:59:46 +00:00
-- >>> match r1 "abbcc"
-- False
--
2024-06-15 19:27:05 +00:00
shouldBeTrue2 :: Bool
shouldBeTrue2 = match r2 "abbbbacccabxxxx"
2024-06-15 20:59:46 +00:00
-- >>> match r2 "abbbbacccabxxxx"
-- True
--
2024-06-15 19:27:05 +00:00
shouldBeFalse2 :: Bool
shouldBeFalse2 = match r2 "abbxxxacc"
2024-06-15 20:59:46 +00:00
-- >>> match r2 "abbxxxacc"
-- False
--
2024-06-15 19:27:05 +00:00
shouldBeTrue3 :: Bool
shouldBeTrue3 = match r3 "ab"
2024-06-15 20:59:46 +00:00
-- >>> match r3 "ab"
-- True
--
2024-06-15 19:27:05 +00:00
shouldBeFalse3 :: Bool
shouldBeFalse3 = match r3 "aba"
2024-06-15 20:59:46 +00:00
-- >>> match r3 "aba"
-- False
--
2024-06-15 19:27:05 +00:00
shouldBeTrue4 :: Bool
shouldBeTrue4 = match r4 "abbbab"
2024-06-15 20:59:46 +00:00
-- >>> match r4 "abbbab"
-- True
--
shouldBeFalse4 :: Bool
shouldBeFalse4 = match r4 "abbabc"
-- >>> match r4 "abbabc"
-- False
--