diff --git a/Data/SequentialIndex.hs b/Data/SequentialIndex.hs --- a/Data/SequentialIndex.hs +++ b/Data/SequentialIndex.hs @@ -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 diff --git a/Data/SequentialIndex/Open.hs b/Data/SequentialIndex/Open.hs --- a/Data/SequentialIndex/Open.hs +++ b/Data/SequentialIndex/Open.hs @@ -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 diff --git a/Test/SequentialIndex.hs b/Test/SequentialIndex.hs --- a/Test/SequentialIndex.hs +++ b/Test/SequentialIndex.hs @@ -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) diff --git a/sequential-index.cabal b/sequential-index.cabal --- a/sequential-index.cabal +++ b/sequential-index.cabal @@ -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.