ForestStructures (empty) → 0.0.0.1
raw patch · 8 files changed
+326/−0 lines, 8 filesdep +ForestStructuresdep +QuickCheckdep +basesetup-changed
Dependencies added: ForestStructures, QuickCheck, base, containers, criterion, fgl, test-framework, test-framework-quickcheck2, test-framework-th, unordered-containers, vector, vector-th-unbox
Files
- Data/Forest/Static.hs +158/−0
- ForestStructures.cabal +99/−0
- LICENSE +30/−0
- README.md +15/−0
- Setup.hs +2/−0
- changelog.md +8/−0
- tests/benchmark.hs +7/−0
- tests/properties.hs +7/−0
+ Data/Forest/Static.hs view
@@ -0,0 +1,158 @@++-- | A data structure for a static forest.++module Data.Forest.Static where++import Data.Foldable (toList)+import Data.Graph.Inductive.Basic+import Data.List (span,uncons,sort)+import Data.Traversable (mapAccumL)+import Debug.Trace+import qualified Data.Map.Strict as S+import qualified Data.Tree as T+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Unboxed as VU++++-- | Kind of possible @TreeOrder@s.+--+-- TODO @In@ for in-order traversal?+--+-- TODO @Unordered@ for trees that have no sorted order?++data TreeOrder = Pre | Post++++-- | A static forest structure. While traversals are always explicitly+-- possible by following the indices, the nodes themselves shall always be+-- ordered by the type @p :: TreeOrder@. This is not completely enforced,+-- given that @Forest@ is exporting the constructor, but encouraged via+-- construction with helper functions.++data Forest (p :: TreeOrder) v a where+ Forest :: (VG.Vector v a) =>+ { label :: v a+ , parent :: VU.Vector Int+ , children :: V.Vector (VU.Vector Int)+ , lsib :: VU.Vector Int+ , rsib :: VU.Vector Int+ , roots :: VU.Vector Int+ } -> Forest p v a++deriving instance (Show a, Show (v a)) => Show (Forest p v a)++++-- | Construct a static 'Forest' with a tree traversal function. I.e.+-- @forestWith preorderF trees@ will construct a pre-order forest from the+-- list of @trees@.++forestWith :: (VG.Vector v a) => (forall a . [T.Tree a] -> [a]) -> [T.Tree a] -> Forest (p::TreeOrder) v a+forestWith f ts+ = Forest { label = VG.fromList $ f ts+ , parent = VU.fromList $ map (\(_,k,_ ,_) -> k ) $ f pcs+ , children = V.fromList $ map (\(_,_,cs,_) -> VU.fromList cs) $ f pcs+ , lsib = VU.fromList $ map fst $ S.elems lr+ , rsib = VU.fromList $ map snd $ S.elems lr+ , roots = VU.fromList $ map (fst . T.rootLabel) us+ }+ where+ -- Step 1: construct a forest isomorphic to @ts@ but labelled with+ -- a total order of unique identifiers. (That is: label with @Int@s).+ -- The unique identifiers are in pre-order.+ ps = addIndicesF' 0 ts+ -- Step 2: use @f@ to produce a permutation map and apply this+ -- permutation to turn the pre-order @ps@ into the required order.+ backp = VU.fromList $ map snd $ sort $ zip (f ps) [0..]+ -- Step 3: decorate the forest with indices in the correct order. Keep+ -- the label in @snd@.+ us = map (fmap (\(k,l) -> (backp VG.! k,l))) $ addIndicesF 0 ts+ -- Step 4: add the correct relations (children, lrSibling, parents)+ pcs = parentChildrenF (-1) us+ -- A map with the left and right sibling+ lr = lrSiblingF us++++-- | Construct a pre-ordered forest.++forestPre :: (VG.Vector v a) => [T.Tree a] -> Forest Pre v a+forestPre = forestWith preorderF++-- | Construct a post-ordered forest.++forestPost :: (VG.Vector v a) => [T.Tree a] -> Forest Post v a+forestPost = forestWith postorderF++-- | Add @pre-ordered@ !!! indices. First argument is the starting index.++addIndices :: Int -> T.Tree a -> T.Tree (Int,a)+addIndices k = snd . mapAccumL (\i e -> (i+1, (i,e))) k++-- | Add @pre-ordered@ !!! indices, but to a forest.++addIndicesF :: Int -> [T.Tree a] -> [T.Tree (Int,a)]+addIndicesF k = snd . mapAccumL go k+ where go = mapAccumL (\i e -> (i+1, (i,e)))++-- | Add @pre-ordered@ !!! indices to a forest, but throw the label away as+-- well.++addIndicesF' :: Int -> [T.Tree a] -> [T.Tree Int]+addIndicesF' k = snd . mapAccumL go k+ where go = mapAccumL (\i e -> (i+1, i))++-- | Add parent + children information. Yields+-- @(Index,Parent,[Child],Label)@. Parent is @-1@ if root node.++parentChildrenF :: Int -> [T.Tree (Int,a)] -> [T.Tree (Int,Int,[Int],a)]+parentChildrenF k ts = [ T.Node (i,k,children sf,l) (parentChildrenF i sf) | T.Node (i,l) sf <- ts ]+ where children sf = map (fst . T.rootLabel) sf++-- | Return a map with all the nearest siblings for each node, for a forest.++lrSiblingF :: [T.Tree (Int,a)] -> S.Map Int (Int,Int)+lrSiblingF = S.delete (-1) . lrSibling . T.Node (-1,error "laziness in lrSiblingF broken")++-- | Return a map with all the nearest siblings for each node, for a tree.++lrSibling :: T.Tree (Int,a) -> S.Map Int (Int,Int)+lrSibling = S.fromList . map splt . T.flatten . go ([]::[Int])+ where go sib (T.Node (k,lbl) frst) = let cs = [l | T.Node (l,_) _ <- frst] in T.Node (k,lbl,sib) [ go cs t | t <- frst]+ splt (k,_,[]) = (k,(-1,-1))+ splt (k,_,sbl) = let (ls,rs) = span (/=k) sbl in (k,(last $ (-1):ls,head $ tail rs ++ [-1]))++-- | Return the left-most leaf for each node.++leftMostLeaves :: Forest p v a -> VU.Vector Int+leftMostLeaves f = VG.map go $ VG.enumFromN 0 $ VG.length $ parent f+ where go k = let cs = children f VG.! k+ in if VG.null cs then k else go (VG.head cs)++-- | Return all left key roots. These are the nodes that have no (super-)+-- parent with the same left-most leaf.+--+-- This function is somewhat specialized for tree editing.+--+-- TODO group by++leftKeyRoots :: Forest Post v a -> VU.Vector Int+leftKeyRoots f = VU.fromList . sort . S.elems $ VU.foldl' go S.empty (VU.enumFromN (0::Int) $ VG.length $ parent f)+ -- Build a map from left-most leaf to most root-near node.+ where go s k = S.insertWith max (lml VU.! k) k s+ lml = leftMostLeaves f++{-+test :: [T.Tree Char]+test = [T.Node 'R' [T.Node 'a' [], T.Node 'b' []], T.Node 'S' [T.Node 'x' [], T.Node 'y' []]]++runtest = do+ print (forestPre test :: Forest Pre V.Vector Char)+ print (forestPost test :: Forest Post V.Vector Char)+ print (forestPost [T.Node 'R' [T.Node 'a' []]] :: Forest Post V.Vector Char)+ print (forestPost [T.Node 'R' [T.Node 'a' [], T.Node 'b' []]] :: Forest Post V.Vector Char)+-}+
+ ForestStructures.cabal view
@@ -0,0 +1,99 @@+name: ForestStructures+version: 0.0.0.1+author: Christian Hoener zu Siederdissen, Sarah Berkemer, 2015-2016+copyright: Christian Hoener zu Siederdissen, 2015-2016+homepage: https://github.com/choener/ForestStructures+bug-reports: https://github.com/choener/ForestStructures/issues+maintainer: choener@bioinf.uni-leipzig.de+category: Formal Languages, Bioinformatics+license: BSD3+license-file: LICENSE+build-type: Simple+stability: experimental+cabal-version: >= 1.10.0+tested-with: GHC == 7.8.4, GHC == 7.10.3+synopsis: Tree- and forest structures+description:+ This library provides both static and dynamic tree and forest+ structures. Once a tree structure is static, it can be mappend+ onto a linearized representation, which is beneficial for+ algorithms that do not modify the internal tree structure, but+ need fast @O(1)@ access to individual nodes, children, and+ siblings.++++Extra-Source-Files:+ changelog.md+ README.md++++library+ build-depends: base >= 4.7 && < 4.9+ , containers >= 0.5 && < 0.6+ , fgl >= 5.5 && < 5.6+ , unordered-containers >= 0.2 && < 0.3+ , vector >= 0.10 && < 0.12+ , vector-th-unbox >= 0.2 && < 0.3+ exposed-modules:+ Data.Forest.Static+ default-language:+ Haskell2010+ default-extensions: BangPatterns+ , AllowAmbiguousTypes+ , DataKinds+ , FlexibleContexts+ , GADTs+ , KindSignatures+ , OverloadedStrings+ , RankNTypes+ , StandaloneDeriving+ , UndecidableInstances+ ghc-options:+ -O2++++test-suite properties+ type:+ exitcode-stdio-1.0+ main-is:+ properties.hs+ ghc-options:+ -threaded -rtsopts -with-rtsopts=-N -O2 -funbox-strict-fields+ hs-source-dirs:+ tests+ default-language:+ Haskell2010+ default-extensions: BangPatterns+ build-depends: base+ , ForestStructures+ , QuickCheck+ , test-framework >= 0.8 && < 0.9+ , test-framework-quickcheck2 >= 0.3 && < 0.4+ , test-framework-th >= 0.2 && < 0.3++++benchmark benchmark+ build-depends: base+ , criterion >= 1.0.2 && < 1.1.1+ , ForestStructures+ default-language:+ Haskell2010+ hs-source-dirs:+ tests+ main-is:+ benchmark.hs+ type:+ exitcode-stdio-1.0+ ghc-options:+ -O2++++source-repository head+ type: git+ location: git://github.com/choener/ForestStructures+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 2015++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 Christian Hoener zu Siederdissen 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,15 @@+[](https://travis-ci.org/choener/ForestStructures)++# ForestStructures: Dynamic and static tree and forest structures++The static tree structure(s) shall be designed with an emphasis on performance.++++#### Contact++Christian Hoener zu Siederdissen +Leipzig University, Leipzig, Germany +choener@bioinf.uni-leipzig.de +http://www.bioinf.uni-leipzig.de/~choener/ +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,8 @@+0.0.0.1+-------++- initial checkin+- preparing travis.yml+- stack.yaml file+- pre and postorder for trees+
+ tests/benchmark.hs view
@@ -0,0 +1,7 @@+module Main where++++main :: IO ()+main = return ()+
+ tests/properties.hs view
@@ -0,0 +1,7 @@+module Main where++++main :: IO ()+main = return ()+