sequential-index 0.0 → 0.1
raw patch · 5 files changed
+177/−31 lines, 5 files
Files
- Data/SequentialIndex.hs +72/−26
- Data/SequentialIndex/Open.hs +66/−0
- README +15/−1
- Test/SequentialIndex.hs +18/−0
- sequential-index.cabal +6/−4
Data/SequentialIndex.hs view
@@ -5,8 +5,16 @@ , exponent , zero , one+, root , sequentialIndex+, unsafeSequentialIndex+, tryFromBools , between+, prefixBits+, build+, buildBits+, leftChild+, rightChild , toByteString , fromByteString )@@ -28,11 +36,14 @@ exponent (SI _ e) = e zero :: SequentialIndex-zero = SI 0 0+zero = SI 0 1 one :: SequentialIndex-one = SI 1 0+one = SI 1 1 +root :: SequentialIndex+root = between zero one+ commonBase :: SequentialIndex -> SequentialIndex -> (Integer, Integer, Int) commonBase (SI m1 e1) (SI m2 e2) = (m1', m2', e) where e = max e1 e2@@ -42,14 +53,67 @@ sequentialIndex :: Integer -> Int -> SequentialIndex sequentialIndex 0 _ = zero sequentialIndex mx ex- = case () of- _ | v < zero -> error "Invalid SequentialIndex: below zero"+ = case unsafeSequentialIndex mx ex of+ v | v < zero -> error "Invalid SequentialIndex: below zero" | v > one -> error "Invalid SequentialIndex: beyond one" | otherwise -> v- where v = until (\(SI m _) -> m `testBit` 0) - (\(SI m e) -> SI (m `shiftR` 1) (e - 1)) - (SI mx ex) +trySequentialIndex :: Integer -> Int -> Maybe SequentialIndex+trySequentialIndex 0 _ = Just zero+trySequentialIndex mx ex+ = case unsafeSequentialIndex mx ex of+ v | v < zero -> Nothing+ | v > one -> Nothing+ | otherwise -> Just v++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)++tryFromBools :: [Bool] -> Maybe SequentialIndex+tryFromBools = uncurry trySequentialIndex . foldr (\x (s, n) -> ((s `shiftL` 1) .|. (if x then 1 else 0), n + 1)) (0, 0)++between :: SequentialIndex -> SequentialIndex -> SequentialIndex+between a b = sequentialIndex (m1 + m2) (e + 1)+ where (m1, m2, e) = commonBase a b++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 :: Int -> [Integer] -> SequentialIndex+build nbits xs = foldr (prefixBits nbits) one xs++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)++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)++toByteString :: SequentialIndex -> B.ByteString+toByteString (SI m e) = B.unfoldr step (m', e')+ where e' = ((e + 7) `div` 8) * 8+ m' = m `shift` (e' - e)++ step (_, 0) = Nothing+ step (v, ex) = let (q, r) = v `divMod` 256+ in Just (fromInteger r, (q, ex - 8))++fromByteString :: B.ByteString -> Maybe SequentialIndex+fromByteString bs | B.null bs = Just zero+ | otherwise = trySequentialIndex m e+ where (m, e) = B.foldr step (0, 0) bs+ step w (mx, ex) = (mx `shiftL` 8 + toInteger w, ex + 8)++ instance Bounded SequentialIndex where minBound = zero maxBound = one@@ -63,25 +127,7 @@ [] -> "0.0" [d1] -> d1 : ".0" (d1:ds) -> d1 : '.' : ds- where bits = map (testBit m) [e, e - 1 .. 0]+ where bits = map (testBit m) [e - 1, e - 2 .. 0] sbit False = '0' sbit True = '1'--between :: SequentialIndex -> SequentialIndex -> SequentialIndex-between a b = sequentialIndex (m1 + m2) (e + 1)- where (m1, m2, e) = commonBase a b--toByteString :: SequentialIndex -> B.ByteString-toByteString (SI m e) = B.unfoldr step m'- where e' = (e `div` 8) * 8 + 7- m' = m `shift` (e' - e)-- step 0 = Nothing- step v = let (q, r) = v `divMod` 256- in Just (fromInteger r, q)--fromByteString :: B.ByteString -> SequentialIndex-fromByteString bs = sequentialIndex m (max 0 $ e - 1)- where (m, e) = B.foldr step (0, 0) bs- step w (mx, ex) = (mx `shiftL` 8 + toInteger w, ex + 8)
+ Data/SequentialIndex/Open.hs view
@@ -0,0 +1,66 @@+module Data.SequentialIndex.Open+(+ SequentialIndex+, mantissa+, exponent+, sequentialIndex+, toClosed+, fromClosed+, root+, leftChild+, rightChild+, prefixBits+, toByteString+, fromByteString+)+where++import Control.Monad+import Data.Bits+import Prelude hiding (exponent)+import qualified Data.ByteString as B+import qualified Data.SequentialIndex as Closed++newtype SequentialIndex = OSI Closed.SequentialIndex+ deriving (Eq, Ord)++mantissa :: SequentialIndex -> Integer+mantissa = Closed.mantissa . toClosed++exponent :: SequentialIndex -> Int+exponent = Closed.exponent . toClosed++sequentialIndex :: Int -> Integer -> SequentialIndex+sequentialIndex eb me = OSI $ Closed.prefixBits eb me Closed.one++toClosed :: SequentialIndex -> Closed.SequentialIndex+toClosed (OSI si) = si++fromClosed :: Closed.SequentialIndex -> Maybe SequentialIndex+fromClosed si = case () of+ _ | si == Closed.zero -> Nothing+ | si == Closed.one -> Nothing+ | otherwise -> Just $ OSI si++root :: SequentialIndex+root = OSI Closed.root++leftChild :: SequentialIndex -> SequentialIndex+leftChild = OSI . Closed.leftChild . toClosed++rightChild :: SequentialIndex -> SequentialIndex+rightChild = OSI . Closed.rightChild . toClosed++prefixBits :: Int -> Integer -> SequentialIndex -> SequentialIndex+prefixBits eb mb = OSI . Closed.prefixBits eb mb . toClosed++toByteString :: SequentialIndex -> B.ByteString+toByteString = Closed.toByteString . toClosed++fromByteString :: B.ByteString -> Maybe SequentialIndex+fromByteString = fromClosed <=< Closed.fromByteString++instance Show SequentialIndex where+ show si = '*' : map (\i -> if testBit m i then 'R' else 'L') [e - 2, e - 3 .. 1]+ where m = mantissa si+ e = exponent si
README view
@@ -1,4 +1,18 @@ 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. -Conceptually, SequentialIndex denotes a path to an element in an imaginary binary tree.+Conceptually, SequentialIndex denotes a path to an element in an imaginary binary tree, with a '1' at the end. Except for 0.0 and 1.0, which are logically on the left or on the right of the entire tree. +So logically, the tree looks roughly like this:++0.0 1.0+ /+ /----------/+ 0.1+ / \+ /--/ \--\+ / \+ 0.01 0.11+ / \ / \+ 0.001 0.011 ...++Note that 0.0 is not connected to any other node, but it is still logically smaller than all nodes.
+ Test/SequentialIndex.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++module Test.SequentialIndex+where++import Data.Maybe+import Data.SequentialIndex+import Test.QuickCheck+import Test.QuickCheck.All+ +instance Arbitrary SequentialIndex where+ arbitrary = fmap fromJust (fmap tryFromBools arbitrary `suchThat` isJust)++prop_sequentialIndexFromToByteString si = Just si == fromByteString (toByteString si) ++main = $(quickCheckAll)++testWith = $(forAllProperties)
sequential-index.cabal view
@@ -7,7 +7,7 @@ -- 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.0+Version: 0.1 -- 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).@@ -15,7 +15,7 @@ -- 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. - Conceptually, SequentialIndex denotes a path to an element in an imaginary binary tree.+ Conceptually, SequentialIndex denotes a path to an element in an imaginary binary tree. However, leafs can only be on the right side of their parent. I.e. the path must end with a '1' (or be the path to the root node, 0.0). 1.0 denotes the invalid node. -- The license under which the package is released. License: BSD3@@ -41,7 +41,8 @@ -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README+Extra-source-files: README,+ Test/SequentialIndex.hs -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.2@@ -49,7 +50,8 @@ Library -- Modules exported by the library.- Exposed-modules: Data.SequentialIndex+ Exposed-modules: Data.SequentialIndex,+ Data.SequentialIndex.Open -- GHC Options. GHC-Options: -Wall