diff --git a/Data/StorableVector.hs b/Data/StorableVector.hs --- a/Data/StorableVector.hs +++ b/Data/StorableVector.hs @@ -166,6 +166,11 @@ unzip, copy, + -- * Interleaved 'Vector's + sieve, + deinterleave, + interleave, + -- * IO hGet, hPut, @@ -189,6 +194,8 @@ import Data.StorableVector.Base +import qualified Control.Monad.Trans.Cont as MC + import qualified Data.List as List import qualified Data.List.HT as ListHT import qualified Data.Strictness.HT as Strict @@ -200,7 +207,7 @@ import Control.Exception (assert, bracket, ) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) -import Foreign.Marshal.Array (advancePtr, copyArray, ) +import Foreign.Marshal.Array (advancePtr, copyArray, withArray, ) import Foreign.Ptr (Ptr, minusPtr, ) import Foreign.Storable (Storable(..)) @@ -388,6 +395,13 @@ withNonEmptyVector "tail" $ \ p s l -> SV p (s+1) (l-1) {-# INLINE tail #-} +laxTail :: (Storable a) => Vector a -> Vector a +laxTail v@(SV fp s l) = + if l<=0 + then v + else SV fp (s+1) (l-1) +{-# INLINE laxTail #-} + -- | /O(1)/ Extract the last element of a 'Vector', which must be finite and non-empty. -- An exception will be thrown in the case of an empty 'Vector'. last :: (Storable a) => Vector a -> a @@ -1358,6 +1372,59 @@ unzip :: (Storable a, Storable b) => [(a, b)] -> (Vector a, Vector b) unzip ls = (pack (P.map fst ls), pack (P.map snd ls)) {-# INLINE unzip #-} + +-- --------------------------------------------------------------------- +-- Interleaved 'Vector's + +-- | /O(l/n)/ 'sieve' selects every 'n'th element. +sieve :: (Storable a) => Int -> Vector a -> Vector a +sieve n (SV fp s l) = + let end = s+l + in fst $ + unfoldrN (- div (-l) n) + (Strict.arguments1 $ \k0 -> + do guard (k0 Int -> Vector a -> [Vector a] +deinterleave n = + P.map (sieve n) . P.take n . P.iterate laxTail + +-- | /O(n)/ +-- Almost the inverse of deinterleave. +-- Restriction is that all input vector must have equal length. +-- @interleave [pack "adgj", pack "behk", pack "cfil"] = pack ['a'..'l']@ +interleave :: (Storable a) => [Vector a] -> Vector a +interleave vs = + unsafePerformIO $ + MC.runContT + (do + pls <- mapM (\v -> MC.ContT (withStartPtr v . curry)) vs + let (ps,ls) = P.unzip pls + ptrs <- MC.ContT (withArray ps) + if and (ListHT.mapAdjacent (==) ls) + then return (ptrs, P.sum ls) + else moduleError "interleave" "all input vectors must have the same length") + (\(ptrs, totalLength) -> create totalLength $ \p -> + let n = P.length vs + pEnd = advancePtr p totalLength + go = Strict.arguments3 $ \k0 j p0 -> do + poke p0 =<< flip peekElemOff j =<< peekElemOff ptrs k0 + let p1 = advancePtr p0 1 + k1 = succ k0 + when (p1 < pEnd) $ + if k1 < n + then go k1 j p1 + else go 0 (succ j) p1 + in go 0 0 p) +{-# INLINE interleave #-} + -- --------------------------------------------------------------------- -- Special lists diff --git a/Data/StorableVector/Lazy.hs b/Data/StorableVector/Lazy.hs --- a/Data/StorableVector/Lazy.hs +++ b/Data/StorableVector/Lazy.hs @@ -16,7 +16,7 @@ import qualified Numeric.NonNegative.Class as NonNeg import qualified Data.List.HT as ListHT -import Data.Tuple.HT (mapPair, mapFst, mapSnd, ) +import Data.Tuple.HT (mapPair, mapFst, mapSnd, swap, ) import Data.Maybe.HT (toMaybe, ) import Data.Maybe (fromMaybe, ) @@ -737,6 +737,55 @@ (Ptr.viewL zt) (Ptr.viewL wt)) (pointer s0, pointer s1, pointer s2, pointer s3) + + +-- * interleaved vectors + +{-# INLINE sieve #-} +sieve :: (Storable a) => Int -> Vector a -> Vector a +sieve n = + fromChunks . List.filter (not . V.null) . snd . + List.mapAccumL + (\offset chunk -> + (mod (offset - V.length chunk) n, + V.sieve n $ V.drop offset chunk)) 0 . + chunks + +{-# INLINE deinterleave #-} +deinterleave :: (Storable a) => Int -> Vector a -> [Vector a] +deinterleave n = + P.map (sieve n) . P.take n . P.iterate (switchL empty (flip const)) + +{- | +Interleave lazy vectors +while maintaining the chunk pattern of the first vector. +All input vectors must have the same length. +-} +{-# INLINE interleaveFirstPattern #-} +interleaveFirstPattern :: (Storable a) => [Vector a] -> Vector a +interleaveFirstPattern [] = empty +interleaveFirstPattern vss@(vs:_) = + let pattern = List.map V.length $ chunks vs + split xs = + snd $ + List.mapAccumL + (\x n -> swap $ mapFst (V.concat . chunks) $ splitAt n x) + xs pattern + in fromChunks $ List.map V.interleave $ + List.transpose $ List.map split vss + +{- +interleaveFirstPattern vss@(vs:_) = + fromChunks . snd . + List.mapAccumL + (\xss n -> + swap $ + mapFst (V.interleave . List.map (V.concat . chunks)) $ + List.unzip $ List.map (splitAt n) xss) + vss . + List.map V.length . chunks $ vs +-} + {- | diff --git a/storablevector.cabal b/storablevector.cabal --- a/storablevector.cabal +++ b/storablevector.cabal @@ -1,5 +1,5 @@ Name: storablevector -Version: 0.2.7.3 +Version: 0.2.8 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description: @@ -7,16 +7,17 @@ with a list interface, a chunky lazy list interface with variable chunk size and an interface for write access via the @ST@ monad. - This is much like @bytestring@ and @binary@ but can be used for every 'Foreign.Storable.Storable' type. - See also packages - , - + This is much like @bytestring@ and @binary@ + but can be used for every 'Foreign.Storable.Storable' type. + See also package + with a similar intention. . We do not provide advanced fusion optimization, since especially for lazy vectors this would either be incorrect or not applicable. - For fusion see . + However we provide fusion with lazy lists in the package + . License: BSD3 License-file: LICENSE Author: Spencer Janssen , Henning Thielemann @@ -24,7 +25,7 @@ Homepage: http://www.haskell.org/haskellwiki/Storable_Vector Stability: Experimental Build-Type: Simple -Tested-With: GHC==6.8.2, JHC==0.7.3 +Tested-With: GHC==6.8.2, GHC==6.12.3, GHC==7.4.1, JHC==0.7.3 Cabal-Version: >=1.6 Extra-Source-Files: foreign-ptr/fast/Data/StorableVector/Memory.hs @@ -51,14 +52,14 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/ - tag: 0.2.7.3 + tag: 0.2.8 Library Build-Depends: - non-negative >= 0.1 && <0.2, - utility-ht >= 0.0.5 && <0.1, + non-negative >=0.1 && <0.2, + utility-ht >=0.0.5 && <0.1, transformers >=0.2 && <0.4, - QuickCheck >= 1 && < 3 + QuickCheck >=1 && <3 If impl(jhc) Hs-Source-Dirs: foreign-ptr/jhc @@ -114,19 +115,19 @@ Extensions: CPP, ForeignFunctionInterface If flag(buildTests) Build-Depends: - bytestring >= 0.9 && < 0.10, - QuickCheck >= 1 && < 3 + bytestring >=0.9 && <0.11, + QuickCheck >=1 && <3 If flag(splitBase) - Build-Depends: random >= 1.0 && < 1.1 + Build-Depends: random >=1.0 && <1.1 If flag(functorInstance) Hs-Source-Dirs: tests-2 - Build-Depends: base >= 3 && <4 + Build-Depends: base >=3 && <4 Else Hs-Source-Dirs: tests-1 - Build-Depends: base >= 4 && <5 + Build-Depends: base >=4 && <5 Else Hs-Source-Dirs: tests-1 - Build-Depends: base >= 1.0 && < 2 + Build-Depends: base >=1.0 && <2 Else Buildable: False @@ -156,8 +157,8 @@ Hs-Source-Dirs: ., foreign-ptr/slow, speedtest If flag(buildTests) If flag(splitBase) - Build-Depends: base >= 3 && <5 + Build-Depends: base >=3 && <5 Else - Build-Depends: base >= 1.0 && < 2 + Build-Depends: base >=1.0 && <2 Else Buildable: False