Skip to content

Instantly share code, notes, and snippets.

@smunix
Last active September 3, 2021 00:17

Revisions

  1. smunix revised this gist Sep 3, 2021. 1 changed file with 56 additions and 1 deletion.
    57 changes: 56 additions & 1 deletion BinaryTree.hs
    Original file line number Diff line number Diff line change
    @@ -1 +1,56 @@
    -- | Binary Tree
    import Data.Function ( fix )
    import Optics

    {- Given a binary tree, produce the sums of all
    the paths from the root to each of the leaves.
    NeoVim with HLS (Haskell Language Server)
    $> ghcid -W -a -c 'cabal repl lib:graph-mach-core'
    ScopedTypeVariables is an extension in Haskell
    LambdaCase extension in Haskell
    -}

    data BinaryTree a where
    Leaf ::a -> BinaryTree a
    Node ::{ _ltree :: BinaryTree a,
    _value :: a,
    _rtree :: BinaryTree a
    } ->
    BinaryTree a
    deriving (Show)

    makeLenses ''BinaryTree
    makePrisms ''BinaryTree

    -- | fix point combinator, Y - combinator
    gsums'' :: forall a . (Num a) => BinaryTree a -> [] a
    gsums'' = fix \r -> \case
    Leaf a -> [a]
    Node lt a rt -> fmap (+ a) (r lt <> r rt)

    gsums :: forall a . Num a => BinaryTree a -> [] a
    gsums (Leaf a ) = [a]
    gsums (Node lt a rt) = fmap (+ a) (gsums lt <> gsums rt)

    -- | using CPS (Continuation Passing Style) style
    gsums' :: forall a . (Num a) => BinaryTree a -> [] a
    gsums' = go id
    where
    go fn (Leaf a) = fn [a]
    go fn (Node lt a rt) =
    go (\lr -> go (\rr -> (fn . fmap (+ a)) (lr <> rr)) rt) lt

    gsums'''
    :: forall a f
    . (Num a, Semigroup (f a), Applicative f)
    => BinaryTree a
    -> f a
    gsums''' =
    (fix \r fn -> \case
    Leaf a -> pure a & fn
    Node lt a rt -> flip r lt \lr -> flip r rt \rr -> lr <> rr <&> (+ a) & fn
    )
    id
  2. smunix created this gist Sep 3, 2021.
    1 change: 1 addition & 0 deletions BinaryTree.hs
    Original file line number Diff line number Diff line change
    @@ -0,0 +1 @@
    -- | Binary Tree