Mario Román

reducing a magma with transparent left multiplication

2 min read

module Magma where
 
data Mag a = I a | L [Mag a] deriving Eq
 
newtype Gen = Gen Char deriving Eq
 
a = Gen 'a'
b = Gen 'b'
u = Gen 'u'
v = Gen 'v'
 
instance Show Gen where
  show (Gen x) = [x]
 
 
example1 :: Mag Gen
example1 = L [I a, I b, L [I u, I v]]
 
example2 :: Mag Gen
example2 = L [I a, L [I b, L []]]
 
example3 :: Mag Gen
example3 = L [L [I a, I b], L [], L [I b, L [], I a], L [L [L [I a]]]]
 
example4 :: Mag Gen
example4 = L [L [L [L [I a, I b]], L [I a, I b]], I a]
 
instance (Show a) => Show (Mag a) where
  show (I x) = show x
  show (L lx) = "(" ++ concat (map show lx) ++ ")"
 
 
multiply :: Mag a -> Mag a -> Mag a
multiply a b = L [a, b]
 
empt :: Mag a
empt = L []
 
 
-- reduce at base level, assuming the elements are reduced
red :: (Eq a) => Mag a -> Mag a
red (I a)         = I a
red (L x)         = L (removeSingle $ removeLeft $ removeEmpty $ x)
  where
    removeLeft (L x : y) = x ++ y
    removeLeft u = u
    
    removeEmpty = filter (/= L [])
    
    removeSingle (L [I a] : x) = I a : removeSingle x
    removeSingle (L u : x) = L u : removeSingle x
    removeSingle (I a : x) = I a : removeSingle x
    removeSingle [] = []
 
-- reduce at each level
redl :: (Eq a) => Mag a -> Mag a
redl (I a) = red (I a)
redl (L x) = red (L (map redl x))

Tags: unital magma.

Graph View