My investigations are much more basic. I’ve got a reduction algorithm working that uses the fact that the elements of lof are like a Dyck language, so strings of parentheses will work as a representation.
test1 = "(()())"
test2 = "((()))"
test3 = "()()"
fix f x = let x' = f x in if x == x' then x else fix f x'
reduce :: String -> String
reduce ('(':')':'(':')':rest) = "()" ++ reduce rest
reduce ('(':'(':')':')':rest) = reduce rest
reduce (head:rest) = head:reduce rest
reduce [] = []
fr = fix reduce
In other words, at the innermost level, occurrences of (()) disappear, and occurrences of ()() become (), and this continues until you have either “” or “()” left.
This seems to work fine, but what I’m wondering is how to define the same algorithm using an algebraic data type. I’ve tried things like
data Form = Empty | Mark [Form]
but writing nested values of that type gets confusing. and writing the reduce function is even more confusing. I wonder if there is a simple implementation that I am missing.
data Form = Mark [Form] deriving (Show, Eq)
test1 = [Mark[Mark[], Mark[]]]
test2 = [Mark[Mark[Mark[]]]]
test3 = [Mark[],Mark[]]
fix f x = let x' = f x in if x == x' then x else fix f x'
reduce :: [Form] -> [Form]
reduce (Mark[]:Mark[]:rest) = Mark[] : reduce rest
reduce (Mark[Mark[]]:rest) = reduce rest
reduce (Mark xs:rest) = Mark (reduce xs):reduce rest
reduce [] = []
fr = fix reduce
data Form = Empty | One | Pairs Form Form | Wraps Form
instance Show Form where
show form = case form of
Empty -> ""
One -> "()"
Pairs f1 f2 -> show f1 ++ show f2
Wraps f1 -> "(" ++ show f1 ++ ")"
reduceF :: Form -> Form
reduceF form = case form of
Empty -> Empty
One -> One
_ -> reduceF (reduce' form)
where
reduce' form' = case form' of
Empty -> Empty
One -> One
Pairs One One -> One
Pairs Empty f2 -> f2
Pairs f1 Empty -> f1
Pairs f1 f2 -> Pairs (reduce' f1) (reduce' f2)
Wraps One -> Empty
Wraps Empty -> One
Wraps f1 -> Wraps (reduce' f1)
mytest1 = Wraps $ Pairs One One
mytest2 = Wraps $ Wraps One
mytest3 = Pairs One One
test1 = "(()())"
test2 = "((()))"
test3 = "()()"
fix f x = let x' = f x in if x == x' then x else fix f x'
reduce :: String -> String
reduce ('(':')':'(':')':rest) = "()" ++ reduce rest
reduce ('(':'(':')':')':rest) = reduce rest
reduce (head:rest) = head:reduce rest
reduce [] = []
fr = fix reduce
main = do
print $ fr test1 ++ " - " ++ show (reduceF mytest1)
print $ fr test2 ++ " - " ++ show (reduceF mytest2)
print $ fr test3 ++ " - " ++ show (reduceF mytest3)