dual-tree (empty) → 0.1.0.0
raw patch · 6 files changed
+495/−0 lines, 6 filesdep +basedep +monoid-extrasdep +newtypesetup-changed
Dependencies added: base, monoid-extras, newtype, semigroups
Files
- CHANGES +3/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- dual-tree.cabal +54/−0
- src/Data/Tree/DUAL.hs +88/−0
- src/Data/Tree/DUAL/Internal.hs +318/−0
+ CHANGES view
@@ -0,0 +1,3 @@+* 0.1.0.0: 3 September 2012++ Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011-2012, Brent Yorgey++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 Brent Yorgey 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dual-tree.cabal view
@@ -0,0 +1,54 @@+name: dual-tree+version: 0.1.0.0+synopsis: Rose trees with cached and accumulating monoidal annotations+description: Rose (n-ary) trees with both upwards- (/i.e./+ cached) and downwards-traveling (/i.e./+ accumulating) monoidal annotations. This is used+ as the core data structure underlying the+ @diagrams@ framework+ (<http://projects.haskell.org/diagrams>), but+ potentially has other applications as well.+ .+ Abstractly, a DUALTree is a rose (n-ary) tree+ with data (of type @l@) at leaves, data (of type+ @a@) at internal nodes, and two types of monoidal+ annotations, one (of type @u@) travelling \"up\"+ the tree and one (of type @d@) traveling+ \"down\".+ .+ See "Data.Tree.DUAL" for full documentation.+ "Data.Tree.DUAL" provides a public API which+ should suffice for most purposes.+ "Data.Tree.DUAL.Internal" exports more of the+ internal implementation---use it at your own+ risk.+license: BSD3+license-file: LICENSE+extra-source-files: CHANGES+author: Brent Yorgey+maintainer: diagrams-discuss@googlegroups.com+category: Data+build-type: Simple+cabal-version: >=1.10+bug-reports: https://github.com/diagrams/dual-tree/issues++source-repository head+ type: git+ location: https://github.com/diagrams/dual-tree.git++library+ default-language: Haskell2010+ exposed-modules: Data.Tree.DUAL+ Data.Tree.DUAL.Internal+ build-depends: base >= 4.3 && < 4.7, + semigroups >= 0.8 && < 0.9,+ newtype >= 0.2 && < 0.3,+ monoid-extras >= 0.2 && < 0.3+ hs-source-dirs: src+ other-extensions: GeneralizedNewtypeDeriving,+ MultiParamTypeClasses,+ FlexibleInstances,+ DeriveFunctor,+ TypeOperators,+ FlexibleContexts,+ DeriveDataTypeable
+ src/Data/Tree/DUAL.hs view
@@ -0,0 +1,88 @@++-----------------------------------------------------------------------------+-- |+-- Module : Data.Tree.DUAL+-- Copyright : (c) 2011-2012 Brent Yorgey+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Rose (n-ary) trees with both upwards- (/i.e./ cached) and+-- downwards-traveling (/i.e./ accumulating) monoidal annotations.+-- This is used as the core data structure underlying the @diagrams@+-- framework (<http://projects.haskell.org/diagrams>), but potentially+-- has other applications as well.+--+-- Abstractly, a DUALTree is a rose (n-ary) tree with data (of type+-- @l@) at leaves, data (of type @a@) at internal nodes, and two types+-- of monoidal annotations, one (of type @u@) travelling \"up\" the+-- tree and one (of type @d@) traveling \"down\".+--+-- Specifically, there are five types of nodes:+--+-- * Leaf nodes which contain a data value of type @l@ and an+-- annotation of type @u@. The annotation represents information+-- about a tree that should be accumulated (/e.g./ number of+-- leaves, some sort of \"weight\", /etc./). If you are familiar+-- with finger trees+-- (<http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>,+-- <http://hackage.haskell.org/package/fingertree>), it is the+-- same idea.+--+-- * There is also a special type of leaf node which contains only a+-- @u@ value, and no data. This allows cached @u@ values to be+-- \"modified\" by inserting extra annotations.+--+-- * Branch nodes, containing a list of subtrees.+--+-- * Internal nodes with a value of type @d@. @d@ may have an+-- /action/ on @u@ (see the 'Action' type class, defined in+-- "Data.Monoid.Action" from the @monoid-extras@ package).+-- Semantically speaking, applying a @d@ annotation to a tree+-- transforms all the @u@ annotations below it by acting on them.+-- Operationally, however, since the action must be a monoid+-- homomorphism, applying a @d@ annotation can actually be done in+-- constant time.+--+-- * Internal nodes with data values of type @a@, possibly of a+-- different type than those in the leaves. These are just \"along+-- for the ride\" and are unaffected by @u@ and @d@ annotations.+--+-- There are two critical points to note about @u@ and @d@ annotations:+--+-- * The combined @u@ annotation for an entire tree is always cached+-- at the root and available in constant (amortized) time.+--+-- * The 'mconcat' of all the @d@ annotations along the path from+-- the root to each leaf is available along with the leaf during a+-- fold operation.+--+-- A fold over a @DUALTree@ is given access to the internal and leaf+-- data, and the accumulated @d@ values at each leaf. It is also+-- allowed to replace \"@u@-only\" leaves with a constant value. In+-- particular, however, it is /not/ given access to any of the @u@+-- annotations, the idea being that those are used only for+-- /constructing/ trees. It is also not given access to @d@ values as+-- they occur in the tree, only as they accumulate at leaves. If you+-- do need access to @u@ or @d@ values, you can duplicate the values+-- you need in the internal data nodes.+--+-----------------------------------------------------------------------------++module Data.Tree.DUAL+ (+ -- * DUAL-trees+ DUALTree++ -- * Constructing DUAL-trees+ , empty, leaf, leafU, annot, applyD++ -- * Modifying DUAL-trees+ , applyUpre, applyUpost+ , mapU++ -- * Accessors and eliminators+ , getU, foldDUAL, flatten++ ) where++import Data.Tree.DUAL.Internal
+ src/Data/Tree/DUAL/Internal.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Tree.DUAL.Internal+-- Copyright : (c) 2011-2012 Brent Yorgey+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- This module provides access to all of the internals of the+-- DUAL-tree implementation. Depend on the internals at your own+-- risk! For a safe public API (and complete documentation), see+-- "Data.Tree.DUAL".+--+-- The main things exported by this module which are not exported from+-- "Data.Tree.DUAL" are two extra types used in the implementation of+-- 'DUALTree', along with functions for manipulating them. A type of+-- /non-empty/ trees, 'DUALTreeNE', is defined, as well as the type+-- 'DUALTreeU' which represents a non-empty tree paired with a cached+-- @u@ annotation. 'DUALTreeNE' and 'DUALTreeU' are mutually+-- recursive, so that recursive tree nodes are interleaved with cached+-- @u@ annotations. 'DUALTree' is defined by just wrapping+-- 'DUALTreeU' in 'Option'. This method has the advantage that the+-- type system enforces the invariant that there is only one+-- representation for the empty tree. It also allows us to get away+-- with only 'Semigroup' constraints in many places.+--+-----------------------------------------------------------------------------++module Data.Tree.DUAL.Internal+ (+ -- * DUAL-trees+ DUALTreeNE(..), DUALTreeU(..), DUALTree(..)++ -- * Constructing DUAL-trees+ , empty, leaf, leafU, annot, applyD++ -- * Modifying DUAL-trees+ , applyUpre, applyUpost+ , mapUNE, mapUU, mapU++ -- * Accessors and eliminators+ , nonEmpty, getU, foldDUALNE, foldDUAL, flatten++ ) where++import Control.Arrow ((***))+import Data.Functor ((<$>))+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NEL+import Data.Maybe (fromMaybe, catMaybes, mapMaybe)+import Data.Monoid.Action+import Data.Semigroup+import Data.Tuple (swap)+import Data.Typeable++import Control.Newtype++------------------------------------------------------------+-- DUALTreeNE+------------------------------------------------------------++-- | /Non-empty/ DUAL-trees.+data DUALTreeNE d u a l+ = Leaf u l -- ^ Leaf with data value and @u@ annotation+ | LeafU u -- ^ Leaf with only @u@ annotation+ | Concat (NonEmpty (DUALTreeU d u a l))+ -- ^ n-way branch, containing a /non-empty/ list+ -- of subtrees.+ | Act d (DUALTreeU d u a l)+ -- ^ @d@ annotation+ | Annot a (DUALTreeU d u a l)+ -- ^ Internal data value+ deriving (Functor, Typeable, Show, Eq)++instance (Action d u, Semigroup u) => Semigroup (DUALTreeNE d u a l) where+ t1 <> t2 = sconcat (NEL.fromList [t1,t2])+ sconcat = Concat . NEL.map pullU++newtype DAct d = DAct { unDAct :: d }++instance Newtype (DAct d) d where+ pack = DAct+ unpack = unDAct++instance (Semigroup d, Semigroup u, Action d u)+ => Action (DAct d) (DUALTreeNE d u a l) where+ act (DAct d) (Act d' t) = Act (d <> d') t+ act (DAct d) t = Act d (pullU t)++------------------------------------------------------------+-- DUALTreeU+------------------------------------------------------------++-- | A non-empty DUAL-tree paired with a cached @u@ value. These+-- should never be constructed directly; instead, use 'pullU'.+newtype DUALTreeU d u a l = DUALTreeU { unDUALTreeU :: (u, DUALTreeNE d u a l) }+ deriving (Functor, Semigroup, Typeable, Show, Eq)++instance Newtype (DUALTreeU d u a l) (u, DUALTreeNE d u a l) where+ pack = DUALTreeU+ unpack = unDUALTreeU++instance (Semigroup d, Semigroup u, Action d u)+ => Action (DAct d) (DUALTreeU d u a l) where+ act d = over DUALTreeU (act (unDAct d) *** act d)++-- | \"Pull\" the root @u@ annotation out into a tuple.+pullU :: (Semigroup u, Action d u) => DUALTreeNE d u a l -> DUALTreeU d u a l+pullU t@(Leaf u _) = pack (u, t)+pullU t@(LeafU u) = pack (u, t)+pullU t@(Concat ts) = pack (sconcat . NEL.map (fst . unpack) $ ts, t)+pullU t@(Act d (DUALTreeU (u,_))) = pack (act d u, t)+pullU t@(Annot _ (DUALTreeU (u, _))) = pack (u, t)++------------------------------------------------------------+-- DUALTree+------------------------------------------------------------++-- | Rose (n-ary) trees with both upwards- (/i.e./ cached) and+-- downwards-traveling (/i.e./ accumulating) monoidal annotations.+-- Abstractly, a DUALTree is a rose (n-ary) tree with data (of type+-- @l@) at leaves, data (of type @a@) at internal nodes, and two+-- types of monoidal annotations, one (of type @u@) travelling+-- \"up\" the tree and one (of type @d@) traveling \"down\". See+-- the documentation at the top of this file for full details.+--+-- @DUALTree@ comes with some instances:+--+-- * 'Functor', for modifying leaf data. Note that 'fmap' of course+-- cannot alter any @u@ annotations.+--+-- * 'Semigroup'. @DUALTreeNE@s form a semigroup where @(\<\>)@+-- corresponds to adjoining two trees under a common parent root,+-- with @sconcat@ specialized to put all the trees under a single+-- parent. Note that this does not satisfy associativity up to+-- structural equality, but only up to observational equivalence+-- under 'flatten'. Technically using 'foldDUAL' directly enables+-- one to observe the difference, but it is understood that+-- 'foldDUAL' should be used only in ways such that reassociation+-- of subtrees \"does not matter\".+--+-- * 'Monoid'. The identity is the empty tree.++newtype DUALTree d u a l = DUALTree { unDUALTree :: Option (DUALTreeU d u a l) }+ deriving ( Functor, Semigroup, Typeable, Show, Eq )++instance Newtype (DUALTree d u a l) (Option (DUALTreeU d u a l)) where+ pack = DUALTree+ unpack = unDUALTree++instance (Semigroup u, Action d u) => Monoid (DUALTree d u a l) where+ mempty = DUALTree mempty+ mappend = (<>)+ mconcat [] = mempty+ mconcat (x:xs) = sconcat (x :| xs)++-- | Apply a @d@ annotation at the root of a tree. Semantically, all+-- @u@ annotations are transformed by the action of @d@, although+-- operationally @act@ incurs only a constant amount of work.+instance (Semigroup d, Semigroup u, Action d u)+ => Action (DAct d) (DUALTree d u a l) where+ act = over DUALTree . fmap . act++------------------------------------------------------------+-- Convenience methods etc.+------------------------------------------------------------++-- | The empty DUAL-tree. This is a synonym for 'mempty', but with a+-- more general type.+empty :: DUALTree d u a l+empty = DUALTree (Option Nothing)++-- | Construct a leaf node from a @u@ annotation along with a leaf+-- datum.+leaf :: u -> l -> DUALTree d u a l+leaf u l = DUALTree (Option (Just (DUALTreeU (u, Leaf u l))))++-- | Construct a leaf node from a @u@ annotation.+leafU :: u -> DUALTree d u a l+leafU u = DUALTree (Option (Just (DUALTreeU (u, LeafU u))))++-- | Add a @u@ annotation to the root, combining it (on the left) with+-- the existing cached @u@ annotation. This function is provided+-- just for convenience; @applyUpre u t = 'leafU' u \<\> t@.+applyUpre :: (Semigroup u, Action d u) => u -> DUALTree d u a l -> DUALTree d u a l+applyUpre u t = leafU u <> t++-- | Add a @u@ annotation to the root, combining it (on the right) with+-- the existing cached @u@ annotation. This function is provided+-- just for convenience; @applyUpost u t = t \<\> 'leafU' u@.+applyUpost :: (Semigroup u, Action d u) => u -> DUALTree d u a l -> DUALTree d u a l+applyUpost u t = t <> leafU u++-- | Add an internal data value at the root of a tree. Note that this+-- only works on /non-empty/ trees; on empty trees this function is+-- the identity.+annot :: (Semigroup u, Action d u) => a -> DUALTree d u a l -> DUALTree d u a l+annot a = (over DUALTree . fmap) (pullU . Annot a)++-- | Apply a @d@ annotation at the root of a tree, transforming all+-- @u@ annotations by the action of @d@.+applyD :: (Semigroup d, Semigroup u, Action d u)+ => d -> DUALTree d u a l -> DUALTree d u a l+applyD = act . DAct++-- | Decompose a DUAL-tree into either @Nothing@ (if empty) or a+-- top-level cached @u@ annotation paired with a non-empty+-- DUAL-tree.+nonEmpty :: DUALTree d u a l -> Maybe (u, DUALTreeNE d u a l)+nonEmpty = fmap unpack . getOption . unpack++-- | Get the @u@ annotation at the root, or @Nothing@ if the tree is+-- empty.+getU :: DUALTree d u a l -> Maybe u+getU = fmap fst . nonEmpty++------------------------------------------------------------+-- Maps+------------------------------------------------------------++-- XXX todo: try adding Map as a constructor, so we can delay the+-- mapping until the end too?++-- | Map a function (which must be a monoid homomorphism, and commute+-- with the action of @d@) over all the @u@ annotations in a non-empty+-- DUAL-tree.+mapUNE :: (u -> u') -> DUALTreeNE d u a l -> DUALTreeNE d u' a l+mapUNE f (Leaf u l) = Leaf (f u) l+mapUNE f (LeafU u) = LeafU (f u)+mapUNE f (Concat ts) = Concat ((NEL.map . mapUU) f ts)+mapUNE f (Act d t) = Act d (mapUU f t)+mapUNE f (Annot a t) = Annot a (mapUU f t)++-- | Map a function (which must be a monoid homomorphism, and commute+-- with the action of @d@) over all the @u@ annotations in a+-- non-empty DUAL-tree paired with its cached @u@ value.+mapUU :: (u -> u') -> DUALTreeU d u a l -> DUALTreeU d u' a l+mapUU f = over DUALTreeU (f *** mapUNE f)++-- | Map a function over all the @u@ annotations in a DUAL-tree. The+-- function must be a monoid homomorphism, and must commute with the+-- action of @d@ on @u@. That is, to use @mapU f@ safely it must be+-- the case that+--+-- * @f mempty == mempty@+--+-- * @f (u1 \<\> u2) == f u1 \<\> f u2@+--+-- * @f (act d u) == act d (f u)@+--+mapU :: (u -> u') -> DUALTree d u a l -> DUALTree d u' a l+mapU = over DUALTree . fmap . mapUU++------------------------------------------------------------+-- Folds+------------------------------------------------------------++-- | Fold for non-empty DUAL-trees.+foldDUALNE :: (Semigroup d, Monoid d)+ => (d -> l -> r) -- ^ Process a leaf datum along with the+ -- accumulation of @d@ values along the+ -- path from the root+ -> r -- ^ Replace @LeafU@ nodes+ -> (NonEmpty r -> r) -- ^ Combine results at a branch node+ -> (a -> r -> r) -- ^ Process an internal datum+ -> DUALTreeNE d u a l -> r+foldDUALNE = foldDUALNE' (Option Nothing)+ where+ foldDUALNE' dacc lf _ _ _ (Leaf _ l) = lf (option mempty id dacc) l+ foldDUALNE' _ _ lfU _ _ (LeafU _) = lfU+ foldDUALNE' dacc lf lfU con ann (Concat ts)+ = con (NEL.map (foldDUALNE' dacc lf lfU con ann . snd . unpack) ts)+ foldDUALNE' dacc lf lfU con ann (Act d t)+ = foldDUALNE' (dacc <> (Option (Just d))) lf lfU con ann . snd . unpack $ t+ foldDUALNE' dacc lf lfU con ann (Annot a t)+ = ann a (foldDUALNE' dacc lf lfU con ann . snd . unpack $ t)++-- | Fold for DUAL-trees. It is given access to the internal and leaf+-- data, and the accumulated @d@ values at each leaf. It is also+-- allowed to replace \"@u@-only\" leaves with a constant value. In+-- particular, however, it is /not/ given access to any of the @u@+-- annotations, the idea being that those are used only for+-- /constructing/ trees. It is also not given access to @d@ values+-- as they occur in the tree, only as they accumulate at leaves. If+-- you do need access to @u@ or @d@ values, you can duplicate the+-- values you need in the internal data nodes.+--+-- The result is @Nothing@ if and only if the tree is empty.+foldDUAL :: (Semigroup d, Monoid d)+ => (d -> l -> r) -- ^ Process a leaf datum along with the+ -- accumulation of @d@ values along the+ -- path from the root+ -> r -- ^ Replace @u@-only nodes+ -> (NonEmpty r -> r) -- ^ Combine results at a branch node+ -> (a -> r -> r) -- ^ Process an internal datum+ -> DUALTree d u a l -> Maybe r+foldDUAL _ _ _ _ (DUALTree (Option Nothing))+ = Nothing+foldDUAL l u c a (DUALTree (Option (Just (DUALTreeU (_, t)))))+ = Just $ foldDUALNE l u c a t++-- | A specialized fold provided for convenience: flatten a tree into+-- a list of leaves along with their @d@ annotations, ignoring+-- internal data values.+flatten :: (Semigroup d, Monoid d) => DUALTree d u a l -> [(l, d)]+flatten = fromMaybe []+ . foldDUAL+ (\d l -> [(l, d)])+ []+ (concat . NEL.toList)+ (const id)