Implementing the "Laws of Form" with an algebraic data type

Learn
#1

I have been reading a little bit about the so-called Laws of Form. Dan Piponi has a complicated post with Haskell code from several years ago.

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.

#2

I think I’d write it like this:

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

I’m not sure if that does exactly what you want.

1 Like
#3

Ah, I see. That’s simple. Getting reduce to take a list of forms, not a single form, is a good trick. I’ll have to think about that a bit. Thank you!

#4 

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)
1 Like
#5

This is helpful. Thank you.

I’m not sure about the use of a Pairs constructor. After all, the data structure is basically a “rose tree”, as far as I can see.

It might be overcomplicating things to say that this is a “biased definition” of the datatype, when what is really needed is the rose tree structure.

https://ncatlab.org/nlab/show/biased+definition

Writing the reduce function for a rose tree with empty leaves should probably be the next thing I try.