diff --git a/Data/BinaryList.hs b/Data/BinaryList.hs --- a/Data/BinaryList.hs +++ b/Data/BinaryList.hs @@ -29,6 +29,8 @@ , lookup , head , last + , minimum + , maximum -- * Decontruction , split , fold @@ -46,21 +48,14 @@ , toList ) where -import Prelude hiding (length,lookup,replicate,head,last,zip,unzip,zipWith,reverse) +import Prelude hiding ( length,lookup,replicate,head,last,zip,unzip,zipWith,reverse + , minimum, maximum + ) import qualified Prelude import Foreign.Storable (sizeOf) import Data.List (find) +import Data.BinaryList.Internal --- | A binary list is a list containing a power of two elements. --- Note that a binary list is never empty. -data BinList a = - -- Single element list. - ListEnd a - -- Given ListNode n l r: - -- * n >= 1. - -- * Both l and r have 2^(n-1) elements. - | ListNode {-# UNPACK #-} !Int (BinList a) (BinList a) - deriving Eq -- | /O(1)/. Build a list with a single element. singleton :: a -> BinList a @@ -144,6 +139,16 @@ forall xs. reverse (reverse xs) = xs #-} +-- | /O(n)/. Retrieves the minimum element of a binary list. +minimum :: Ord a => BinList a -> a +minimum (ListEnd x) = x +minimum (ListNode _ l r) = min (minimum l) (minimum r) + +-- | /O(n)/. Retrieves the maximum element of a binary list. +maximum :: Ord a => BinList a -> a +maximum (ListEnd x) = x +maximum (ListNode _ l r) = max (maximum l) (maximum r) + ------------------------------ -- Transformations with tuples @@ -220,17 +225,6 @@ fromList :: [a] -> Maybe (BinList a) fromList xs = fmap (fromListBuilder xs) $ exponentInBasisTwo $ Prelude.length xs --- | /O(n)/. This function builds a binary list from a linked list, assuming --- the length of the input list is a power of two. -fromListBuilder :: [a] -- ^ Input list - -> Int -- ^ Length index of the input list - -> BinList a -fromListBuilder [x] _ = ListEnd x -fromListBuilder xs n = - let m = n - 1 -- Length index of a single branch - (l,r) = splitAt (2^m) xs - in ListNode n (fromListBuilder l m) (fromListBuilder r m) - -- | /O(1)/. This is the last exponent that has power of two defined in the type 'Int'. -- -- /Note: This value is system dependent, since the type 'Int' varies in size/ @@ -285,8 +279,8 @@ go xs (ListNode _ l r) = go (go xs r) l go xs (ListEnd x) = x : xs ------------------------ --- Some class instances +----------------------------- +-- Show and Functor instances instance Show a => Show (BinList a) where show = show . toList @@ -294,4 +288,3 @@ instance Functor BinList where fmap f (ListNode n l r) = ListNode n (fmap f l) (fmap f r) fmap f (ListEnd x) = ListEnd $ f x - diff --git a/Data/BinaryList/Internal.hs b/Data/BinaryList/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/BinaryList/Internal.hs @@ -0,0 +1,29 @@ + +-- | This module only contains the 'BinList' data type, with 'Show' and +-- 'Functor' instances, plus the 'fromListBuilder' function. +module Data.BinaryList.Internal + ( BinList (..) + , fromListBuilder + ) where + +-- | A binary list is a list containing a power of two elements. +-- Note that a binary list is never empty. +data BinList a = + -- Single element list. + ListEnd a + -- Given ListNode n l r: + -- * n >= 1. + -- * Both l and r have 2^(n-1) elements. + | ListNode {-# UNPACK #-} !Int (BinList a) (BinList a) + deriving Eq + +-- | /O(n)/. This function builds a binary list from a linked list, assuming +-- the length of the input list is a power of two. +fromListBuilder :: [a] -- ^ Input list + -> Int -- ^ Length index of the input list + -> BinList a +fromListBuilder [x] _ = ListEnd x +fromListBuilder xs n = + let m = n - 1 -- Length index of a single branch + (l,r) = splitAt (2^m) xs + in ListNode n (fromListBuilder l m) (fromListBuilder r m) diff --git a/Data/BinaryList/Serialize.hs b/Data/BinaryList/Serialize.hs new file mode 100644 --- /dev/null +++ b/Data/BinaryList/Serialize.hs @@ -0,0 +1,170 @@ + +-- | Serialization methods for binary lists. +module Data.BinaryList.Serialize ( + -- * Simple interface + encode + , decode + -- * Other methods + , Direction (..) + -- ** Encoding + , EncodedBinList (..) + , encodeBinList + -- ** Decoding + , DecodedBinList (..) + , Decoded (..) + , fromDecoded + , decodeBinList + -- ** ByteString translations + , encodedToByteString + , encodedFromByteString + ) where + +-- Binary lists +import Data.BinaryList.Internal +import Data.BinaryList +-- Binary package +import Data.Binary (Binary (..)) +import Data.Binary.Put +import Data.Binary.Get +-- Bytestrings +import Data.ByteString.Lazy (ByteString) +-- Utils +import Control.Monad (replicateM) + +-- | Encode a binary list using the 'Binary' instance of +-- its elements. +encode :: Binary a => BinList a -> ByteString +encode = encodedToByteString . encodeBinList put FromLeft + +-- | Decode a binary list using the 'Binary' instance of +-- its elements. It returns a 'String' in case of +-- decoding failure. +decode :: Binary a => ByteString -> Either String (BinList a) +decode input = encodedFromByteString input >>= fromDecoded . decData . decodeBinList get + +-- | Direction of encoding. If the direction is 'FromLeft', +-- the binary list will be encoded from left to right. If +-- the direction is 'FromRight', the binary list will be +-- encoded in the opposite way. Choose a direction according +-- to the part of the list you want to have access earlier. +-- If you foresee reading only a part of the list, either +-- at its beginning or end, an appropiate choice of direction +-- will allow you to avoid decoding the full list. +data Direction = FromLeft | FromRight deriving Eq + +-- | A binary list encoded, ready to be written in a file or be +-- sent over a network. It can be directly translated to a +-- 'ByteString' using 'encodedToByteString', or restored +-- using 'encodedFromByteString'. +data EncodedBinList = + EncodedBinList + { -- | Direction of encoding. + encDirection :: Direction + -- | Length index (see 'lengthIndex') of the binary list. + , encLength :: Int + -- | Encoded data. + , encData :: ByteString + } + +-- | Encode a binary list, using a custom serialization for its elements and +-- an user-supplied direction. +encodeBinList :: (a -> Put) -> Direction -> BinList a -> EncodedBinList +encodeBinList f d xs = EncodedBinList d (lengthIndex xs) $ + if d == FromLeft + then runPut $ foldl (\y x -> y >> f x) (return ()) $ toList xs + else runPut $ foldr (\x y -> f x >> y) (return ()) $ toList xs + +-- | A binary list decoded, from where you can extract a binary list. If the +-- decoding process fails in some point, you still will be able to retrieve +-- the binary list of elements that were decoded successfully before the +-- error. +data DecodedBinList a = + DecodedBinList + { -- | Direction of encoding. + decDirection :: Direction + -- | Length index (see 'lengthIndex') of the binary list. + , decLength :: Int + -- | Decoded data. + , decData :: Decoded a + } + +-- | The result of decoding a binary list, which produces a list of binary +-- lists of increasing size, ending in either a decoding error or a final +-- binary list. When this is the result of 'decodeBinListIncremental', it +-- contains sublists of order 1, 2, 4, 8, ... up to the order of the total +-- list (unless an error has been encountered first). This sublists are +-- either a section starting at the left, or a section starting at the right, +-- depending on the 'Direction' of encoding. +data Decoded a = -- | Partial binary list, and rest of decoded input. + PartialResult (BinList a) (Decoded a) + -- | Full binary list and remaining input. + | FinalResult (BinList a) ByteString + -- | A decoding error, with an error message and the remaining input. + | DecodingError String ByteString + +-- | Get the final result of a decoding process, unless it returned an error, in which +-- case this error is returned as a 'String'. +fromDecoded :: Decoded a -> Either String (BinList a) +fromDecoded (PartialResult _ d) = fromDecoded d +fromDecoded (FinalResult xs _) = Right xs +fromDecoded (DecodingError err _) = Left err + +-- | Decode an encoded binary list. +-- The result is given as a 'DecodedBinList' value, which can then be +-- queried to get partial results. +decodeBinList :: Get a -> EncodedBinList -> DecodedBinList a +decodeBinList f (EncodedBinList d l b) = DecodedBinList d l $ + case runGetOrFail f b of + Left (r,_,err) -> DecodingError err r + Right (r,_,x) -> go r (ListEnd x) + where + -- go :: ByteString -- ^ Input data. + -- -> BinList a -- ^ Accumulated binary list. + -- -> Decoded a + go input xs = + let i = lengthIndex xs + in if i == l + -- If the final length index has been reached, we stop decoding. + then FinalResult xs input + -- Otherwise, we read another chunk of data of the same size of + -- the already decoded data. + else case runGetOrFail (replicateM (2^i) f) input of + Left (r,_,err) -> DecodingError err r + Right (r,_,list) -> + let -- Binary list of new data + ys = fromListBuilder list i + -- Since the new data is of the same size of the accumulated + -- binary list, we can append safely just using 'ListNode'. + -- The appending order is determined by the encoding direction. + zs = if d == FromLeft + then ListNode (i+1) xs ys + else ListNode (i+1) ys xs + -- The Partial result is returned, and used again recurively to + -- build the next binary list. + in PartialResult zs $ go r zs + +-- | Translate an encoded binary list to a bytestring. +encodedToByteString :: EncodedBinList -> ByteString +encodedToByteString (EncodedBinList d l b) = runPut $ do + -- We start with 0 if the direction is left-to-right, and + -- with 1 if the direction is right-to-left. + putWord8 $ if d == FromLeft then 0 else 1 + -- Int values are converted to Word64 (note that Word32 does not contain every Int in a + -- 64-bit system). Then the Word64 value is encoded in big-endian format. + putWord64be $ fromIntegral l + putLazyByteString b + +-- | Translate a bytestring to an encoded binary list, in case this is possible. Otherwise, +-- it returns a string with a human-readable error. +encodedFromByteString :: ByteString -> Either String EncodedBinList +encodedFromByteString input = + let p = do w <- getWord8 + d <- case w of + 0 -> return FromLeft + 1 -> return FromRight + _ -> fail $ "encodedFromByteString: unknown direction " ++ show w + l <- getWord64be + return (d,l) + in case runGetOrFail p input of + Left (_,_,err) -> Left err + Right (r,_,(d,l)) -> Right $ EncodedBinList d (fromIntegral l) r diff --git a/binary-list.cabal b/binary-list.cabal --- a/binary-list.cabal +++ b/binary-list.cabal @@ -1,5 +1,5 @@ name: binary-list -version: 0.1.0.2 +version: 0.2.0.0 synopsis: Lists of size length a power of two. description: Some algorithmic problems work only when the input list has length a power of two. This library provides with a @@ -14,13 +14,13 @@ cabal-version: >=1.10 library - exposed-modules: Data.BinaryList - build-depends: base == 4.* + exposed-modules: Data.BinaryList, Data.BinaryList.Serialize + other-modules: Data.BinaryList.Internal + build-depends: base == 4.*, bytestring, binary default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -fno-warn-orphans Source-repository head type: git location: git://github.com/Daniel-Diaz/binary-list.git -