Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

100% haddock coverage

  • Loading branch information...
commit 3b891b36b24af7e76f91529217d51aa62157579a 1 parent 8a92775
Edward Kmett authored
12 lca.cabal
View
@@ -1,6 +1,6 @@
name: lca
category: Algorithms, Data Structures
-version: 0.2.1
+version: 0.2.2
license: BSD3
cabal-version: >= 1.6
license-file: LICENSE
@@ -10,8 +10,14 @@ stability: provisional
homepage: http://github.com/ekmett/lca/
bug-reports: http://github.com/ekmett/lca/issues
copyright: Copyright (C) 2011-2012 Edward A. Kmett
-synopsis: O(log n) persistent on-line lowest common ancestor calculation without preprocessing with optional monoidal annotations
-description: O(log n) persistent on-line lowest common ancestor calculation without preprocessing with optional monoidal annotations
+synopsis: O(log n) persistent on-line lowest common ancestor calculation without preprocessing
+description:
+ This library implements the technique described in my talk
+ .
+ <http://www.slideshare.net/ekmett/skewbinary-online-lowest-common-ancestor-search>
+ .
+ to improve the known asymptotic bounds on /online/ lowest common ancestor search from /O(n)/ to
+ /O(log n)/ without preprocessing and with optional monoidal annotations.
build-type: Simple
extra-source-files: .travis.yml
37 src/Data/LCA/Online.hs
View
@@ -9,12 +9,17 @@
-- Portability : portable
--
-- Provides online calculation of the the lowest common ancestor in /O(log h)/
--- by compressing the spine of the paths using a skew-binary random access
+-- by compressing the spine of a 'Path' using a skew-binary random access
-- list.
--
+-- This library implements the technique described in my talk
+--
+-- <http://www.slideshare.net/ekmett/skewbinary-online-lowest-common-ancestor-search>
+--
+-- to improve the known asymptotic bounds on online lowest common ancestor search.
+--
-- Algorithms used here assume that the key values chosen for @k@ are
-- globally unique.
---
----------------------------------------------------------------------------
module Data.LCA.Online
( Path
@@ -41,7 +46,6 @@ import Prelude hiding (length, null, drop)
import Data.LCA.View
-- | Complete binary trees
--- NB: we could ensure the complete tree invariant
data Tree a
= Bin {-# UNPACK #-} !Int a (Tree a) (Tree a)
| Tip {-# UNPACK #-} !Int a
@@ -70,8 +74,8 @@ data Path a
= Nil
| Cons {-# UNPACK #-} !Int -- the number of elements @n@ in this entire skew list
{-# UNPACK #-} !Int -- the number of elements @w@ in this binary tree node
- (Tree a) -- a complete binary tree @t@ of with @w@ elements
- (Path a) -- @n - w@ elements in a linked list @ts@, of complete trees in ascending order by size
+ (Tree a) -- a complete binary tree @t@ of with @w@ elements
+ (Path a) -- @n - w@ elements in a linked list @ts@, of complete trees in ascending order by size
deriving (Show, Read)
instance Functor Path where
@@ -90,16 +94,19 @@ consT :: Int -> Tree a -> Path a -> Path a
consT w t ts = Cons (w + length ts) w t ts
{-# INLINE consT #-}
+-- | Convert a 'Path' to a list of @(ID, value)@ pairs.
toList :: Path a -> [(Int,a)]
toList Nil = []
toList (Cons _ _ t ts) = go t (toList ts) where
go (Tip k a) xs = (k,a) : xs
go (Bin k a l r) xs = (k,a) : go l (go r xs)
+-- | Build a 'Path' from a list of @(ID, value)@ pairs.
fromList :: [(Int,a)] -> Path a
fromList [] = Nil
fromList ((k,a):xs) = cons k a (fromList xs)
+-- | Traverse a 'Path' with access to the node IDs.
traverseWithKey :: Applicative f => (Int -> a -> f b) -> Path a -> f (Path b)
traverseWithKey f = go where
go Nil = pure Nil
@@ -108,44 +115,46 @@ traverseWithKey f = go where
goT (Tip k a) = Tip k <$> f k a
{-# INLINE traverseWithKey #-}
--- | The empty path
+-- | The 'empty' 'Path'
empty :: Path a
empty = Nil
{-# INLINE empty #-}
--- | /O(1)/
+-- | /O(1)/ Determine the 'length' of a 'Path'.
length :: Path a -> Int
length Nil = 0
length (Cons n _ _ _) = n
{-# INLINE length #-}
--- | /O(1)/
+-- | /O(1)/ Returns 'True' iff the path is 'empty'.
null :: Path a -> Bool
null Nil = True
null _ = False
{-# INLINE null #-}
-- | /O(1)/ Invariant: most operations assume that the keys @k@ are globally unique
+--
+-- Extend the 'Path' with a new node ID and value.
cons :: Int -> a -> Path a -> Path a
cons k a (Cons n w t (Cons _ w' t2 ts)) | w == w' = Cons (n + 1) (2 * w + 1) (Bin k a t t2) ts
cons k a ts = Cons (length ts + 1) 1 (Tip k a) ts
{-# INLINE cons #-}
--- | /O(1)/
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path'.
uncons :: Path a -> Maybe (Int, a, Path a)
uncons Nil = Nothing
uncons (Cons _ _ (Tip k a) ts) = Just (k, a, ts)
uncons (Cons _ w (Bin k a l r) ts) = Just (k, a, consT w2 l (consT w2 r ts)) where w2 = div w 2
{-# INLINE uncons #-}
--- | /O(1)/
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path', slightly faster than 'uncons'.
view :: Path a -> View Path a
view Nil = Root
view (Cons _ _ (Tip k a) ts) = Node k a ts
view (Cons _ w (Bin k a l r) ts) = Node k a (consT w2 l (consT w2 r ts)) where w2 = div w 2
{-# INLINE view #-}
--- | /O(log (h - k))/ to @keep k@ elements of path of height @h@
+-- | /O(log (h - k))/ to @'keep' k@ elements of 'Path' of 'length' @h@
keep :: Int -> Path a -> Path a
keep = go where
go _ Nil = Nil
@@ -164,12 +173,12 @@ keep = go where
goT _ _ _ ts = ts
{-# INLINE keep #-}
--- | /O(log k)/ to @drop k@ elements from a path
+-- | /O(log k)/ to @'drop' k@ elements from a 'Path'
drop :: Int -> Path a -> Path a
drop k xs = keep (length xs - k) xs
{-# INLINE drop #-}
--- | /O(log h)/ @xs `isAncestorOf` ys@ holds when @xs@ is a prefix starting at the root of path @ys@.
+-- | /O(log h)/ @xs `isAncestorOf` ys@ holds when @xs@ is a prefix starting at the root of 'Path' @ys@.
isAncestorOf :: Path a -> Path b -> Bool
isAncestorOf xs ys = xs ~= keep (length xs) ys
{-# INLINE isAncestorOf #-}
@@ -182,7 +191,7 @@ Cons _ _ s _ ~= Cons _ _ t _ = sameT s t
_ ~= _ = False
{-# INLINE (~=) #-}
--- | /O(log h)/ Compute the lowest common ancestor
+-- | /O(log h)/ Compute the lowest common ancestor of two paths.
lca :: Path a -> Path b -> Path a
lca xs0 ys0 = case compare nxs nys of
LT -> go xs0 (keep nxs ys0)
44 src/Data/LCA/Online/Monoidal.hs
View
@@ -46,6 +46,7 @@ infixl 6 <>
{-# INLINE (<>) #-}
-- | Complete binary trees
+--
-- NB: we could ensure the complete tree invariant
data Tree a
= Bin a {-# UNPACK #-} !Int a (Tree a) (Tree a)
@@ -68,7 +69,7 @@ sameT xs ys = root xs == root ys where
root (Tip k _) = k
root (Bin _ k _ _ _) = k
--- | Compressed paths using skew binary random access lists
+-- | A compressed 'Path' as a skew binary random access list
data Path a
= Nil
| Cons a
@@ -82,6 +83,7 @@ instance Foldable Path where
foldMap _ Nil = mempty
foldMap f (Cons _ _ _ t ts) = foldMap f t <> foldMap f ts
+-- | Extract a monoidal summary of a 'Path'.
measure :: Monoid a => Path a -> a
measure Nil = mempty
measure (Cons a _ _ _ _) = a
@@ -92,7 +94,8 @@ consT w t ts = Cons (measureT t <> measure ts) (w + length ts) w t ts
consN :: Monoid a => Int -> Int -> Tree a -> Path a -> Path a
consN n w t ts = Cons (measureT t <> measure ts) n w t ts
-map :: (Monoid a, Monoid b) => (a -> b) -> Path a -> Path b
+-- | /O(n)/ Re-annotate a 'Path' full of monoidal values using a different 'Monoid'.
+map :: Monoid b => (a -> b) -> Path a -> Path b
map f = go where
go Nil = Nil
go (Cons _ n k t ts) = consN n k (goT t) (go ts)
@@ -100,7 +103,8 @@ map f = go where
goT (Bin _ k a l r) = bin k (f a) (goT l) (goT r)
{-# INLINE map #-}
-mapWithKey :: (Monoid a, Monoid b) => (Int -> a -> b) -> Path a -> Path b
+-- | /O(n)/ Re-annotate a 'Path' full of monoidal values with access to the key.
+mapWithKey :: Monoid b => (Int -> a -> b) -> Path a -> Path b
mapWithKey f = go where
go Nil = Nil
go (Cons _ n k t ts) = consN n k (goT t) (go ts)
@@ -108,10 +112,14 @@ mapWithKey f = go where
goT (Bin _ k a l r) = bin k (f k a) (goT l) (goT r)
{-# INLINE mapWithKey #-}
--- | @mapHom f@ assumes that f is a monoid homomorphism, that is to say, you must ensure
+-- | /O(n)/ Re-annotate a 'Path' full of monoidal values/
+--
+-- Unlike 'map', @'mapHom' f@ assumes that f is a 'Monoid' homomorphism, that is to say you must ensure
--
--- > f a `mappend` f b = f (a `mappend` b)
--- > f mempty = mempty
+-- @
+-- f a `'mappend'` f b = f (a `'mappend'` b)
+-- f 'mempty' = 'mempty'
+-- @
mapHom :: (a -> b) -> Path a -> Path b
mapHom f = go where
go Nil = Nil
@@ -120,16 +128,19 @@ mapHom f = go where
goT (Bin m k a l r) = Bin (f m) k (f a) (goT l) (goT r)
{-# INLINE mapHom #-}
+-- | Convert a 'Path' to a list of @(ID, value)@ pairs.
toList :: Path a -> [(Int,a)]
toList Nil = []
toList (Cons _ _ _ t ts) = go t (toList ts) where
go (Tip k a) xs = (k,a) : xs
go (Bin _ k a l r) xs = (k,a) : go l (go r xs)
+-- | Build a 'Path' from a list of @(ID, value)@ pairs.
fromList :: Monoid a => [(Int,a)] -> Path a
fromList [] = Nil
fromList ((k,a):xs) = cons k a (fromList xs)
+-- | Traverse a 'Path' with access to the node IDs.
traverseWithKey :: (Applicative f, Monoid b) => (Int -> a -> f b) -> Path a -> f (Path b)
traverseWithKey f = go where
go Nil = pure Nil
@@ -138,6 +149,7 @@ traverseWithKey f = go where
goT (Bin _ k a l r) = bin k <$> f k a <*> goT l <*> goT r
{-# INLINE traverseWithKey #-}
+-- | Traverse a 'Path' yielding a new monoidal annotation.
traverse :: (Applicative f, Monoid b) => (a -> f b) -> Path a -> f (Path b)
traverse f = go where
go Nil = pure Nil
@@ -146,42 +158,46 @@ traverse f = go where
goT (Bin _ k a l r) = bin k <$> f a <*> goT l <*> goT r
{-# INLINE traverse #-}
--- | The empty path
+-- | The empty 'Path'
empty :: Path a
empty = Nil
{-# INLINE empty #-}
--- | /O(1)/
+-- | /O(1)/ Determine the 'length' of a 'Path'.
length :: Path a -> Int
length Nil = 0
length (Cons _ n _ _ _) = n
{-# INLINE length #-}
--- | /O(1)/
+-- | /O(1)/ Returns 'True' iff the path is 'empty'.
null :: Path a -> Bool
null Nil = True
null _ = False
{-# INLINE null #-}
-- | /O(1)/ Invariant: most operations assume that the keys @k@ are globally unique
+--
+-- Extend the 'Path' with a new node ID and value.
cons :: Monoid a => Int -> a -> Path a -> Path a
cons k a (Cons m n w t (Cons _ _ w' t2 ts)) | w == w' = Cons (a <> m) (n + 1) (2 * w + 1) (bin k a t t2) ts
cons k a ts = Cons (a <> measure ts) (length ts + 1) 1 (Tip k a) ts
{-# INLINE cons #-}
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path'.
uncons :: Monoid a => Path a -> Maybe (Int, a, Path a)
uncons Nil = Nothing
uncons (Cons _ _ _ (Tip k a) ts) = Just (k, a, ts)
uncons (Cons _ _ w (Bin _ k a l r) ts) = Just (k, a, consT w2 l (consT w2 r ts)) where w2 = div w 2
{-# INLINE uncons #-}
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path', slightly faster than 'uncons'.
view :: Monoid a => Path a -> View Path a
view Nil = Root
view (Cons _ _ _ (Tip k a) ts) = Node k a ts
view (Cons _ _ w (Bin _ k a l r) ts) = Node k a (consT w2 l (consT w2 r ts)) where w2 = div w 2
{-# INLINE view #-}
--- | /O(log (h - k))/ to @keep k@ elements of path of height @h@, and provide a monoidal summary of the dropped elements
+-- | /O(log (h - k))/ to keep @k@ elements of 'Path' of 'length' @h@, and provide a monoidal summary of the dropped elements
mkeep :: Monoid a => Int -> Path a -> (a, Path a)
mkeep = go mempty where
go as _ Nil = (as, Nil)
@@ -201,22 +217,22 @@ mkeep = go mempty where
goT as _ _ _ ts = (as, ts)
{-# INLINE mkeep #-}
--- | /O(log (h - k))/ to @keep k@ elements of path of height @h@
+-- | /O(log (h - k))/ to @'keep' k@ elements of 'Path' of 'length' @h@
keep :: Monoid a => Int -> Path a -> Path a
keep k xs = snd (mkeep k xs)
{-# INLINE keep #-}
--- | /O(log k)/ to @drop k@ elements from a path
+-- | /O(log k)/ to @'drop' k@ elements from a 'Path'
drop :: Monoid a => Int -> Path a -> Path a
drop k xs = snd (mdrop k xs)
{-# INLINE drop #-}
--- | /O(log k)/ to @drop k@ elements from a path and provide a monoidal summary of the dropped elements
+-- | /O(log k)/ to drop @k@ elements from a 'Path' and provide a monoidal summary of the dropped elements
mdrop :: Monoid a => Int -> Path a -> (a, Path a)
mdrop k xs = mkeep (length xs - k) xs
{-# INLINE mdrop #-}
--- /O(log h)/ @xs `isAncestorOf` ys@ holds when @xs@ is a prefix starting at the root of path @ys@.
+-- | /O(log h)/ @xs `'isAncestorOf'` ys@ holds when @xs@ is a prefix starting at the root of path @ys@.
isAncestorOf :: Monoid b => Path a -> Path b -> Bool
isAncestorOf xs ys = xs ~= keep (length xs) ys
22 src/Data/LCA/Online/Naive.hs
View
@@ -35,13 +35,16 @@ import Prelude hiding (length, null, drop)
import qualified Prelude
import Data.LCA.View
+-- | An uncompressed 'Path' with memoized length.
data Path a = Path {-# UNPACK #-} !Int [(Int,a)]
deriving (Show, Read)
+-- | Convert a 'Path' to a list of @(ID, value)@ pairs.
toList :: Path a -> [(Int,a)]
toList (Path _ xs) = xs
{-# INLINE toList #-}
+-- | Build a 'Path' from a list of @(ID, value)@ pairs.
fromList :: [(Int,a)] -> Path a
fromList xs = Path (Prelude.length xs) xs
{-# INLINE fromList #-}
@@ -55,54 +58,59 @@ instance Foldable Path where
instance Traversable Path where
traverse f (Path n xs) = Path n <$> traverse (\(k,a) -> (,) k <$> f a) xs
+-- | Traverse a 'Path' with access to the node IDs.
traverseWithKey :: Applicative f => (Int -> a -> f b) -> Path a -> f (Path b)
traverseWithKey f (Path n xs) = Path n <$> traverse (\(k,a) -> (,) k <$> f k a) xs
{-# INLINE traverseWithKey #-}
--- | The empty path
+-- | The empty 'Path'
empty :: Path a
empty = Path 0 []
--- | /O(1)/
+-- | /O(1)/ Determine the length of a 'Path'.
length :: Path a -> Int
length (Path n _) = n
{-# INLINE length #-}
--- | /O(1)/
+-- | /O(1)/ Returns 'True' iff the 'Path' is 'empty'.
null :: Path a -> Bool
null (Path n _) = n == 0
{-# INLINE null #-}
-- | /O(1)/ Invariant: most operations assume that the keys @k@ are globally unique
+--
+-- Extend the path with a new node ID and value.
cons :: Int -> a -> Path a -> Path a
cons k a (Path n xs) = Path (n + 1) $ (k,a):xs
{-# INLINE cons #-}
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path'.
uncons :: Path a -> Maybe (Int, a, Path a)
uncons (Path _ []) = Nothing
uncons (Path n ((k,a):xs)) = Just (k,a,Path (n - 1) xs)
{-# INLINE uncons #-}
+-- | /O(1)/ Extract the node ID and value from the newest node on the 'Path', slightly faster than 'uncons'.
view :: Path a -> View Path a
view (Path _ []) = Root
view (Path n ((k,a):xs)) = Node k a (Path (n - 1) xs)
{-# INLINE view #-}
--- | /O(h - k)/ to @keep k@ elements of path of height @h@
+-- | /O(h - k)/ to @'keep' k@ elements of 'Path' of 'length' @h@
keep :: Int -> Path a -> Path a
keep k p@(Path n xs)
| k >= n = p
| otherwise = Path k $ Prelude.drop (n - k) xs
{-# INLINE keep #-}
--- | /O(k)/ to @drop k@ elements from a path
+-- | /O(k)/ to @'drop' k@ elements from a 'Path'
drop :: Int -> Path a -> Path a
drop k (Path n xs)
| k >= n = empty
| otherwise = Path (n - k) (Prelude.drop k xs)
{-# INLINE drop #-}
--- /O(h)/ @xs `isAncestorOf` ys@ holds when @xs@ is a prefix starting at the root of path @ys@.
+-- | /O(h)/ @xs `isAncestorOf` ys@ holds when @xs@ is a prefix starting at the root of 'Path' @ys@.
isAncestorOf :: Path a -> Path b -> Bool
isAncestorOf xs ys = xs ~= keep (length xs) ys
{-# INLINE isAncestorOf #-}
@@ -115,7 +123,7 @@ Path _ ((i,_):_) ~= Path _ ((j,_):_) = i == j
_ ~= _ = False
{-# INLINE (~=) #-}
--- | /O(h)/ Compute the lowest common ancestor
+-- | /O(h)/ Compute the lowest common ancestor of two paths
lca :: Path a -> Path b -> Path a
lca xs0 ys0 = case compare nxs nys of
LT -> go nxs (toList xs0) (toList (keep nxs ys0))
11 src/Data/LCA/View.hs
View
@@ -1,3 +1,13 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.LCA.View
+-- Copyright : (C) 2012 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- Stability : provisional
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
module Data.LCA.View (View(..)) where
import Control.Applicative
@@ -5,6 +15,7 @@ import Data.Foldable
import Data.Traversable
import Data.Monoid
+-- | Provides a consistent 'View' for peeling off the bottom node of a path.
data View f a
= Root
| Node {-# UNPACK #-} !Int a (f a)
Please sign in to comment.
Something went wrong with that request. Please try again.