RegExp.hs

-----------------------------------------------------------------------
--
-- 	Haskell: The Craft of Functional Programming, 3e
-- 	Simon Thompson
-- 	(c) Addison-Wesley, 1996-2011.
-- 
-- 	Chapter 12, Section 3: Recognizing Regular Expressions
--
------------------------------------------------------------------------

module RegExp where

import Data.List (foldl1)
import Data.Char (ord)

type RegExp = String -> Bool

epsilon :: RegExp
epsilon = (=="")

char :: Char -> RegExp
char ch = (==[ch])

(|||) :: RegExp -> RegExp ->  RegExp
e1 ||| e2 = 
    \x -> e1 x || e2 x

(<*>) :: RegExp -> RegExp ->  RegExp
e1 <*> e2 =
    \x -> or [ e1 y && e2 z | (y,z) <- splits x ]

splits :: String -> [(String,String)]
splits xs = [splitAt n xs | n<-[0..len]]
    where
      len = length xs

(<**>) :: RegExp -> RegExp ->  RegExp
e1 <**> e2 =
    \x -> or [ e1 y && e2 z | (y,z) <- fsplits x ]

star :: RegExp -> RegExp
star p = epsilon ||| (p <**> star p)
--           epsilon ||| (p <*> star p)
-- is OK as long as p can't have epsilon match

fsplits :: String -> [(String,String)]
fsplits xs = tail (splits xs)

-- define a few char patterns for use in exercises
a,b :: RegExp
a = char 'a'
b = char 'b'
--- End of base program for assignment

-----------------------------------------------------------------------
--
-- Author: Clay McLeod
-- Assignment: 3
-- Class: CSCI 503
-- Date: Oct. 9, 2014
--
------------------------------------------------------------------------

------------------------------------------------------------------------
-- 12.14
--
-- This regular expression will match any combination of the set (ab)*
-- eg. (sigma, ab, ba, abab, abba, baab, baba, ...)
-- 
-- Testing:
--
-- Does match.
-- *RegExp> star ((a ||| b) <*> (a ||| b)) ""
-- True
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "ab"
-- True
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "ba"
-- True
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "abab"
-- True
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "abba"
-- True
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "abbaababababab"
-- True
--
--
-- Does not match.
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "a"
-- False
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "b"
-- False
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "baa"
-- False
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "bab"
-- False
-- *RegExp> star ((a ||| b) <*> (a ||| b)) "claymcleod"
-- False
------------------------------------------------------------------------

------------------------------------------------------------------------
-- 12.15
--
-- This regular expression will match any combination of the set ((ab)*)*
-- This is essentially the same output as 12.14
-- eg. (sigma, ab, ba, abab, abba, baab, baba, ...)
-- 
-- Testing:
--
-- Does match.
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) ""
-- True
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "ab"
-- True
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "ba"
-- True
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "abab"
-- True
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "abba"
-- True
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "abbababababa"
-- True
--
--
-- Does not match.
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "a"
-- False
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "b"
-- False
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "baa"
-- False
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "bab"
-- False
-- *RegExp> star(star ((a ||| b) <*> (a ||| b))) "claymcleod"
-- False
------------------------------------------------------------------------

------------------------------------------------------------------------
-- 12.16
--
-- option testing
-- *RegExp> option a ""
-- True
-- *RegExp> option a "a"
-- True
-- *RegExp> option a "aa"
-- False
-- *RegExp> option a "aaa"
-- False
-- *RegExp> option a "aaaa"
-- False
--
--
-- plus testing
--
-- *RegExp> plus a ""
-- False
-- *RegExp> plus a "a"
-- False
-- *RegExp> plus a "aa"
-- True
-- *RegExp> plus a "aaa"
-- True
-- *RegExp> plus a "aaaa"
-- True
------------------------------------------------------------------------

option :: RegExp ->  RegExp
option e = epsilon ||| e

plus :: RegExp ->  RegExp
plus e = (e) <*> (e <*> star(e))

------------------------------------------------------------------------
-- 12.18 
--
-- (a) String of digits that begin with non-zero digit
--
-- Answer: (range ['1'..'9'] <*> star(range ['0'..'9']))
--
-- Testing:
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9'])) ""
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9'])) "0"
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9'])) "01231241"
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9'])) "11231241"
-- True
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9'])) "1"
-- True
--
--
-- (b) Fraction Numbers: two string of digits separated by '.';
--
-- Answer: (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9'])
--
-- Testing:
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9']) ""
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9']) "14"
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9']) "14.4"
-- True
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9']) "014.4"
-- False
-- *RegExp> (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9']) "14.40"
-- False
------------------------------------------------------------------------

range :: [Char] -> RegExp
range (x:xs) 
             | xs == []  = e 
             | otherwise = e ||| range xs
             where e :: RegExp
                   e = char x
range _ = error "Incorrect syntax"

dot :: RegExp
dot = char '.'

-- Just to be sure, here they are in function form

firstprob :: RegExp 
firstprob = (range ['1'..'9'] <*> star(range ['0'..'9']))

secondprob :: RegExp 
secondprob = (range ['1'..'9'] <*> star(range ['0'..'9']) <*> dot <*> star(range ['0'..'9']) <*> range ['1'..'9'])

------------------------------------------------------------------------
-- 12.18
--
--
--
-- Part (a) 
--
-- Answer: (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b))
--
-- Testing:
--
-- *RegExp> (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b)) "b"
-- True
-- *RegExp> (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b)) "ab"
-- True
-- *RegExp> (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b)) "aab"
-- True
-- *RegExp> (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b)) "abab"
-- True
-- *RegExp> (star(b) <*> (a ||| star(b)) <*> star(b) <*> (a ||| star(b)) <*>  star(b)) "aaab"
-- False
--
--
--
-- Part (b) 
--
-- Answer: (star(b) <*> (a) <*> star(b) <*> (a) <*>  star(b))
--
-- Testing:
--
-- *RegExp> (star(b) <*> (a) <*> star(b) <*> (a) <*>  star(b)) "aaab"
-- False
-- *RegExp> (star(b) <*> (a) <*> star(b) <*> (a) <*>  star(b)) "ab"
-- False
-- *RegExp> (star(b) <*> (a) <*> star(b) <*> (a) <*>  star(b)) "aba"
-- True
-- *RegExp> (star(b) <*> (a) <*> star(b) <*> (a) <*>  star(b)) "aa"
-- True
--
--
--
-- Part (c) 
--
-- Answer: (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b))
--
-- I can't tell if he wants me to accept epsilon as a valid expression or not. If he does NOT,
-- then the answer is really this:
-- 
-- Answer: (((a ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b))
--
-- Testing (with the first answer):
--
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) "aba"
-- True
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) "ab"
-- True
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) "abc"
-- False
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) "a"
-- True
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) ""
-- True
-- *RegExp> (((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b) <*> ((epsilon ||| a) ||| b)) "aaaa"
-- False
--
--
--
-- Part (d) 
--
-- Answer: ((option b) <*> star(a <*> b) <*> (option a))
--
-- Testing: 
--
-- *RegExp> ((option b) <*> star(a <*> b) <*> (option a)) "a"
-- True
-- *RegExp> ((option b) <*> star(a <*> b) <*> (option a)) "b"
-- True
-- *RegExp> ((option b) <*> star(a <*> b) <*> (option a)) "ab"
-- True
-- *RegExp> ((option b) <*> star(a <*> b) <*> (option a)) "bb"
-- False
-- *RegExp> ((option b) <*> star(a <*> b) <*> (option a)) "aa"
--False

------------------------------------------------------------------------