sequential-index 0.1 → 0.2

raw patch · 4 files changed

+98/−13 lines, 4 files

Files

• Data/SequentialIndex.hs +58/−9
• Data/SequentialIndex/Open.hs +11/−2
• Test/SequentialIndex.hs +27/−0
• sequential-index.cabal +2/−2

@@ -1,20 +1,28 @@ module Data.SequentialIndex (+-- * Type   SequentialIndex+-- * Extractors , mantissa , exponent+-- * Constructors , zero , one , root , sequentialIndex , unsafeSequentialIndex , tryFromBools+-- * Operations+-- ** Arithmetical operations , between , prefixBits+-- ** Tree operations , build , buildBits , leftChild , rightChild+, parent+-- * Conversion , toByteString , fromByteString )@@ -24,23 +32,39 @@ import           Prelude         hiding (exponent) import qualified Data.ByteString as B --- must always be in normalised form!+-- | An arbitrary-precision number between 0.0 and 1.0. To create new numbers,+-- use 'between'.+-- +-- Each number consist of a 'mantissa' (>= 0) and an 'exponent' (> 0), so that+-- its numeric value equals @mantissa x * 2 ^ (1 - exponent x)@. The constraint+-- that it must lie between 0.0 and 1.0 is enforced in the constructors.+-- +-- It is possible to span a hypothetical tree in this number scheme. Discarding+-- the last binary digit of the mantissa, which has to be a 1, each digit of+-- the mantissa denotes a branch in this hypothetical binary tree. So a whole+-- 'SequentialIndex' (if it ends with 1) corresponds with a path in a binary+-- tree. data SequentialIndex -    = SI !Integer !Int+    = SI !Integer !Int -- must always be in normalised form!     deriving (Eq) +-- | Extracts the mantissa. mantissa :: SequentialIndex -> Integer mantissa (SI m _) = m +-- | Extracts the exponent. exponent :: SequentialIndex -> Int exponent (SI _ e) = e +-- | The lowest possible number: 0.0. zero :: SequentialIndex zero = SI 0 1 +-- | The highest possible number: 1.0. one :: SequentialIndex one = SI 1 1 +-- | The root of a hypothetical binary tree. root :: SequentialIndex root = between zero one @@ -50,6 +74,9 @@           m1' = m1 `shift` (e - e1)           m2' = m2 `shift` (e - e2) +-- | Construct a 'SequentialIndex' from its 'mantissa' and 'exponent'.+-- +-- Errors are checked and result in a run-time error. sequentialIndex :: Integer -> Int -> SequentialIndex sequentialIndex 0 _ = zero sequentialIndex mx ex@@ -58,6 +85,9 @@           | v > one   -> error "Invalid SequentialIndex: beyond one"           | otherwise -> v +-- | Construct a 'SequentialIndex' from its 'mantissa' and 'exponent'.+-- +-- Errors are checked and result in 'Nothing'. trySequentialIndex :: Integer -> Int -> Maybe SequentialIndex trySequentialIndex 0 _ = Just zero trySequentialIndex mx ex@@ -66,38 +96,56 @@           | v > one   -> Nothing           | otherwise -> Just v +-- | Construct a 'SequentialIndex' from its 'mantissa' and 'exponent'.+-- +-- Errors are not checked. unsafeSequentialIndex :: Integer -> Int -> SequentialIndex unsafeSequentialIndex mx ex      = until (\(SI m _) -> m `testBit` 0)              (\(SI m e) -> SI (m `shiftR` 1) (e - 1))              (SI mx ex) +-- | Construct a 'SequentialIndex' from a list of boolean digits. The exponent+-- equals the number of digits. tryFromBools :: [Bool] -> Maybe SequentialIndex tryFromBools = uncurry trySequentialIndex . foldr (\x (s, n) -> ((s `shiftL` 1) .|. (if x then 1 else 0), n + 1)) (0, 0) +-- | Compute a number right in the middle of the arguments.+-- +-- @(x + y) / 2@ between :: SequentialIndex -> SequentialIndex -> SequentialIndex between a b = sequentialIndex (m1 + m2) (e + 1)     where (m1, m2, e) = commonBase a b +-- | Add digits in front of the mantissa. prefixBits :: Int -> Integer -> SequentialIndex -> SequentialIndex prefixBits _ _   (SI 0 1) = error "No meaningful prefix for 'zero' possible" prefixBits eb mb (SI m e) = sequentialIndex ((mb `shiftL` e) + m) (eb + e + 1) +-- | Build a number from a list of fixed-width mantissa segments. build :: Int -> [Integer] -> SequentialIndex build nbits xs = foldr (prefixBits nbits) one xs +-- | Build a number from a list of fixed-width mantissa segments. buildBits :: (Bits a, Integral a) => [a] -> SequentialIndex buildBits xs = build (bitSize $ head xs) (map toInteger xs) -leftChild :: SequentialIndex -> SequentialIndex-leftChild (SI 0 1) = error "'zero' has no left child"-leftChild (SI m e) = SI ((m `shiftR` 1) `shiftL` 2 .|. 1) (e + 1)+-- | Get the left child of the current path in the hypothetical tree.+leftChild :: SequentialIndex -> Maybe SequentialIndex+leftChild (SI 0 1) = Nothing+leftChild (SI m e) = Just $ SI ((m `shiftR` 1) `shiftL` 2 .|. 1) (e + 1) -rightChild :: SequentialIndex -> SequentialIndex-rightChild (SI 0 1) = error "'zero' has no real right child"-rightChild (SI 1 1) = error "'one' has no right child"-rightChild (SI m e) = SI ((m `shiftR` 1) `shiftL` 2 .|. 3) (e + 1)+-- | Get the right child of the current path in the hypothetical tree.+rightChild :: SequentialIndex -> Maybe SequentialIndex+rightChild (SI _ 1) = Nothing+rightChild (SI m e) = Just $ SI ((m `shiftR` 1) `shiftL` 2 .|. 3) (e + 1) +-- | Get the parent of the current path in the hypothetical tree.+parent :: SequentialIndex -> Maybe SequentialIndex+parent (SI _ 1) = Nothing+parent (SI m e) = Just $ SI ((m `shiftR` 2) `shiftL` 1 .|. 1) (e - 1)++-- | Convert a 'SequentialIndex' to a binary representation. toByteString :: SequentialIndex -> B.ByteString toByteString (SI m e) = B.unfoldr step (m', e')     where e' = ((e + 7) `div` 8) * 8@@ -107,6 +155,7 @@           step (v, ex) = let (q, r) = v `divMod` 256                          in Just (fromInteger r, (q, ex - 8)) +-- | Convert a 'SequentialIndex' from its binary representation. fromByteString :: B.ByteString -> Maybe SequentialIndex fromByteString bs | B.null bs = Just zero                   | otherwise = trySequentialIndex m e

@@ -4,11 +4,13 @@ , mantissa , exponent , sequentialIndex+, tryFromBools , toClosed , fromClosed , root , leftChild , rightChild+, parent , prefixBits , toByteString , fromByteString@@ -17,6 +19,7 @@  import           Control.Monad import           Data.Bits+import           Data.Maybe import           Prelude              hiding (exponent) import qualified Data.ByteString      as B import qualified Data.SequentialIndex as Closed@@ -33,6 +36,9 @@ sequentialIndex ::  Int -> Integer -> SequentialIndex sequentialIndex eb me = OSI $ Closed.prefixBits eb me Closed.one +tryFromBools :: [Bool] -> Maybe SequentialIndex+tryFromBools = fromClosed <=< Closed.tryFromBools+ toClosed :: SequentialIndex -> Closed.SequentialIndex toClosed (OSI si) = si @@ -46,10 +52,13 @@ root = OSI Closed.root  leftChild :: SequentialIndex -> SequentialIndex-leftChild = OSI . Closed.leftChild . toClosed+leftChild = OSI . fromJust . Closed.leftChild . toClosed  rightChild :: SequentialIndex -> SequentialIndex-rightChild = OSI . Closed.rightChild . toClosed+rightChild = OSI . fromJust . Closed.rightChild . toClosed++parent :: SequentialIndex -> Maybe SequentialIndex+parent = fmap OSI . Closed.parent . toClosed  prefixBits :: Int -> Integer -> SequentialIndex -> SequentialIndex prefixBits eb mb = OSI . Closed.prefixBits eb mb . toClosed

@@ -13,6 +13,33 @@  prop_sequentialIndexFromToByteString si = Just si == fromByteString (toByteString si)  +prop_between a b = let m = between a b in (a == m && m == b) || (a < m && m < b) || (b < m && m < a)++prop_leftChild x = case leftChild x of+                     Nothing -> True+                     Just v -> v < x++prop_leftChildZero = leftChild zero == Nothing+prop_leftChildOne = leftChild one == Just root+prop_leftChildRoot = isJust $ leftChild root++prop_rightChild x = case rightChild x of+                    Nothing -> True+                    Just v -> v > x++prop_rightChildZero = rightChild zero == Nothing+prop_rightChildOne = rightChild one == Nothing+prop_rightChildRoot = isJust $ rightChild root++prop_parentLeft x = maybe True (== x) $ parent =<< leftChild x+prop_parentRight x = maybe True (== x) $ parent =<< rightChild x++prop_parentZero = parent zero == Nothing+prop_parentOne = parent one == Nothing+prop_parentRoot = parent root == Just one+prop_parentRootLeft = (parent =<< leftChild root) == Just root+prop_parentRootRight = (parent =<< rightChild root) == Just root+ main = $(quickCheckAll)  testWith = $(forAllProperties)

@@ -7,10 +7,10 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1+Version:             0.2  -- A short (one-line) description of the package.-Synopsis:            Sequential index numbers between 0.0 and 1.0 that allow arbitrarily inserting new numbers in between (for special containers).+Synopsis:            Sequential numbers that allow arbitrarily inserting numbers - for containers  -- A longer description of the package. Description:         Sequential index numbers between 0.0 and 1.0 that allow arbitrarily inserting new numbers in between. They can possibly used for disk-based and other special containers, where adding a new element without changing the indexes of the other elements is important.