Lab 6 for the FP101x course about Rose trees, functors, monoids, and foldables in Frege

lab6-frege-template.fr

------------------------------------------------------------------------------------------------------------------------------
-- ROSE TREES, FUNCTORS, MONOIDS, FOLDABLES, Frege version by Dierk Koenig
------------------------------------------------------------------------------------------------------------------------------

module Lab6 where

import frege.prelude.Math(round, sin)

data Rose a = Rose a [Rose a]
derive Show Rose a
derive Eq   Rose a

-- create an infix operator :> for the Rose constructor, which is right-associative at precedence 13 (same as ++)
infixr 13 `:>`
(:>) = Rose

-- ===================================
-- Ex. 0
-- ===================================

root :: Rose a -> a 
root tree = undefined

children :: Rose a -> [Rose a]
children tree = undefined

xs = 0 :>
        [1 :>
            [2 :>
                [3 :>
                    [4 :> [],
                     5 :> []]]],
         6 :> [],
         7 :>
            [8 :>
                [9 :>
                    [10 :> []],
                 11 :> []],
             12 :>
                [13 :> []]]]

ex0 = root . head . children . head . children . head . drop 2 $ children xs

-- ===================================
-- Ex. 1
-- ===================================

size :: Rose a -> Int
size tree = undefined 

leaves :: Rose a -> Int
leaves tree = undefined

ex1 = (*) (leaves . head . children . head . children $ xs) (product . map size . children . head . drop 2 . children $ xs)

-- ===================================
-- Ex. 2
-- ===================================

instance Functor Rose where
  fmap f tree = undefined

ex2 = round . root . head . children . fmap (\x -> if x > 0.5 then x else 0) $ fmap (\x -> Double.sin(fromIntegral x)) xs

-- ===================================
-- Ex. 3
-- ===================================

class Monoid m where
  mempty :: m
  mappend :: m -> m -> m

data Sum a = Sum {unSum :: a}
derive Show Sum a

data Product a = Product {unProduct :: a}
derive Show Product a

instance Monoid (Num a) =>  Sum a where
  mempty = Sum (fromIntegral 0)
  mappend (Sum n1) (Sum n2) = Sum (n1 + n2)

instance Monoid (Num a) => Product a where
  mempty = undefined
  mappend (Product n1) (Product n2) = undefined

num1 = mappend (mappend (Sum 2) (mappend (mappend mempty (Sum 1)) mempty)) (mappend (Sum 2) (Sum 1))
  
num2 = mappend (Sum 3) (mappend mempty (mappend (mappend (mappend (Sum 2) mempty) (Sum (-1))) (Sum 3)))
  
ex3 = Sum.unSum (mappend (Sum 5) (Sum (Product.unProduct (mappend (Product (Sum.unSum num2)) (mappend (Product (Sum.unSum num1)) (mappend mempty (mappend (Product 2) (Product 3))))))))

-- ===================================
-- Ex. 4
-- ===================================

-- A foldable over a datastructure of monoids or
-- a foldable over a datastructure that can be mapped to a datastructure over monoids by a functor

class Foldable Functor f => f where
  foldit  :: Monoid m => f m -> m
--  foldMap :: Monoid m => (a -> m) -> f a -> m         -- leave this commented for Ex 4 and uncomment for Ex 5
--  foldMap f func = undefined                          -- leave this commented for Ex 4 and uncomment for Ex 5

instance Foldable Rose where
  foldit tree = undefined

sumxs = Sum 0 :> [Sum 13 :> [Sum 26 :> [Sum (-31) :> [Sum (-45) :> [], Sum 23 :> []]]], Sum 27 :> [], Sum 9 :> [Sum 15 :> [Sum 3 :> [Sum (-113) :> []], Sum 1 :> []], Sum 71 :> [Sum 55 :> []]]]

ex4 = Sum.unSum (mappend (mappend (foldit sumxs) (mappend (foldit . head . drop 2 . children $ sumxs) (Sum 30))) (foldit . head . children $ sumxs))

-- ===================================
-- Ex. 5
-- ===================================

ex5 = Sum.unSum (mappend (mappend (foldMap Sum xs) (mappend (foldMap Sum . head . drop 2 . children $ xs) (Sum 30))) (foldMap Sum . head . children $ xs))

-- ===================================
-- Ex. 6
-- ===================================

ex6 = Sum.unSum (mappend (mappend (foldMap Sum xs) (Sum (Product.unProduct (mappend (foldMap Product . head . drop 2 . children $ xs) (Product 3))))) (foldMap Sum . head . children $ xs))

-- ===================================
-- Ex. 7
-- ===================================

fsum :: (Foldable f, Num a) => f a -> a
fsum xs = undefined

fproduct :: (Foldable f, Num a) => f a -> a
fproduct xs = undefined

ex7 = ((fsum . head . drop 1 . children $ xs) + (fproduct . head . children . head . children . head . drop 2 . children $ xs)) - (fsum . head . children . head . children $ xs)


-- Successively uncomment the lines below to validate your implementation

main _ = do
--    println $ root (1 :> [2 :> [], 3 :> []])        == 1
--    println $ root ('a' :> [])                      == 'a'
--
--    println $ children (1 :> [2 :> [], 3 :> []])    == [2 :> [], 3 :> []]
--    println $ children ('a' :> [])                  == []
--
--    println $ ex0
--    println $ ex1
--    println $ fmap (*2) (1 :> [2 :> [], 3 :> []])   == (2 :> [4 :> [], 6 :> []])
--    println $ ex2
--    println $ ex3
--    println $ ex4
--    println $ ex5
--    println $ ex6
--    println $ ex7