{-# 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:

• the Int type
• the (+) operator which is a polymorphic function of type signature a -> a -> a. It is a binary function, that when applied to Ints, takes two Int's and returns a single Int.
• 0 which can be consider a nullary (zero arity) function Int, taking nothing and returning a single Int.
• a closure law, that all functions in the algebra return a value within the same type. This law is implicit in the construction and definition of a type in Haskell.
• identity and associativity laws, something like:
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

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:

• the functor (an endofunctor F in a category C) -- []
• the carrier object (an object A in that category) -- Int
• the action (a morphism from F(A) to A) -- foldr (+) 0

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

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)

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:

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.