# Basic implementation

1 Jun 2013

As of March 2020, School of Haskell has been switched to read-only mode.

# Cleaning up

First, we will define a newtype for a generated algebra.

``````
newtype GA k a = GA [(k,a)] deriving (Show, Eq)

main = print \$ GA \$ [(2,'a'),(-1,'c')]``````

Then, we will build our pyramid of requirements:

We search hoogle for monoid: `monoid.`

Let's go:

``````import Data.Monoid
import Data.List

--monoid already has mempty and mappend.

-- this will be more visual.
(<+>) = mappend

class Monoid s => SimpleAlgebra s where
(<*>) :: s -> s -> s

isZero x = x == mempty

instance (Monoid a, Eq a, SimpleAlgebra k) => Monoid (GA k a) where
mempty = GA []
(GA list1) `mappend` (GA list2) =  ... ``````

Because `list1` and `list2` are both lists of terms, you might guess that their sum will be simply the concatenation:

``(GA list1) `mappend` (GA list2) = GA \$ (list1 ++ list2)``

The problem is that this will never ever simplify; it will keep on growing forever.

We would like our `GA`s to be always as simple as they can get.

So here we hit our first road block; You see, we want the following simplification:

``````
2*a1 + 3*a1 = (2+3) *a1
``````

Here is how I break down this task into manageable pieces:

``````
2*a1 + 3*a1 = (map (+) [2,3]) *a1 = 5 * a1
``````

And here is how you do this:

### Regrouping:

``````import Data.Monoid
import Data.List
import Data.Function

regroup [] = []
regroup (x:xs) = let (likeX, unlikeX) = partition (((==) `on` snd) x) xs
in (fst x:map fst likeX, snd x) : regroup unlikeX

main = do let a = [(k,a) | k <- [0..5], a <- [2..7]]
print \$ regroup a``````

Then we generalize to include a function:

``````import Data.Monoid
import Data.List
import Data.Function

regroupWith f [] = []
regroupWith f (x:xs) = let (likeX, unlikeX) = partition (((==) `on` snd) x) xs
in (f \$ fst x:map fst likeX, snd x) : regroupWith f unlikeX

regroup list = regroupWith id list

main = do let a = [(k,a) | k <- [0..5], a <- [2..7]]
print \$ regroup a``````

## simplifying by accumulation

Then our simplifier is just:

``accum list = regroupWith mconcat list``
``````import Data.Monoid
import Data.List
import Data.Function

regroupWith f [] = []
regroupWith f (x:xs) = let (likeX, unlikeX) = partition (((==) `on` snd) x) xs
in (f \$ fst x:map fst likeX, snd x) : regroupWith f unlikeX

accum list = regroupWith mconcat list

main = do let a = [(k,a) | k <- map Sum [0..5], a <-  [2..7]]
print \$ accum a``````

## Monoid instance (how to add two elements of our GA)

``````
import Data.Monoid
import Data.List
import Data.Function

newtype GA k a = GA [(k,a)] deriving (Show, Eq)

--monoid already has mempty and mappend.
-- this will be more visual.
(<+>) :: Monoid a0 => a0 -> a0 -> a0
(<+>) = mappend

class Monoid s => SimpleAlgebra s where
(<*>) :: s -> s -> s

isZero x = x == mempty
clean ::  (Eq k, Monoid k) => GA k a -> GA k a
clean (GA list) = GA \$ filter (not . isZero . fst) list

regroupWith f [] = []
regroupWith f (x:xs) = let (likeX, unlikeX) = partition (((==) `on` snd) x) xs
in (f \$ fst x:map fst likeX, snd x) : regroupWith f unlikeX

accum list = regroupWith mconcat list
regroup list = regroupWith id list

instance (Monoid a, Eq a, SimpleAlgebra k, Eq k) => Monoid (GA k a) where
mempty = GA []
(GA list1) `mappend` (GA list2) =  clean \$ GA \$ accum (list1 ++ list2) ``````

## SimpleAlgebra instance (how to multiply in GA)

We basically multiply (by distributivity) each term of the first list with each term of the second list, and then we add all of it together.

To multiply two terms together, we multiply the `k`s in K, and the `a`s in A.

``````instance  (Monoid a, Eq a, SimpleAlgebra k, Eq k) => SimpleAlgebra (GA k a) where
(GA list1) <*> (GA list2) =  clean \$ GA \$ accum [(k1 <*> k2, a1 <> a2) |
(k1,a1) <- list1,
(k2,a2) <- list2]``````

# Full implementation

``````import Data.Monoid
import Data.List
import Data.Function

newtype GA k a = GA [(k,a)] deriving (Show, Eq)

--monoid already has mempty and mappend.
-- this will be more visual.
(<+>) :: Monoid a0 => a0 -> a0 -> a0
(<+>) = mappend

class Monoid s => SimpleAlgebra s where
(<*>) :: s -> s -> s

isZero x = x == mempty
clean ::  (Eq k, Monoid k) => GA k a -> GA k a
clean (GA list) = GA \$ filter (not . isZero . fst) list

regroupWith f [] = []
regroupWith f (x:xs) = let (likeX, unlikeX) = partition (((==) `on` snd) x) xs
in (f \$ fst x:map fst likeX, snd x) : regroupWith f unlikeX

accum list = regroupWith mconcat list
regroup list = regroupWith id list

instance (Monoid a, Eq a, SimpleAlgebra k, Eq k) => Monoid (GA k a) where
mempty = GA []
(GA list1) `mappend` (GA list2) =  clean \$ GA \$ accum (list1 ++ list2)

instance  (Monoid a, Eq a, SimpleAlgebra k, Eq k) => SimpleAlgebra (GA k a) where
(GA list1) <*> (GA list2) =  clean \$ GA \$ accum [(k1 <*> k2, a1 <> a2) | (k1,a1) <- list1, (k2,a2) <- list2]
``````

Next, we will implement this a little more efficiently.
{"ft_lang_label":"__label__en","ft_lang_prob":0.5740762,"math_prob":0.9961657,"size":4591,"snap":"2020-34-2020-40","text_gpt3_token_len":1532,"char_repetition_ratio":0.15195116,"word_repetition_ratio":0.63910615,"special_character_ratio":0.3528643,"punctuation_ratio":0.15982722,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.99991226,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-09-23T12:12:08Z\",\"WARC-Record-ID\":\"<urn:uuid:fe13287e-ee99-4235-8c72-4b3a4703bd11>\",\"Content-Length\":\"28383\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:ab33b3fd-a3fe-4674-b891-d1c9ba9099df>\",\"WARC-Concurrent-To\":\"<urn:uuid:b91e5e3a-093f-4d4a-b816-e89947d809f7>\",\"WARC-IP-Address\":\"23.20.232.179\",\"WARC-Target-URI\":\"https://www.schoolofhaskell.com/user/Sam567/generated-algebras-from-scratch/basic-implementation\",\"WARC-Payload-Digest\":\"sha1:MJBKBR4G5TF7LZ46RCW5BJGN32REUQEZ\",\"WARC-Block-Digest\":\"sha1:CQS5GCNI7YEVDKONV5ZHDXGNOPBV7WIX\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-40/CC-MAIN-2020-40_segments_1600400210996.32_warc_CC-MAIN-20200923113029-20200923143029-00371.warc.gz\"}"}