public
Last active

The Lazy Length monoid allows you to compare two lists by length without calculating the full length of both lists (unless they are of equal length). Though `lazyLength :: [a] -> LazyLength` is O(n), two `LazyLength` values for lists of length n and m may be compared in time O(min(log n, log m)).

  • Download Gist
LazyLength.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
{-# LANGUAGE BangPatterns #-}
module LazyLength (
LazyLength(),
fromLazyLength,
toLazyLength,
lazyLength,
-- QuickCheck properties
prop_invariant,
prop_invertible,
prop_addition,
prop_ordered,
prop_bounded,
prop_accurate
) where
 
import Data.Function (fix)
import Data.List
import Data.Monoid
import Test.QuickCheck
 
-- Lazy representation of a length. Stores the largest non-zero bit
-- position as a unary number, then the rest of the bits at the tail
-- of the unary number.
--
-- This allows lengths N and M to be compared in O(min(log(N),log(M)))
-- steps, and, in particular, only one must be fully evaluated.
--
-- We'll use smart constructors rather than expose the
-- default constructors to maintain an invariant: a LazyLength
-- made of `b` `Bit`s and `Rem n` has `0 <= n < 2^b`.
data LazyLength = Rem !Integer | Bit LazyLength deriving (Eq, Ord, Show)
 
-- NOTE: derived `Ord` instance has a `compare` which takes O(min(log n, log m))
 
instance Bounded LazyLength where
minBound = Rem 0
maxBound = fix Bit
 
-- Convert the given non-negative value to LazyLength, O(n).
toLazyLength :: Integral a => a -> LazyLength
toLazyLength n | n < 0 = error "can't have a negative length"
| otherwise = toLazyLength' n 0 1
where toLazyLength' n lo !hi = if n < hi
then Rem . fromIntegral $ n - lo
else Bit $ toLazyLength' n hi (2*hi)
 
-- Convert the given LazyLength to a number n, O(log n).
fromLazyLength :: Integral a => LazyLength -> a
fromLazyLength (Rem _) = 0
fromLazyLength (Bit x) = fromLazyLength' 0 x
where fromLazyLength' !b (Rem n) = fromInteger $ 2^b + n
fromLazyLength' !b (Bit x) = fromLazyLength' (b+1) x
instance Monoid LazyLength where
mempty = minBound
-- mappend just does addition on the represented naturals
mappend (Bit x) (Bit y) = Bit $ mappend' 0 x y
where -- (2^{b + i} + n) + (2^{b + j} + m) > 2^b
mappend' !b (Bit x) (Bit y) = Bit $ mappend' (b+1) x y
-- (2^b + n) + (2^b + m) = 2^{b+1} + (n+m)
-- 0 <= n < 2^b
-- 0 <= m < 2^b
-- =>
-- 0 <= n+m < 2^{b+1}
mappend' !b (Rem n) (Rem m) = Bit . Rem $ n + m
mappend' !b (Rem n) (Bit y) = Bit $ cleanup (2^b + n) (b+1) y
mappend' !b (Bit x) (Rem m) = Bit $ cleanup (2^b + m) (b+1) x
cleanup n !b (Bit y) = Bit $ cleanup n (b+1) y
-- 0 <= n < 2^b
-- 0 <= m < 2^b
-- => either
-- 0 <= n + m < 2^b
-- 2^b <= n + m < 2^{b+1} => 0 <= n + m - 2^b < 2^b
-- => either
-- n + (2^b + m) = 2^b + (n+m)
-- n + (2^b + m) = 2^{b+1} + (n+m-2^n)
cleanup n !b (Rem m) = let p = 2^b
q = n + m
in if q >= p
then Bit . Rem $ q - p
else Rem q
mappend _ _ = mempty
 
-- compute the length of a list, O(n).
lazyLength :: [a] -> LazyLength
lazyLength [] = minBound
lazyLength (_:as) = Bit $ lazyLength' 1 as
where lazyLength' !n as = case genericSplitAt (n-1) as of
(rs,[]) -> Rem $ genericLength rs
(_,_:qs) -> Bit $ lazyLength' (2*n) qs
 
-- make sure we can test the invariant w/ QuickCheck
instance Arbitrary LazyLength where
arbitrary = fmap (toLazyLength . abs) (arbitrary :: Gen Integer)
 
instance CoArbitrary LazyLength where
coarbitrary = variant . fromLazyLength
 
-- it's in canonical form
prop_invariant :: LazyLength -> Bool
prop_invariant = invariant' 0
where invariant' !b (Rem n) = 0 <= n && n < 2^b
invariant' !b (Bit x) = invariant' (b+1) x
 
-- there's a bijection between LazyLength and the naturals
prop_invertible :: LazyLength -> Bool
prop_invertible x = toLazyLength (fromLazyLength x) == x
 
-- mempty is the identity for mappend
prop_zero :: LazyLength -> Bool
prop_zero x = x `mappend` mempty == x
 
-- mappend works like addition over the naturals
prop_addition :: LazyLength -> LazyLength -> Bool
prop_addition x y = x `mappend` y == toLazyLength (fromLazyLength x + fromLazyLength y)
 
-- order is preserved
prop_ordered :: LazyLength -> LazyLength -> Bool
prop_ordered x y = compare x y == compare (fromLazyLength x) (fromLazyLength y)
 
-- stays inside the given bounds
prop_bounded :: LazyLength -> Bool
prop_bounded x = minBound <= x && x < maxBound
 
-- lazyLength accurately calculates list length
prop_accurate :: [()] -> Bool
prop_accurate as = toLazyLength (length as) == lazyLength as

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.