Last active

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

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)).

View LazyLength.hs
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.