FenwickTree (empty) → 0.1
raw patch · 6 files changed
+369/−0 lines, 6 filesdep +QuickCheckdep +basedep +template-haskellsetup-changed
Dependencies added: QuickCheck, base, template-haskell
Files
- Data/Tree/Fenwick.hs +184/−0
- FenwickTree.cabal +41/−0
- LICENSE +31/−0
- README +7/−0
- Setup.hs +4/−0
- tests/test_Fenwick.hs +102/−0
+ Data/Tree/Fenwick.hs view
@@ -0,0 +1,184 @@+module Data.Tree.Fenwick(FTree,+ empty, insert,+ query, invQuery,+ toList, toFreqList,+ fromList,+ size, depth) where++import Data.List(sortBy, foldl')+-- ^ Fenwick trees are a O(log N) data structure for updating cumulative sums.+-- This implementation comes with an operation to find a least element for+-- which real-valued cumulative sum reaches certain value, and allows for+-- storage of arbitrary information in the nodes.+-- See http://en.wikipedia.org/wiki/Fenwick_tree++--import Control.Exception(assert) -- DEBUG++-- | Type of values that are summed.+type Val = Double++-- | Mother structure holds functions+-- that allow to get a value to be summed and comparison function.+-- Below there is a tree of `FNode`s.+data FTree a = FTree { root :: FNode a+ , val :: a -> Val+ , cmp :: a -> a -> Ordering+ }+-- TODO: Typeable, Data and others necessary for transport?++instance (Show a) => Show (FTree a) where+ showsPrec _ ft = ("FTree " ++) . shows (root ft)++-- | Node within a tree, contains a splitting element for comparison,+-- and partial sum for this element, which is added to all lookups+-- to the right.+data FNode a = Node { psum :: Val,+ split :: a,+ left, right :: FNode a+ }+ | Leaf+ deriving (Show)++-- | Creates an empty Fenwick tree.+empty :: (a -> Double) -> (a -> a -> Ordering) -> FTree a+empty v c = FTree { root = Leaf+ , val = v+ , cmp = c+ }++-- | Inserts a value into a Fenwick tree.+insert :: a -> FTree a -> FTree a+insert a ft = ft { root = insert' a (val ft) (cmp ft) (root ft) }++-- | Inserts a value into a given node of Fenwick tree.+insert' a val cmp Leaf = Node { psum = val a+ , split = a+ , left = Leaf+ , right = Leaf+ }+insert' a val cmp n@(Node { psum = p+ , split = s+ , left = l+ , right = r+ }) = case a `cmp` s of+ GT -> n { right = insert' a val cmp r }+ LT -> n { psum = p + val a+ , left = insert' a val cmp l }+ EQ -> n { psum = p + val a } -- just adjust frequency++-- | Finds a cumulative sum up to a given node of a Fenwick tree.+-- Note: if the node is not found, a sum at point corresponding to this+-- node is still returned. (Convenient for finding CDF value at a given point.)+query :: a -> FTree a -> Val+query a ft = query' (cmp ft) a (root ft)++-- | Finds a cumulative sum up to a given node within a subtree.+query' cmp a Leaf = 0.0+query' cmp a (Node { psum = p+ , split = s+ , left = l+ , right = r }) = case a `cmp` s of+ GT -> p + query' cmp a r+ LT -> query' cmp a l+ EQ -> p++-- | Finds a node corresponding to a given cumulative sum,+-- convenient for sampling quantile function of a distribution.+-- NOTE: returns an answer only up to a cumulative sum+-- of a whole tree.+invQuery :: Val -> FTree a -> Maybe a+invQuery v ft = invQuery' v (root ft)++-- | Finds a node corresponding to a given cumulative sum,+-- if it is in a given subtree.+invQuery' :: Val -> FNode a -> Maybe a +invQuery' v Leaf = Nothing+invQuery' v (Node { psum = p+ , split = s+ , left = l+ , right = r }) = case v `compare` p of+ EQ -> Just s+ GT -> invQuery' (v-p) r+ LT -> case invQuery' v l of+ Just r -> Just r+ Nothing -> Just s++-- | Extract a sorted list of inserted values from the tree.+toList :: FTree a -> [a]+toList ft = toList' (root ft) []++-- | Extract a sorted list of inserted objects from a subtree,+-- and prepends it to a last argument. (For efficiency.)+toList' Leaf cont = cont+toList' (Node { split = s+ , left = l+ , right = r }) cont = toList' l $ s:toList' r cont++-- | Extract a sorted list of cumulative sums, and corresponding+-- objects from the tree.+toFreqList :: FTree a -> [(Double, a)]+toFreqList ft = toFreqList' 0.0 (root ft) []++-- | Extract a sorted list of cumulative sums, and corresponding+-- objects from a subtree, assuming a given cumulative sum+-- from the start (left side of a tree), and list of values+-- from the right side of a tree as two helper arguments.+-- (For efficiency.)+toFreqList' cSum Leaf cont = cont+toFreqList' cSum (Node { split = s+ , psum = p+ , left = l+ , right = r+ }) cont = toFreqList' cSum l $+ (nSum, s):toFreqList' nSum r cont+ where+ nSum = p+cSum++-- | Creates a tree from a list and helper functions: compare, and value.+fromList cmp val ls = FTree { cmp = cmp+ , val = val+ , root = fromList' cmp val l $ sortBy cmp ls+ }+ where+ l = length ls++-- | Creates a subtree from a list and helper functions.+-- O(n^2): First it splits a list in half, then+fromList' cmp val 0 [ ] = Leaf+fromList' cmp val 1 [a] = Node { split = a+ , psum = val a+ , left = Leaf+ , right = Leaf+ }+fromList' cmp val n ls = Node { split = a+ , psum = val a+ , left = fromList' cmp val n' lsLeft+ , right = fromList' cmp val n'' lsRight+ }+ where+ a = head rest+ lsRight = tail rest+ (lsLeft, rest) = splitAt n' ls+ n' = n `div` 2+ n'' = n - n' - 1+-- TODO: Make it O(n) by recursion with continuations.+{-+ assertions r = assert (n' + n'' + 1 == n ) $+ assert (length lsRight == n'') $+ assert (length lsLeft == n' ) $+ r+-}++-- | Returns a maximum depth of a tree.+depth :: FTree a -> Int+depth = depth' . root++-- | Returns maximum depth of a given subtree.+depth' Leaf = 0+depth' (Node { left = l+ , right = r }) = (depth' l `max` depth' r) + 1++-- | Returns number of elements in a tree.+size :: FTree a -> Int+size = length . toList+
+ FenwickTree.cabal view
@@ -0,0 +1,41 @@+name: FenwickTree+version: 0.1+stability: alpha+homepage: https://github.com/mgajda/FenwickTree+package-url: http://hackage.haskell.org/package/FenwickTree+synopsis: Data structure for fast query and update of cumulative sums+description: Fenwick trees are a O(log N) data structure for updating cumulative sums.+ This implementation comes with an operation to find a least element for+ which real-valued cumulative sum reaches certain value, and allows for+ storage of arbitrary information in the nodes.+category: Data Structures+license: BSD3+license-file: LICENSE++author: Michal J. Gajda+copyright: Copyright by Michal J. Gajda '2013+maintainer: mjgajda@googlemail.com+bug-reports: mailto:mjgajda@googlemail.com++build-type: Simple+cabal-version: >=1.8+tested-with: GHC==7.4.2+data-files: README++source-repository head+ type: git+ location: git://github.com:mgajda/FenwickTree.git++Library+ ghc-options: -fspec-constr-count=4 -O3 + build-depends: base>=4.0, base <4.7, template-haskell, QuickCheck >= 2.5.0.0+ other-extensions: ScopedTypeVariables+ exposed-modules: Data.Tree.Fenwick+ exposed: True++Test-suite test_FenwickTree+ Type: exitcode-stdio-1.0+ main-is: tests/test_Fenwick.hs+ ghc-options: -fspec-constr-count=4 -O3 + Build-depends: base>=4.0, base <4.7, template-haskell, QuickCheck >= 2.5.0.0+
+ LICENSE view
@@ -0,0 +1,31 @@+PDB data in here (*.pdb files) is subject to Protein Databank License.++Haskell code in this package is subject to:++Copyright (c) Michal J. Gajda 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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 view
@@ -0,0 +1,7 @@+Fenwick trees are a O(log N) data structure for updating cumulative sums.+This implementation comes with an operation to find a least element for+which real-valued cumulative sum reaches certain value, and allows for+storage of arbitrary information in the nodes.++See:+http://en.wikipedia.org/wiki/Fenwick_tree
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ tests/test_Fenwick.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Data.Tree.Fenwick+import Data.List(sort)++import Test.QuickCheck+import Test.QuickCheck.All++tol = 0.001++infix 4 ==~++class AEq a where+ (==~) :: a -> a -> Bool++instance AEq Double where+ (==~) a b = abs (a - b) <= tol++instance (AEq a, AEq b) => AEq (a, b) where+ (a, b) ==~ (c, d) = (a ==~ c) && (b ==~ d)++instance (AEq a) => AEq [a] where+ [] ==~ [] = True+ (b:bs) ==~ (c:cs) = (b ==~ c) && (bs ==~ cs)+ _ ==~ _ = False++instance (AEq a) => AEq (Maybe a) where+ Nothing ==~ Nothing = True+ (Just f) ==~ (Just g) = f ==~ g+ _ ==~ _ = False++emptyFT :: FTree (Double, Double)+emptyFT = empty getFreq cmpFst++getFreq (pos, freq) = freq++cmpFst (pos1, _) (pos2, _) = pos1 `compare` pos2++absFreq (a, freq) = if aFreq == 0.0+ then (a, 0.001)+ else (a, aFreq)+ where+ aFreq = abs freq++-- Prepare a list of unique values++uniq [] = []+uniq (e:es) = (e:) . uniq . filter (/= e) $ es++mkTree = foldr insert emptyFT++prop_insert_toList ls = toList (mkTree uls) == sort uls+ where+ uls = uniq ls++prop_insert_query_non_zero l ls = query l (insert l ft) ==~ snd l + query l ft+ where+ ft = mkTree $ filter (/=l) ls++prop_freqList ls = toFreqList (mkTree uls) ==~ zip (tail $ scanl (\a b -> snd b + a) 0.0 uls) uls+ where+ uls = uniq $ sort ls++prop_freqList_query l ls = query l ft ==~ lookupFL l (toFreqList ft)+ where+ uls = uniq ls+ ft = insert l (mkTree uls)++lookupFL a ((f, b):_ ) | a == b = f+lookupFL a ((f, b):cs) = lookupFL a cs+lookupFL a [] = 0.0+-- prop_insert_freqList++prop_toList_fromList ls = toList (fromList cmpFst getFreq uls) == uls+ where+ uls = sort $ uniq ls++prop_size_fromList ls = size (mkTree uls) == length uls+ where+ uls = uniq ls++prop_depth_fromList ls = (d <= l) && ((floor . logBase 2 . fromIntegral) l <= d)+ where+ d = depth (mkTree uls)+ l = length uls+ uls = uniq ls++prop_freqList_invQuery q ls = ((jf /= Nothing) && (sumFreq > 0)) ==> jf ==~ lookupFreq q (toFreqList ft)+ where+ jf = invQuery q ft+ uls = uniq $ map absFreq ls+ ft = mkTree uls+ sumFreq = sum $ map snd ls++lookupFreq :: Double -> [(Double, (Double, Double))] -> Maybe (Double, Double)+lookupFreq q ((f, b):_ ) | q <= f = Just b+lookupFreq q ((f, b):cs) | q > f = lookupFreq q cs+lookupFreq q [] = Nothing++main = $quickCheckAll+