Skip to content

Instantly share code, notes, and snippets.

@YoEight
Last active August 2, 2022 19:44
Show Gist options
  • Save YoEight/9710441 to your computer and use it in GitHub Desktop.
Save YoEight/9710441 to your computer and use it in GitHub Desktop.
Computes Fibonacci number with a histomorphism -- correction: Actually it's a dynamorphism as it uses an anamorphism to generate intermediary step
data Cofree f a = a :< (f (Cofree f a))
-- Fix point
newtype Mu f = Mu { unMu :: f (Mu f) }
extract :: Cofree f a -> a
extract (a :< _) = a
-- catamorphism
cata :: Functor f => (f b -> b) -> Mu f -> b
cata f = f . fmap (cata f) . unMu
-- anamporhism (catamorphism dual)
ana :: Functor f => (a -> f a) -> a -> Mu f
ana f a = Mu $ fmap (ana f) (f a)
-- hylomorphism (anamorphism and catamorphism composition)
hylo :: Functor f => (a -> f a) -> (f b -> b) -> a -> b
hylo f g = cata g . ana f
-- dynamorphism
dyna :: Functor f => (a -> f a) -> (f (Cofree f b) -> b) -> a -> b
dyna fa fc = extract . hylo fa (\fb -> fc fb :< fb)
-- Natural numbers
data Nat a = Zero | Succ a
instance Functor Nat where
fmap f (Succ a) = Succ $ f a
fmap _ Zero = Zero
nat :: b -> (a -> b) -> Nat a -> b
nat b _ Zero = b
nat _ f (Succ a) = f a
getN_1 :: Cofree Nat a -> a
getN_1 = extract
getN_2 :: a -> Cofree Nat a -> a
getN_2 a (_ :< as) = nat a getN_1 as
fib :: Integer -> Integer
fib = dyna gen crush where
gen 0 = Zero
gen n = Succ (n - 1)
crush Zero = 0
crush (Succ ns) =
let n_1 = getN_1 ns
n_2 = getN_2 1 ns in
n_1 + n_2
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment