Data

Tools

Indexes

Applications

Experiments

Awesome

An open API service indexing awesome lists of open source software.

https://github.com/alcarney/binarytreehouse

A haskell implementation of a data structrue I've called a "BinaryTreeHouse" for want of a better name.
https://github.com/alcarney/binarytreehouse

Last synced: 9 months ago
JSON representation

A haskell implementation of a data structrue I've called a "BinaryTreeHouse" for want of a better name.

Awesome Lists containing this project

README 

          
* BinaryTreeHouse



This Haskell package implements a data structure which for want of a better name I am calling a

~BinaryTreeHouse~ simply because it is essentially a binary tree, but with the difference that the

terminal "Leaf" nodes can have one type, while the "Branches" can have a completely different type.

When you draw a structure such as this I think it looks like a tree with tree houses on all the

branches - hence the name.



This package's README is a [[https://en.wikipedia.org/wiki/Literate_programming][literate program]], so this file contains all the code contained in this

package written, explained and tested all in one place. Currently this is done with Emacs' Org Mode

and more specifically Org-Babel to deal with all the source code. For obvious reasons this makes it

difficult for people who don't use or are not familiar with emacs to contribute and I'd like to work

towards a more portable solution both in terms of software used and markup formats used.



I also want to take the opportunity of this fairly simple project to learn "How to do things right"

i,e. I want to learn how to do proper testing, packing and distribution etc. As well as getting a

feel for what working on a literate program is like and starting to find/create tools that help make

the process easier - after all no one will want to do it of it's hard ;)



Without further ado, let's get into it

* Implementation Documentation



This section of the document goes into detail about how this package is implemented, it explains

many of the whys and hows which make up this package. Any major new contributions must be written up

here so that we have a comprehensive up to date reference for anyone who wishes to get to grips with

the internals of the package.



** Defining the Tree



The ~BinaryTreeHouse~ datatype is recursive in nature where nodes are either a terminal Leaf node

containing a value or a Branch node which contains a value and left and right sub-trees. We also

must consider the possibilty of an empty tree, which we can represent with a ~Nil~ data

constructor. So in Haskell we write

#+begin_src haskell :noweb-ref binarytreehouse-def

data BinaryTreeHouse a b = Nil

                         | Leaf a

                         | Branch b (BinaryTreeHouse a b) (BinaryTreeHouse a b)

#+end_src



Where ~a~ and ~b~ are type parameters and can replaced by any type. Now if we let Haskell derive the

instance of ~Show~ for this datatype for us then if we ask Haskell to show us the tree consisting of

a single branch containing the letter 'a' and two Leaves containing the value '2' and '5' then it

will represent the tree as follows

#+begin_src haskell

Branch "a" (Leaf 2) (Leaf 5)

#+end_src



Which is all well and good for simple trees but this very quicklt gets out of hand as you increase

the complexity of the tree, so instead we create our own show instance to give us an ASCII

representation of our tree instead to look something like the following

#+begin_src

     +-----+

     | "a" |

     +-----+

+---+       +---+

| 2 |       | 5 |

+---+       +---+

#+end_src



which makes the structure of the tree immediately more obvious. So we can write our show instance as

follows

#+begin_src haskell :noweb-ref binarytreehouse-show-instance

instance (Show a, Show b) => Show (BinaryTreeHouse a b) where

    show t = show $ showBinaryTreeHouse t



showBinaryTreeHouse :: (Show a, Show b) => BinaryTreeHouse a b -> TextBlock

showBinaryTreeHouse Nil = makeTextBlock [""]

showBinaryTreeHouse (Leaf x) = showBox ('+', '-', '|') 0 x

showBinaryTreeHouse (Branch h x y) = addToTheRight 0 (addToTheRight 0 left house) right

  where house = showBox ('+', '-', '|') 0 h

        left = padTop (height house) (showBinaryTreeHouse x)

        right = padTop (height house) (showBinaryTreeHouse y)

#+end_src



As you can see this makes use of the ~TextBlock~ datatype which handles the manipulation of the

various blocks of text and allows us to align thing easily, since this is defined in another module

I will not go into details here, please refer to the section on ~Showing the Tree~ for full details.



*** Bifunctor Instance



So it turns out that our ~BinaryTreeHouse~ is a ~Bifunctor~ which as far as I can tell it is

essentially a ~Functor~ but with two independant datatypes. There are two ways of defining a

~Bifunctor~ instance either by providing an implementation of ~bimap~ (given two functions f, g map

them over the two datatypes) or providing implementations of functions ~first~ (given a function f

map it over just the first datatype) and ~second~ (given a function f map it over just the second

datatype).



So below we create the ~Bifunctor~ instance by defining the ~first~ function to map over the leaves

of the tree and the ~second~ function to map over the branches of the tree.

#+begin_src haskell :noweb-ref binarytreehouse-bifunctor-instance

instance Bifunctor BinaryTreeHouse where



  first _ Nil = Nil

  first f (Leaf a) = Leaf (f a)

  first f (Branch house left right) = Branch house (first f left) (first f right)



  second _ Nil = Nil

  second _ (Leaf a) = Leaf a

  second f (Branch house left right) = Branch (f house) (second f left) (second f right)

#+end_src



Finally we define a function that allows you to combine two ~BinaryTreeHouse~ structures underneath

a common branch.

#+begin_src haskell :noweb-ref binarytreehouse-growth

growTree :: b -> BinaryTreeHouse a b -> BinaryTreeHouse a b -> BinaryTreeHouse a b

growTree _ Nil Nil = Nil

growTree house left right = Branch house left right

#+end_src



With everything defined we can now define our ~BinaryTreeHouse~ module

#+begin_src haskell :tangle src/Data/BinaryTreeHouse.hs :noweb yes :padline no

module Data.BinaryTreeHouse

(

    BinaryTreeHouse(..),



    growTree

) where



import Data.Bifunctor

import Data.TextBlock



<>

<>

<>

<>

#+end_src



** Showing the BinaryTreeHouse



As mentioned in the previous section if we let Haskell derive the show instance for us it can very

quickly become difficult to interpret the structure of the tree when shown, so instead we will

derive our own instance.



By rendering the tree in ASCII and the recursive nature of the structure we have to be able to

manipulate lists of strings easily so that all the characters are aligned properly. To help abstract

over the issue we create the ~TextBlock~ datatype which we will write various functions for to help

arrange a number of them.



So what is a ~TextBlock~ made from? Well, we need to keep track of its width and height and of

course the text it contains, so using Haskell's record syntax we define the following

#+begin_src haskell :noweb-ref textblock-def

data TextBlock = TextBlock {width :: Int, height :: Int, contents :: [String]}

#+end_src



also we need to be able to view the contents so let's also define a ~Show~ instance

#+begin_src haskell :noweb-ref textblock-show-instance

instance Show TextBlock where

    show (TextBlock _ _ str) = unlines str

#+end_src



Now while we can manually create a TextBlock we might give the wrong widths and height so it would

be better to simply pass a list of strings to a function which we wish to make into a block and have

the function do the rest.



The following function not only converts a list of strings into a TextBlock, but also makes sure

that all lines in the block are as long as the longest line in the block. Any lines that are shorter

than this have spaces appended to them until they are the correct length.

#+begin_src haskell :noweb-ref textblock-make

makeTextBlock :: [String] -> TextBlock

makeTextBlock str = TextBlock {width = newWidth, height = newHeight, contents = newContents}

  where newWidth = maximum $ map length str

        newHeight = length str

        newContents = map (makeLength newWidth) str

        makeLength x s

            | length s < x = s ++ spacePadding (x - length s)

            | otherwise = s



spacePadding :: Int -> String

spacePadding x = replicate x ' '



#+end_src



Particuarly for our use case it can be useful to define a ~showBox~ function where given a 3-tuple

of ~Char~ for the characters to use for corners, top/bottom and side edges and an integer to define

some padding surround a "Showable" object in an ASCII box.

#+begin_src haskell :noweb-ref showbox-func

showBox :: Show a => (Char, Char, Char) -> Int -> a -> TextBlock

showBox (corner, top, edge) off x = makeTextBlock [topedge, itemedge, topedge]

  where item = show x

        showlength = length item + 2

        offset = spacePadding off

        topedge = [corner] ++ replicate (showlength + 2 * off) top ++ [corner]

        itemedge = [edge] ++ offset ++ " " ++ item ++ " " ++ offset ++ [edge]

#+end_src



Before we get to combining TextBlocks we need to define our own zip function, since the zip

implementation in Haskell's Prelude stops when one of the zip's arguments runs out the longer list

is truncated. In our case that would lead to TextBlocks losing text when stuck together - not good!



So we define our own ~zipWithPad~ where given a two lists ~[a]~, ~[b]~ to zip together with

some function ~(a -> b -> c)~ and something to pad the lists with in case they run out then we can

define as follows

#+begin_src haskell :noweb-ref zip-funcs

zipWithPad :: (a -> b -> c) -> a -> b -> [a] -> [b] -> [c]

zipWithPad f a _ [] ys = zipWith f (repeat a) ys

zipWithPad f _ b xs [] = zipWith f xs (repeat b)

zipwithPad f a b (x:xs) (y:ys) = f x y : zipWithPad f a b xs ys



#+end_src



In particular the above function comes in useful when we want to stitch two boxes together side by

side.

#+begin_src haskell :noweb-ref zip-funcs

sideBySideZip :: [String] -> [String] -> [String]

sideBySideZip x y = zipWithPad (++) (spacePadding x') (spacePadding y') x y

  where x' = maximum $ map length x

        y' = maximum $ map length y

#+end_src



We need to be able to combine TextBlocks together so we now write a number of functions which allow

us to do this with the option to add pading between them.

#+begin_src haskell :noweb-ref textblock-combination-funcs

-- Adds the second block on top of the first

addOnTop :: Int -> TextBlock -> TextBlock -> TextBlock

addOnTop pad x y = TextBlock {width = newWidth, height = newHeight, contents = newContents}

  where newWidth = max (width x) (width y)

        newHeight = height x + height y + pad

        padding = replicate pad $ spacePadding newWidth

        newContents = contents (enforceWidth y) ++ padding ++ contents (enforceWidth x)

        enforceWidth a

            | width a < newWidth = padRight (newWidth - width a) a

            | otherwise  = a



addBelow :: Int -> TextBlock -> TextBlock -> TextBlock

addBelow pad x y = addOnTop pad y x



addToTheRight :: Int -> TextBlock -> TextBlock -> TextBlock

addToTheRight pad x y = TextBlock {width = newWidth, height = newHeight, contents = newContents}

  where newWidth = width x + width y + pad

        newHeight = max (height x) (height y)

        x' = x {width = width x + 1, contents = map (++ spacePadding pad) (contents x)}

        newContents = sideBySideZip (contents x') (contents y)



addToTheLeft :: Int -> TextBlock -> TextBlock -> TextBlock

addToTheLeft pad x y = addToTheRight pad y x



#+end_src



It may also be useful to pad blocks simply for alignment purposes so we provide a number of

functions to pad a ~TextBlock~ with a given number of spaces. Here we also create a datatype to help

simplify the implementation of the ~padBlock~ function.

#+begin_src haskell :noweb-ref padfunc-datatype-def

data Side = STop | SBottom | SLeft | SRight

#+end_src



#+begin_src haskell :noweb-ref textblock-padding-funcs

padBlock :: Side -> Int -> TextBlock -> TextBlock

padBlock _ 0 x = x

padBlock STop pad x = addOnTop 0 x (makeTextBlock $ replicate pad $ spacePadding $ width x)

padBlock SBottom pad x = addBelow 0 x (makeTextBlock $ replicate pad $ spacePadding $ width x)

padBlock SLeft pad x = addToTheLeft 0 x (makeTextBlock $ replicate (height x) $ spacePadding pad)

padBlock SRight pad x = addToTheRight 0 x (makeTextBlock $ replicate (height x) $ spacePadding pad)



padTop :: Int -> TextBlock -> TextBlock

padTop = padBlock STop



padBottom :: Int -> TextBlock -> TextBlock

padBottom = padBlock SBottom



padLeft :: Int -> TextBlock -> TextBlock

padLeft = padBlock SLeft



padRight :: Int -> TextBlock -> TextBlock

padRight = padBlock SRight



#+end_src



Finally! We can now create our ~TextBlock~ module

#+begin_src haskell :tangle src/Data/TextBlock.hs :noweb yes :padline no

module Data.TextBlock

(

    TextBlock (..),

    makeTextBlock,

    showBox,



    padRight,

    padLeft,

    padTop,

    padBottom,



    addOnTop,

    addBelow,

    addToTheRight,

    addToTheLeft



) where



-- Data Types

<>

<>



-- Instance Definitions

<>



-- Functions

<>

<>

<>

<>

<>

#+end_src



*** TODO Investigate making a monoid instance for the TextBlock

Would this simplify any of our existing functions for us?

*** TODO Add function that allows you to add a border to a TextBlock

Then reimplement the showBinaryTreeHouse function in terms of this function.

*** TODO Investigate simplifying the add* functions

Can we use the ~makeBlock~ function to simplify things?