Skip to content

Instantly share code, notes, and snippets.

@sordina
Created June 1, 2018 03:40
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sordina/8435cd0b82b61aa2d7b7195ba51887a7 to your computer and use it in GitHub Desktop.
Save sordina/8435cd0b82b61aa2d7b7195ba51887a7 to your computer and use it in GitHub Desktop.
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Control.Arrow
import Data.Functor.Classes
data Fix f = In { out :: (f (Fix f)) }
instance (Show (f (Fix f))) => Show (Fix f) where
show (In f) = "In (" ++ show f ++ ")"
main :: IO ()
main = print "hello"
bottomUp :: Functor f => (Fix f -> Fix f) -> Fix f -> Fix f
bottomUp fn =
out -- 1) unpack
>>> fmap (bottomUp fn) -- 2) recurse
>>> In -- 3) repack
>>> fn -- 4) apply
data Stump a f = Node a | Branch f f deriving (Functor, Show)
type Tree a = Fix (Stump a)
tree :: Tree Int
tree = In (Branch
(In (Branch (In (Node 1)) (In (Node 2))))
(In (Branch (In (Node 3)) (In (Node 4)))))
mappo f (In (Node x)) = In (Node (f x))
mappo f x = x
inc = mappo succ
tree2 = bottomUp inc tree
summo (In (Node x)) = In (Node x)
summo (In (Branch (In (Node x)) (In (Node y)))) = In (Node (x + y))
summo _ = In (Node 0)
foldo f (In (Node x)) = In (Node x)
foldo f (In (Branch (In (Node x)) (In (Node y)))) = In (Node (f x y))
foldo f t = t
tree3 = bottomUp summo tree
tree4 = bottomUp summo tree2
factorialtree5 = bottomUp (foldo (*)) tree2
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment