storablevector-streamfusion (empty) → 0.0
raw patch · 6 files changed
+410/−0 lines, 6 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, old-time, storablevector, stream-fusion, utility-ht
Files
- LICENSE +27/−0
- Setup.lhs +3/−0
- src/Data/StorableVector/Lazy/Stream.hs +51/−0
- src/Data/StorableVector/Stream.hs +45/−0
- storablevector-streamfusion.cabal +104/−0
- test/Speed.hs +180/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Data/StorableVector/Lazy/Stream.hs view
@@ -0,0 +1,51 @@+module Data.StorableVector.Lazy.Stream (+ from, fromList,+ to, toList,+ ) where++import qualified Data.StorableVector.Lazy as SV+import qualified Data.StorableVector.Stream as SVG+import Foreign.Storable (Storable, )++import qualified Data.Stream as G++from :: Storable a =>+ SV.ChunkSize -> G.Stream a -> SV.Vector a+from size (G.Stream f s) =+ SV.unfoldr size+ (let go s0 =+ case f s0 of+ G.Yield a s1 -> Just (a, s1)+ G.Skip s1 -> go s1+ G.Done -> Nothing+ in go)+ s++{-# INLINE fromList #-}+fromList :: Storable a =>+ SV.ChunkSize -> [a] -> SV.Vector a+fromList size =+ from size . G.stream++++to :: Storable a =>+ SV.Vector a -> G.Stream a+to =+ concatS . map SVG.to . SV.chunks++{-# INLINE toList #-}+toList :: Storable a =>+ SV.Vector a -> [a]+toList = G.unstream . to++++concatS :: [G.Stream a] -> G.Stream a+concatS =+ foldr G.append empty++empty :: G.Stream a+empty =+ G.stream []+-- G.Stream (\_ -> G.Done) G.None
+ src/Data/StorableVector/Stream.hs view
@@ -0,0 +1,45 @@+module Data.StorableVector.Stream (+ from, fromList,+ to, toList,+ ) where++import qualified Data.StorableVector as SV+import Foreign.Storable (Storable, )++import qualified Data.Stream as G++import Data.Maybe.HT (toMaybe, )+++from :: Storable a =>+ Int -> G.Stream a -> SV.Vector a+from size (G.Stream f s) =+ fst $+ SV.unfoldrN size+ (let go s0 =+ case f s0 of+ G.Yield a s1 -> Just (a, s1)+ G.Skip s1 -> go s1+ G.Done -> Nothing+ in go)+ s++{-# INLINE fromList #-}+fromList :: Storable a =>+ Int -> [a] -> SV.Vector a+fromList size =+ from size . G.stream+++to :: Storable a =>+ SV.Vector a -> G.Stream a+to xs =+ G.unfoldr+ (\i ->+ toMaybe (i < SV.length xs) (SV.index xs i, succ i))+ 0++{-# INLINE toList #-}+toList :: Storable a =>+ SV.Vector a -> [a]+toList = G.unstream . to
+ storablevector-streamfusion.cabal view
@@ -0,0 +1,104 @@+Name: storablevector-streamfusion+Version: 0.0+Category: Data+Synopsis: Conversion between storablevector and stream-fusion lists with fusion+Description:+ This package brings together the best of two worlds:+ The flexibility of plain lists and speed of low-level arrays.+ Lists are lazy per element,+ thus allowing for elegant tying-the-knot algorithms+ and correct fusion of subsequent operations,+ and they support any element type, including functions.+ Storablevectors do not have these features.+ Instead they are fast, including very fast access via indices,+ they are memory efficient and allow simple exchange with C.+ .+ This package provides the canonical functions+ for conversion from StorableVector to Stream and back.+ By a simple fusion rule+ they let the interim Stream based lists disappear in many situations,+ resulting in fast low-level loops.+ Such fusion could not be correct on StorableVectors.+ E.g. consider+ .+ > import qualified Data.StorableVector.Lazy as SV+ > SV.zipWith f (SV.unfoldr size g a) (SV.cons b (SV.unfoldr size h c))+ .+ which yields a storable vector with the chunk structure+ .+ > [1, size, size, ...]+ .+ and the following strictness behaviour:+ For computation of the first value of the result,+ the first chunk with size @size@ of @SV.unfoldr size g a@+ has to be fully evaluated.+ This has two advantages:+ Firstly, you do not really want that behaviour,+ but you accept it for the sake of overall performance.+ Secondly, the odd behaviour cannot easily be preserved by fusion,+ and we must resist to tell the optimizer incorrect rules.+ .+ So here is the solution: Write+ .+ > import qualified Data.StorableVector.Lazy.Stream as SVG+ > import qualified Data.List.Stream as Stream+ > SVG.from chunkSize $+ > Stream.zipWith f+ > (Stream.unfoldr g a)+ > (Stream.cons b (Stream.unfoldr h c))+ .+ and get two advantages.+ First: You do not have to pass the @size@ parameter at the leaves,+ but only once at the top.+ Second: Fusion jumps in and turns everything in a single efficient @SV.unfoldr@.+License: BSD3+License-file: LICENSE+Author: Henning Thielemann <storablevector@henning-thielemann.de>+Maintainer: Henning Thielemann <storablevector@henning-thielemann.de>+Homepage: http://www.haskell.org/haskellwiki/Storable_Vector+Package-URL: http://code.haskell.org/~thielema/storablevector-streamfusion/+Stability: Experimental+Build-Type: Simple+Tested-With: GHC==6.8.2+Cabal-Version: >=1.2++Flag splitBase+ description: Choose the new smaller, split-up base package.++Flag buildTests+ description: Build test executables+ default: False++Library+ Build-Depends:+ storablevector >=0.2 && <0.3,+ stream-fusion >=0.1 && <0.2,+ utility-ht >=0.0.1 && <0.1+ If flag(splitBase)+ Build-Depends: base >= 3+ Else+ Build-Depends: base >= 1.0 && < 2++ GHC-Options: -Wall -funbox-strict-fields+ Hs-Source-Dirs: src++ Exposed-Modules:+ Data.StorableVector.Stream+ Data.StorableVector.Lazy.Stream+++Executable speedtest+ GHC-Options: -Wall -funbox-strict-fields -fexcess-precision -ddump-simpl-stats+ Hs-Source-Dirs: src, test+ Main-Is: Speed.hs+ Build-Depends:+ stream-fusion >=0.1 && <0.2,+ old-time >=1.0 && <1.1,+ binary >=0.4 && <0.5,+ bytestring >= 0.9 && < 0.10+ If flag(splitBase)+ Build-Depends: base >= 3+ Else+ Build-Depends: base >= 1.0 && < 2+ if !flag(buildTests)+ Buildable: False
+ test/Speed.hs view
@@ -0,0 +1,180 @@+module Main (main) where++import qualified Data.StorableVector.Stream as VG+import qualified Data.StorableVector as V++import qualified Data.StorableVector.Lazy.Stream as VGL+import qualified Data.StorableVector.Lazy as VL++import qualified Data.ByteString.Lazy as B+import qualified Data.Binary.Builder as Bin+import qualified Data.Monoid as Md++import qualified Data.List.Stream as L+import qualified Data.Stream as S+import Control.Monad.Stream (zipWithM_, )++import Control.Monad (when, )+import System.IO (withBinaryFile, hPutBuf, Handle, IOMode(WriteMode))+import Foreign (Storable, Ptr, Int16, poke, allocaArray, sizeOf, advancePtr, )++import GHC.Float (double2Int, )++import System.Time (getClockTime, diffClockTimes, tdSec, tdPicosec, )++++{-# INLINE signalToBinaryPut #-}+signalToBinaryPut :: [Int16] -> B.ByteString+signalToBinaryPut =+ Bin.toLazyByteString . mconcat .+ L.map (Bin.putWord16host . fromIntegral)++mconcat :: Md.Monoid m => [m] -> m+mconcat =+ L.foldr Md.mappend Md.mempty+++{- awfully slow+doubleToInt16 :: Double -> Int16+doubleToInt16 x = round (32767 * x)+-}++round' :: Double -> Int16+round' x =+ fromIntegral (double2Int+ (if x<0 then x-0.5 else x+0.5))++doubleToInt16 :: Double -> Int16+doubleToInt16 x = round' (32767 * x)+++-- that's important in order to allow fusion+{-# INLINE exponential2 #-}+exponential2 :: Double -> Double -> [Double]+exponential2 hl y0 =+ let k = 0.5 ** recip hl+ in L.iterate (k*) y0++exponential2Gen :: Double -> Double -> S.Stream Double+exponential2Gen hl y0 =+ let k = 0.5 ** recip hl+ in S.iterate (k*) y0+++{-# INLINE writeSignal #-}+writeSignal :: FilePath -> Int -> [Double] -> IO ()+writeSignal name num signal =+ withBinaryFile name WriteMode $ \h ->+ allocaArray num $ \buf ->+ zipWithM_ poke+ (L.take num $ L.iterate (flip advancePtr 1) buf)+ (L.map doubleToInt16 signal) >>+ hPutArray h buf num++writeExponentialList :: FilePath -> Int -> Double -> Double -> IO ()+writeExponentialList name num hl y0 =+ withBinaryFile name WriteMode $ \h ->+ allocaArray num $ \buf ->+ zipWithM_ poke+ (L.take num $ L.iterate (flip advancePtr 1) buf)+ (L.map doubleToInt16+ (let k = 0.5 ** recip hl+ in L.iterate (k*) y0)) >>+ hPutArray h buf num++writeExponential :: FilePath -> Int -> Double -> Double -> IO ()+writeExponential name num hl y0 =+ withBinaryFile name WriteMode $ \h ->+ allocaArray num $ \buf ->+ let k = 0.5 ** recip hl+ endPtr = advancePtr buf num+ loop ptr y =+ when (ptr<endPtr) $+ poke ptr (doubleToInt16 y) >>+ loop (advancePtr ptr 1) (y*k)+ in loop buf y0 >>+ hPutArray h buf num++hPutArray :: Storable a => Handle -> Ptr a -> Int -> IO ()+hPutArray h buf num =+ let size :: Storable a => Ptr a -> a -> Int+ size _ dummy = num * sizeOf dummy+ in hPutBuf h buf (size buf undefined)++exponentialStorableVector :: Int -> Double -> Double -> V.Vector Int16+exponentialStorableVector num hl y0 =+ let k = 0.5 ** recip hl+ in fst $ V.unfoldrN num (\y -> Just (doubleToInt16 y, y*k)) y0++exponentialStorableVectorLazy :: Double -> Double -> VL.Vector Int16+exponentialStorableVectorLazy hl y0 =+ let k = 0.5 ** recip hl+ in VL.unfoldr VL.defaultChunkSize+ (\y -> Just (doubleToInt16 y, y*k)) y0++++measureTime :: String -> (FilePath -> IO ()) -> IO ()+measureTime name act =+ do putStr (name++": ")+ timeA <- getClockTime+ act (name++".sw")+ timeB <- getClockTime+ let td = diffClockTimes timeB timeA+ print (fromIntegral (tdSec td) ++ fromInteger (tdPicosec td) * 1e-12 :: Double)++numSamples :: Int+numSamples = 1000000++halfLife :: Double+halfLife = 100000+++main :: IO ()+main =+ do measureTime "storablevector-from-stream" $ \fn ->+ V.writeFile fn $+ VG.from numSamples $+ S.map doubleToInt16 $+ exponential2Gen halfLife 1+ measureTime "storablevector-fused" $ \fn ->+ V.writeFile fn $+ VG.fromList numSamples $+ L.map doubleToInt16 $+ exponential2 halfLife 1+ measureTime "storablevector" $ \fn ->+ V.writeFile fn $+ exponentialStorableVector numSamples halfLife 1++ measureTime "storablevector-lazy-from-stream" $ \fn ->+ VL.writeFile fn $+ VGL.from VL.defaultChunkSize $+ S.take numSamples $+ S.map doubleToInt16 $+ exponential2Gen halfLife 1+ measureTime "storablevector-lazy-fused" $ \fn ->+ VL.writeFile fn $+ VGL.fromList VL.defaultChunkSize $+ L.take numSamples $+ L.map doubleToInt16 $+ exponential2 halfLife 1+ measureTime "storablevector-lazy" $ \fn ->+ VL.writeFile fn $+ VL.take numSamples $+ exponentialStorableVectorLazy halfLife 1++ measureTime "loop-poke" $ \fn ->+ writeExponential fn numSamples halfLife 1+ measureTime "list-binary-put" $ \fn ->+ B.writeFile fn $+ signalToBinaryPut $+ L.take numSamples $+ L.map doubleToInt16 $+ exponential2 halfLife 1+ measureTime "list-poke-buffer" $ \fn ->+ writeSignal fn numSamples $+ exponential2 halfLife 1+ measureTime "list-poke" $ \fn ->+ writeExponentialList fn numSamples halfLife 1