cal-layout (empty) → 0.1.0.0
raw patch · 6 files changed
+286/−0 lines, 6 filesdep +basedep +cal-layoutdep +containers
Dependencies added: base, cal-layout, containers
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- README.md +88/−0
- cal-layout.cabal +44/−0
- example/Bookings.hs +29/−0
- src/CalLayout.hs +91/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+# Revision history for cal-layout++## 0.1.0.0 -- 2019-01-03+* First version.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Boro Sitnikovski++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Boro Sitnikovski nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,88 @@+# Calendar Layout Algorithm++This algorithm will calculate top, width, height, and width for each event in a list of events so that they can be drawn on a canvas such that none of them overlap.++## Algorithm++The most complex bit in the algorithm is `CalLayout.mkIntersectionsForest`, which, given a list of calendar events produces a `Data.Tree.Forest`.++Given a list of events, and an _initial_ event (such that it intersects all events), `mkIntersectionsForest` will convert them to a forest such that every parent overlaps the children. This will produce a similar forest (by excluding the initial element):++```+> putStr $ drawForest $ map (fmap show) forest+"P&P Leg Training"+|+`- "Gym Tour"++"12 days of Christmas workout"++"12 days of Christmas workout"+|+`- "12 days of Christmas workout"+```++Otherwise, the tree really looks like:++```+> putStr $ drawTree $ fmap show (Node initial forest)+"root"+|++- "P&P Leg Training"+| |+| `- "Gym Tour"+|++- "12 days of Christmas workout"+|+`- "12 days of Christmas workout"+ |+ `- "12 days of Christmas workout"+```++Now that we have this structure, we need to calculate the `depth` and `maxDepth` of each node. `CalLayout.populateDepths` does exactly that. Viewed as a forest, it looks something like:++```+("P&P Leg Training", 1, 1)+|+`- ("Gym Tour", 1, 0)++("12 days of Christmas workout", 0, 0)++("12 days of Christmas workout", 1, 1)+|+`- ("12 days of Christmas workout", 1, 0)+```++Once we have this data, calculations are straight-forward:++```+top = start e+left = width * depth+width = 100 / (1 + maxDepth)+height = end e - start e+```++As we can see, all this calculation is just for figuring out `left` and `width`, whereas `top` and `height` were easy.++## Prerequisites++Make sure you have [`stack`](https://haskellstack.org/) installed.++## Running++1. Run `stack init`+1. Run `stack run`++For playground, you can use `stack repl`.++Example:++```+$ stack run+("P&P Leg Training",Dimension {top = 600.0, left = 50.0, width = 50.0, height = 60.0})+("Gym Tour",Dimension {top = 600.0, left = 0.0, width = 50.0, height = 15.0})+("12 days of Christmas workout",Dimension {top = 720.0, left = 0.0, width = 100.0, height = 120.0})+("12 days of Christmas workout",Dimension {top = 840.0, left = 50.0, width = 50.0, height = 360.0})+("12 days of Christmas workout",Dimension {top = 1020.0, left = 0.0, width = 50.0, height = 120.0})+```++Copyright 2019, Boro Sitnikovski. All rights reserved.
+ cal-layout.cabal view
@@ -0,0 +1,44 @@+name: cal-layout+version: 0.1.0.0+synopsis: Calendar Layout Algorithm+copyright: (c) 2019 Boro Sitnikovski+homepage: https://github.com/bor0/cal-layout+license: BSD3+license-file: LICENSE+author: Boro Sitnikovski+maintainer: buritomath@gmail.com+category: Math+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10+description:+ This project demonstrates calculation of+ dimensions and positions for a list of+ events in a given calendar.+extra-source-files:+ CHANGELOG.md+ README.md+ LICENSE++source-repository head+ type: git+ location: https://github.com/bor0/cal-layout++source-repository this+ type: git+ tag: 0.1.0.0+ location: https://github.com/bor0/cal-layout++library+ exposed-modules: CalLayout+ build-depends: base >=4 && <5+ , containers ==0.5.11.0+ hs-source-dirs: src+ default-language: Haskell2010++executable bookings-test+ main-is: Bookings.hs+ build-depends: base >=4 && <5+ , cal-layout+ hs-source-dirs: example+ default-language: Haskell2010
+ example/Bookings.hs view
@@ -0,0 +1,29 @@+module Main where++import CalLayout++data Booking = Booking {+ bCalId :: String+ , bStart :: Int+ , bEnd :: Int+} deriving (Eq)++instance (CalLayout Booking) where+ start = bStart+ end = bEnd++instance (Show Booking) where+ show (Booking id _ _) = show id++initial = Booking "root" minBound maxBound++events = [+ Booking "Gym Tour" (10*60) (10*60 + 15)+ , Booking "P&P Leg Training" (10*60) (11*60)+ , Booking "12 days of Christmas workout" (12*60) (14*60)+ , Booking "12 days of Christmas workout" (17*60) (19*60)+ , Booking "12 days of Christmas workout" (14*60) (20*60)+ ]++main :: IO ()+main = mapM_ print $ getDimensions events initial
+ src/CalLayout.hs view
@@ -0,0 +1,91 @@+module CalLayout (CalLayout(..), Dimension, getDimensions) where++import Data.List+import Data.Tree++type TimeUnit = Int++-- | Main interface for events.+class (Eq a) => CalLayout a where+ start :: a -> TimeUnit+ end :: a -> TimeUnit++-- | Dimension data type.+data Dimension = Dimension {+ top :: Double+ , left :: Double+ , width :: Double+ , height :: Double+} deriving (Show)++-- | Insert an event into a tree by calculating intersections.+insertEvent :: (CalLayout a) => a -> Tree a -> Tree a+insertEvent e n@(Node t t') = if e `intersects` t then Node t (insertEventForest e t') else n+ where+ -- | Given two events, check if they intersect.+ intersects :: (CalLayout a) => a -> a -> Bool+ intersects e e' = (start e >= start e' && start e < end e')+ || ((start e' == start e) || (end e' == end e))+ -- | Given an event and a tree, check if the tree contains it.+ treeContains :: (CalLayout a) => a -> Tree a -> Bool+ treeContains e (Node e' []) = e == e'+ treeContains e (Node e' trs) = e == e' || any (treeContains e) trs+ -- | Insert an event in a forest.+ insertEventForest :: (CalLayout a) => a -> Forest a -> Forest a+ insertEventForest e [] = [Node e []]+ insertEventForest e (x:xs) = let newx = insertEvent e x in+ if treeContains e newx+ then newx : xs+ else x : insertEventForest e xs++-- | Make intersections forest by recursively using `insertEvent`.+-- we need to provide an initial member since a `Data.Tree` cannot be empty.+mkIntersectionsForest :: (CalLayout a) => [a] -> a -> Forest a+mkIntersectionsForest events initial = go (sortBy startSort events) initialTree+ where+ -- | The initial tree contains a root node with least and most start/end times+ -- for capturing all intersections.+ initialTree = Node initial []+ -- | startSort first sorts by start time, then length of events+ startSort e1 e2 | start e1 == start e2 = lengthSort e1 e2+ | start e1 < start e2 = LT+ | otherwise = GT+ -- | Sorts by length of events+ lengthSort e1 e2 | end e2 < end e1 = LT+ | otherwise = GT+ -- | Iterative function for constructing the forest+ go [] (Node r f) = f -- skip `initial` root+ go (e:es) forest = go es (insertEvent e forest)++-- | For a given forest, populate max depth and depth+-- we need those for calculating width/left respectively.+populateDepths :: Forest a -> [(a, Int, Int)]+populateDepths = concatMap populateDepth+ where+ calcDepth :: Tree a -> Int+ calcDepth (Node _ []) = 0+ calcDepth (Node _ x) = 1 + maximum (map calcDepth x)+ squish :: Int -> Tree a -> [(a, Int, Int)] -> [(a, Int, Int)]+ squish maxDepth n@(Node x ts) xs = (x, maxDepth, calcDepth n) : foldr (squish maxDepth) xs ts+ populateDepth :: Tree a -> [(a, Int, Int)]+ populateDepth t = squish (calcDepth t) t []++-- | Calculate dimensions for a forest.+calculateDimensions :: (CalLayout a) => Forest a -> [(a, Dimension)]+calculateDimensions forest = go (populateDepths forest)+ where+ go [] = []+ go ((e, maxDepth, depth) : xs) = (e, Dimension top left width height) : go xs+ where+ -- top is straightforward.+ top = fromIntegral $ start e+ -- left is a little more complex, since it relies on depth.+ left = width * fromIntegral depth+ -- width is a little more complex, since it relies on max depth.+ width = 100 / (1 + fromIntegral maxDepth)+ -- height is straightforward.+ height = fromIntegral $ end e - start e++-- | Helper wrapper for getting dimensions.+getDimensions :: (CalLayout a) => [a] -> a -> [(a, Dimension)]+getDimensions events initial = calculateDimensions $ mkIntersectionsForest events initial