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

{- Syntax
    Implementieren Sie den AST (abstract syntax tree) entsprechend den Vorgaben
    auf dem Übungsblatt.
-}
data Regex
    = Empty
    | Epsilon
    | Symbol Char
    | Sequence Regex Regex
    | Star Regex
    | Choice Regex Regex
    -- | 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]
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",""]
--

{- 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
    | 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
--

{- 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
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
--

{-
    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
    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
{-
    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"
-- >>> match r1 "abbbbaccca"
-- True
--

shouldBeFalse1 :: Bool
shouldBeFalse1 = match r1 "abbcc"
-- >>> match r1 "abbcc"
-- False
--


shouldBeTrue2 :: Bool
shouldBeTrue2 = match r2 "abbbbacccabxxxx"
-- >>> match r2 "abbbbacccabxxxx"
-- True
--

shouldBeFalse2 :: Bool
shouldBeFalse2 = match r2 "abbxxxacc"
-- >>> match r2 "abbxxxacc"
-- False
--

shouldBeTrue3 :: Bool
shouldBeTrue3 = match r3 "ab"
-- >>> match r3 "ab"
-- True
--

shouldBeFalse3 :: Bool
shouldBeFalse3 = match r3 "aba"
-- >>> match r3 "aba"
-- False
--

shouldBeTrue4 :: Bool
shouldBeTrue4 = match r4 "abbbab"
-- >>> match r4 "abbbab"
-- True
--

shouldBeFalse4 :: Bool
shouldBeFalse4 = match r4 "abbabc"
-- >>> match r4 "abbabc"
-- False
--