{-# LANGUAGE NoImplicitPrelude #-}
import Tower.Prelude

Algebra (a work in progress)

A distinguishing feature of Haskell is our focus on algebra. Don Stewart suggests that all problem domains of computation are algebraic, and software architectures are mappings from one algebra to another. Gabriel Gonzalez describes the algebra of 3 + 4 + 9 = 16 as the essence of the haskell design pattern:

Combine several components together of type A to generate a new component of the same type A, indistinguishable in character from its substituent parts.

Being such a powerful metaphor, algebra is many things to many different parts of haskell. The very general and not very theoretical meaning is this: an algebra in Haskell terms is a type T, together with some operators1 and some laws about the interaction of the type and the functions.

For example, (Int, (+), 0) is an algebra consisting of:

a + 0 = a
0 + a = a
a + (b + c) = (a + b) + c

And that's enough to fully specify an algebra - in this case, the Int addition monoid.

F-Algebras

https://www.schoolofhaskell.com/user/bartosz/understanding-algebras

A more concrete definition of an algebra in Haskell is this:

type Algebra f a = f a -> a

Which Bartosz covers nicely here and here.

Here algebra consists of:

or foldr (+) 0 :: Algebra [] Int


newtype Fix f = Fx (f (Fix f))

unFix :: Fix f -> f (Fix f)
unFix (Fx x) = x

cata :: Functor f => (f a -> a) -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFix

Free Magma

In tree terms, the free magma is a rooted binary trees which are finite, proper (i.e. every node has 0 or 2 children) and whose leaves are elements of a, eg

usual version of a Tree

data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Eq, Functor)

fix version

data FreeMagmaF r a = Single a | Double r r deriving (Eq, Functor)
type FreeMagma a = Fix (FreeMagmaF a)

alg :: (Magma a) => Algebra (FreeMagmaF a) a
alg (Single a) = a
alg (a `Double` b) = a ⊕ b
opMagma :: Tree a -> Tree a -> Tree a
opMagma a b = Branch a b

1 ⊕ (4 ⊕ 9)

(Leaf 1) Branch ((Leaf 4) Branch (Leaf 9))

-- x = In $ (In $ Single 1) `Double` (In $ (In $ Single 4) `Double` (In $ Single 4))
-- exMagma = In $ (In $ Single 1) `Double` (In $ (In $ Single 1) `Double` (In $ Single 1))

Unital

Unit is added by grafting to the root of the tree

data FreeU a = Empty | NonEmpty (Tree a)

singleU :: a -> FreeU a
singleU a = NonEmpty (Leaf a)

opU :: FreeU a -> FreeU a -> FreeU a
opU Empty b = b
opU a Empty = a
opU (NonEmpty a) (NonEmpty b) = NonEmpty (Branch a b)

Associative

See https://www.schoolofhaskell.com/user/bss/magma-tree

Almost but not quite isomorphic to a non-empty list

data NonEmpty a = a :| [a]

'not quite' because [] admits an Empty to the definition, and we'd like to be able to think about non-unital associations.

data FreeA a = SingleA a | OpA a (FreeA a)

opA :: FreeA a -> FreeA a -> FreeA a
opA (SingleA a) b = OpA a b
opA (OpA a b) c = OpA a (opA b c)
  -- (a ⊕ b) ⊕ c
  opA (opA (SingleA a) b) c
= opA (OpA a b) c
= OpA a (opA b c)
= opA (SingleA a) (opA b c)
  -- a ⊕ (b ⊕ c)

Idempotent

Without associativity, the best representation you can achieve is just to check equality on either side of the operation.

a + a = a
(a + a) + a = a + a = a
(a + b) + (a + b) = a + b
(a + b) + b /= a + b
data FreeI a = SingleI a | OpI (FreeI a) (FreeI a) deriving (Eq)

ie same shape as the FreeMagma

opI :: (Eq a) => FreeI a -> FreeI a -> FreeI a
opI a b = if a == b then a else OpI a b

Monoid (Associative, Unital)

See https://www.schoolofhaskell.com/user/bss/magma-tree

data [] a = [] | a : [a]

data List a = Unit | Op a (List a)

fix version

data ListF a b = Nil | Cons a b deriving Functor

algSum :: (Additive a) => ListF a a -> a
algSum Nil = zero
algSum (Cons a b) = a + b
lst :: (Num a) => Fix (ListF a)
lst = Fx $ Cons 2 (Fx $ Cons 3 (Fx $ Cons 4 (Fx Nil)))


-- data FreeM a = UnitM | OpM a (FreeM a)

singleM :: a -> [a]
singleM s = [s]

opM :: [a] -> [a] -> [a]
opM = (++)
-- opM [] a = a
-- opM a [] = a
-- opM (a:b) c = a:(opM b c)
  -- unit ⊕ a
  opM [] (singleM a)
  -- a
= singleM a
= OpM a UnitM
= OpM a (opM UnitM UnitM)
= opM (OpM a UnitM) UnitM
= opM (singleM a) UnitM
  -- a ⊕ unit

  -- (a ⊕ b) ⊕ c
  opM (opM (singleM a) b) c
= opM (opM (OpM a UnitM) b) c
= opM (OpM a (opM UnitM b)) c
= opM (OpM a b) c
= OpM a (opM b c)
= OpM a (opM UnitM (opM b c))
= opM (OpM a UnitM) (opM b c)
= opM (singleM a) (opM b c)
  -- a ⊕ (b ⊕ c)

Group


opGroup :: (Eq a, Invertible a) => [a] -> [a] -> [a]
opGroup [] a = a
opGroup a [] = a
opGroup (a:b) fb@(c:d) =
    if a == inv c
    then opGroup b d
    else a:opGroup b fb

Monoidal, Idempotent

(a + b) + b = a + (b + b) = a + b
a + (a + b) = (a + a) + b = a + b
-- data FreeMI a = UnitMI | OpMI a (FreeMI a) deriving (Eq)

opMI :: (Eq a) => [a] -> [a] -> [a]
opMI [] a = a
opMI a [] = a
opMI fa@(a:b) fb@(c:d)
  | fa == fb = fa
  | otherwise = a:opMI b fb

Monoidal, Commutative

Once we have associativity and commutivity, the canonical representation is an ordered list

-- data FreeMC a = UnitMC | OpMC a (FreeMC a) deriving (Eq, Ord)

opMC :: (Ord a) => [a] -> [a] -> [a]
opMC [] a = a
opMC a [] = a
opMC fa@(a:b) fb@(c:d) =
    if a <= c
    then a:opMC b fb
    else c:opMC fa d

Monoidal, Idempotent, Commutative

-- data FreeMIC a = UnitMIC | OpMIC a (FreeMIC a) deriving (Eq, Ord)

opMIC :: (Eq a, Ord a) => [a] -> [a] -> [a]
opMIC [] a = a
opMIC a [] = a
opMIC fa@(a:b) fb@(c:d)
    | fa == fb = fa
    | a == c = a:opMIC b d
    | b == d = a:fb
    | a <= c = a:opMIC b fb
    | b <= d = c:a:opMIC b d
    | otherwise = c:a:opMIC d b

Abelian Group

-- data FreeGroupC a = UnitGroupC | OpGroupC a (FreeGroupC a) deriving (Eq, Ord)

opGroupC :: (Eq a, Ord a, Invertible a) => [a] -> [a] -> [a]
opGroupC [] a = a
opGroupC a [] = a
opGroupC f@(a:b) fb@(c:d)
    | a == inv c && b <= d = opGroupC b d
    | a == inv c && b > d = opGroupC d b
    | a <= c = a:opGroupC b fb
    | b <= d = c:a:opGroupC b d
    | otherwise = c:a:opGroupC d b

semiring

addition is commutative monoidal mult is monoidal

-- data FreeSemiring a = FreeSemiring (List (List a))
opSemiring :: (Eq a, Ord a, Invertible a) => [[a]] -> [[a]] -> [[a]]
opSemiring [] a = a
opSemiring a [] = a
opSemiring f@(a:b) fb@(c:d) = undefined

instance Semiring (FreeSemiring a) liftFree :: forall s a. (Semiring s) => (a -> s) -> Free a -> s

reference:

https://www.schoolofhaskell.com/user/bss/magma-tree

https://bartoszmilewski.com/2014/09/29/how-to-get-enriched-over-magmas-and-monoids/

https://xinitrc.de/blog/2014/02/09/Sucker-for-generality.html

http://homepages.inf.ed.ac.uk/wadler/papers/free-rectypes/free-rectypes.txt

https://www.schoolofhaskell.com/user/bss/magma-tree

https://bartoszmilewski.com/2013/06/10/understanding-f-algebras/


  1. I go back and forth about whether to call (+) :: a -> a -> a a function or operator. Usage in Haskell tends towards function being very general. Usage of operator tends towards functions that are candidates for infix (and thus get mixed with other operators so that precedence is important), are common, and are introduced in classes.