summaryrefslogtreecommitdiff
path: root/packages/hmatrix/src/Data/Packed/Internal/Vector.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/hmatrix/src/Data/Packed/Internal/Vector.hs')
-rw-r--r--packages/hmatrix/src/Data/Packed/Internal/Vector.hs521
1 files changed, 0 insertions, 521 deletions
diff --git a/packages/hmatrix/src/Data/Packed/Internal/Vector.hs b/packages/hmatrix/src/Data/Packed/Internal/Vector.hs
deleted file mode 100644
index 6d03438..0000000
--- a/packages/hmatrix/src/Data/Packed/Internal/Vector.hs
+++ /dev/null
@@ -1,521 +0,0 @@
1{-# LANGUAGE MagicHash, CPP, UnboxedTuples, BangPatterns, FlexibleContexts #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module : Data.Packed.Internal.Vector
5-- Copyright : (c) Alberto Ruiz 2007
6-- License : GPL-style
7--
8-- Maintainer : Alberto Ruiz <aruiz@um.es>
9-- Stability : provisional
10-- Portability : portable (uses FFI)
11--
12-- Vector implementation
13--
14-----------------------------------------------------------------------------
15
16module Data.Packed.Internal.Vector (
17 Vector, dim,
18 fromList, toList, (|>),
19 vjoin, (@>), safe, at, at', subVector, takesV,
20 mapVector, mapVectorWithIndex, zipVectorWith, unzipVectorWith,
21 mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_,
22 foldVector, foldVectorG, foldLoop, foldVectorWithIndex,
23 createVector, vec,
24 asComplex, asReal, float2DoubleV, double2FloatV,
25 stepF, stepD, condF, condD,
26 conjugateQ, conjugateC,
27 fwriteVector, freadVector, fprintfVector, fscanfVector,
28 cloneVector,
29 unsafeToForeignPtr,
30 unsafeFromForeignPtr,
31 unsafeWith
32) where
33
34import Data.Packed.Internal.Common
35import Data.Packed.Internal.Signatures
36import Foreign.Marshal.Alloc(free)
37import Foreign.Marshal.Array(peekArray, copyArray, advancePtr)
38import Foreign.ForeignPtr(ForeignPtr, castForeignPtr)
39import Foreign.Ptr(Ptr)
40import Foreign.Storable(Storable, peekElemOff, pokeElemOff, sizeOf)
41import Foreign.C.String
42import Foreign.C.Types
43import Data.Complex
44import Control.Monad(when)
45import System.IO.Unsafe(unsafePerformIO)
46
47#if __GLASGOW_HASKELL__ >= 605
48import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
49#else
50import Foreign.ForeignPtr (mallocForeignPtrBytes)
51#endif
52
53import GHC.Base
54#if __GLASGOW_HASKELL__ < 612
55import GHC.IOBase hiding (liftIO)
56#endif
57
58import qualified Data.Vector.Storable as Vector
59import Data.Vector.Storable(Vector,
60 fromList,
61 unsafeToForeignPtr,
62 unsafeFromForeignPtr,
63 unsafeWith)
64
65
66-- | Number of elements
67dim :: (Storable t) => Vector t -> Int
68dim = Vector.length
69
70
71-- C-Haskell vector adapter
72-- vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r
73vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b
74vec x f = unsafeWith x $ \p -> do
75 let v g = do
76 g (fi $ dim x) p
77 f v
78{-# INLINE vec #-}
79
80
81-- allocates memory for a new vector
82createVector :: Storable a => Int -> IO (Vector a)
83createVector n = do
84 when (n < 0) $ error ("trying to createVector of negative dim: "++show n)
85 fp <- doMalloc undefined
86 return $ unsafeFromForeignPtr fp 0 n
87 where
88 --
89 -- Use the much cheaper Haskell heap allocated storage
90 -- for foreign pointer space we control
91 --
92 doMalloc :: Storable b => b -> IO (ForeignPtr b)
93 doMalloc dummy = do
94#if __GLASGOW_HASKELL__ >= 605
95 mallocPlainForeignPtrBytes (n * sizeOf dummy)
96#else
97 mallocForeignPtrBytes (n * sizeOf dummy)
98#endif
99
100{- | creates a Vector from a list:
101
102@> fromList [2,3,5,7]
1034 |> [2.0,3.0,5.0,7.0]@
104
105-}
106
107safeRead v = inlinePerformIO . unsafeWith v
108{-# INLINE safeRead #-}
109
110inlinePerformIO :: IO a -> a
111inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
112{-# INLINE inlinePerformIO #-}
113
114{- | extracts the Vector elements to a list
115
116>>> toList (linspace 5 (1,10))
117[1.0,3.25,5.5,7.75,10.0]
118
119-}
120toList :: Storable a => Vector a -> [a]
121toList v = safeRead v $ peekArray (dim v)
122
123{- | Create a vector from a list of elements and explicit dimension. The input
124 list is explicitly truncated if it is too long, so it may safely
125 be used, for instance, with infinite lists.
126
127>>> 5 |> [1..]
128fromList [1.0,2.0,3.0,4.0,5.0]
129
130-}
131(|>) :: (Storable a) => Int -> [a] -> Vector a
132infixl 9 |>
133n |> l = if length l' == n
134 then fromList l'
135 else error "list too short for |>"
136 where l' = take n l
137
138
139-- | access to Vector elements without range checking
140at' :: Storable a => Vector a -> Int -> a
141at' v n = safeRead v $ flip peekElemOff n
142{-# INLINE at' #-}
143
144--
145-- turn off bounds checking with -funsafe at configure time.
146-- ghc will optimise away the salways true case at compile time.
147--
148#if defined(UNSAFE)
149safe :: Bool
150safe = False
151#else
152safe = True
153#endif
154
155-- | access to Vector elements with range checking.
156at :: Storable a => Vector a -> Int -> a
157at v n
158 | safe = if n >= 0 && n < dim v
159 then at' v n
160 else error "vector index out of range"
161 | otherwise = at' v n
162{-# INLINE at #-}
163
164{- | takes a number of consecutive elements from a Vector
165
166>>> subVector 2 3 (fromList [1..10])
167fromList [3.0,4.0,5.0]
168
169-}
170subVector :: Storable t => Int -- ^ index of the starting element
171 -> Int -- ^ number of elements to extract
172 -> Vector t -- ^ source
173 -> Vector t -- ^ result
174subVector = Vector.slice
175
176
177{- | Reads a vector position:
178
179>>> fromList [0..9] @> 7
1807.0
181
182-}
183(@>) :: Storable t => Vector t -> Int -> t
184infixl 9 @>
185(@>) = at
186
187
188{- | concatenate a list of vectors
189
190>>> vjoin [fromList [1..5::Double], konst 1 3]
191fromList [1.0,2.0,3.0,4.0,5.0,1.0,1.0,1.0]
192
193-}
194vjoin :: Storable t => [Vector t] -> Vector t
195vjoin [] = fromList []
196vjoin [v] = v
197vjoin as = unsafePerformIO $ do
198 let tot = sum (map dim as)
199 r <- createVector tot
200 unsafeWith r $ \ptr ->
201 joiner as tot ptr
202 return r
203 where joiner [] _ _ = return ()
204 joiner (v:cs) _ p = do
205 let n = dim v
206 unsafeWith v $ \pb -> copyArray p pb n
207 joiner cs 0 (advancePtr p n)
208
209
210{- | Extract consecutive subvectors of the given sizes.
211
212>>> takesV [3,4] (linspace 10 (1,10::Double))
213[fromList [1.0,2.0,3.0],fromList [4.0,5.0,6.0,7.0]]
214
215-}
216takesV :: Storable t => [Int] -> Vector t -> [Vector t]
217takesV ms w | sum ms > dim w = error $ "takesV " ++ show ms ++ " on dim = " ++ (show $ dim w)
218 | otherwise = go ms w
219 where go [] _ = []
220 go (n:ns) v = subVector 0 n v
221 : go ns (subVector n (dim v - n) v)
222
223---------------------------------------------------------------
224
225-- | transforms a complex vector into a real vector with alternating real and imaginary parts
226asReal :: (RealFloat a, Storable a) => Vector (Complex a) -> Vector a
227asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n)
228 where (fp,i,n) = unsafeToForeignPtr v
229
230-- | transforms a real vector into a complex vector with alternating real and imaginary parts
231asComplex :: (RealFloat a, Storable a) => Vector a -> Vector (Complex a)
232asComplex v = unsafeFromForeignPtr (castForeignPtr fp) (i `div` 2) (n `div` 2)
233 where (fp,i,n) = unsafeToForeignPtr v
234
235---------------------------------------------------------------
236
237float2DoubleV :: Vector Float -> Vector Double
238float2DoubleV v = unsafePerformIO $ do
239 r <- createVector (dim v)
240 app2 c_float2double vec v vec r "float2double"
241 return r
242
243double2FloatV :: Vector Double -> Vector Float
244double2FloatV v = unsafePerformIO $ do
245 r <- createVector (dim v)
246 app2 c_double2float vec v vec r "double2float2"
247 return r
248
249
250foreign import ccall unsafe "float2double" c_float2double:: TFV
251foreign import ccall unsafe "double2float" c_double2float:: TVF
252
253---------------------------------------------------------------
254
255stepF :: Vector Float -> Vector Float
256stepF v = unsafePerformIO $ do
257 r <- createVector (dim v)
258 app2 c_stepF vec v vec r "stepF"
259 return r
260
261stepD :: Vector Double -> Vector Double
262stepD v = unsafePerformIO $ do
263 r <- createVector (dim v)
264 app2 c_stepD vec v vec r "stepD"
265 return r
266
267foreign import ccall unsafe "stepF" c_stepF :: TFF
268foreign import ccall unsafe "stepD" c_stepD :: TVV
269
270---------------------------------------------------------------
271
272condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float
273condF x y l e g = unsafePerformIO $ do
274 r <- createVector (dim x)
275 app6 c_condF vec x vec y vec l vec e vec g vec r "condF"
276 return r
277
278condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double
279condD x y l e g = unsafePerformIO $ do
280 r <- createVector (dim x)
281 app6 c_condD vec x vec y vec l vec e vec g vec r "condD"
282 return r
283
284foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF
285foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV
286
287--------------------------------------------------------------------------------
288
289conjugateAux fun x = unsafePerformIO $ do
290 v <- createVector (dim x)
291 app2 fun vec x vec v "conjugateAux"
292 return v
293
294conjugateQ :: Vector (Complex Float) -> Vector (Complex Float)
295conjugateQ = conjugateAux c_conjugateQ
296foreign import ccall unsafe "conjugateQ" c_conjugateQ :: TQVQV
297
298conjugateC :: Vector (Complex Double) -> Vector (Complex Double)
299conjugateC = conjugateAux c_conjugateC
300foreign import ccall unsafe "conjugateC" c_conjugateC :: TCVCV
301
302--------------------------------------------------------------------------------
303
304cloneVector :: Storable t => Vector t -> IO (Vector t)
305cloneVector v = do
306 let n = dim v
307 r <- createVector n
308 let f _ s _ d = copyArray d s n >> return 0
309 app2 f vec v vec r "cloneVector"
310 return r
311
312------------------------------------------------------------------
313
314-- | map on Vectors
315mapVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b
316mapVector f v = unsafePerformIO $ do
317 w <- createVector (dim v)
318 unsafeWith v $ \p ->
319 unsafeWith w $ \q -> do
320 let go (-1) = return ()
321 go !k = do x <- peekElemOff p k
322 pokeElemOff q k (f x)
323 go (k-1)
324 go (dim v -1)
325 return w
326{-# INLINE mapVector #-}
327
328-- | zipWith for Vectors
329zipVectorWith :: (Storable a, Storable b, Storable c) => (a-> b -> c) -> Vector a -> Vector b -> Vector c
330zipVectorWith f u v = unsafePerformIO $ do
331 let n = min (dim u) (dim v)
332 w <- createVector n
333 unsafeWith u $ \pu ->
334 unsafeWith v $ \pv ->
335 unsafeWith w $ \pw -> do
336 let go (-1) = return ()
337 go !k = do x <- peekElemOff pu k
338 y <- peekElemOff pv k
339 pokeElemOff pw k (f x y)
340 go (k-1)
341 go (n -1)
342 return w
343{-# INLINE zipVectorWith #-}
344
345-- | unzipWith for Vectors
346unzipVectorWith :: (Storable (a,b), Storable c, Storable d)
347 => ((a,b) -> (c,d)) -> Vector (a,b) -> (Vector c,Vector d)
348unzipVectorWith f u = unsafePerformIO $ do
349 let n = dim u
350 v <- createVector n
351 w <- createVector n
352 unsafeWith u $ \pu ->
353 unsafeWith v $ \pv ->
354 unsafeWith w $ \pw -> do
355 let go (-1) = return ()
356 go !k = do z <- peekElemOff pu k
357 let (x,y) = f z
358 pokeElemOff pv k x
359 pokeElemOff pw k y
360 go (k-1)
361 go (n-1)
362 return (v,w)
363{-# INLINE unzipVectorWith #-}
364
365foldVector :: Storable a => (a -> b -> b) -> b -> Vector a -> b
366foldVector f x v = unsafePerformIO $
367 unsafeWith v $ \p -> do
368 let go (-1) s = return s
369 go !k !s = do y <- peekElemOff p k
370 go (k-1::Int) (f y s)
371 go (dim v -1) x
372{-# INLINE foldVector #-}
373
374-- the zero-indexed index is passed to the folding function
375foldVectorWithIndex :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b
376foldVectorWithIndex f x v = unsafePerformIO $
377 unsafeWith v $ \p -> do
378 let go (-1) s = return s
379 go !k !s = do y <- peekElemOff p k
380 go (k-1::Int) (f k y s)
381 go (dim v -1) x
382{-# INLINE foldVectorWithIndex #-}
383
384foldLoop f s0 d = go (d - 1) s0
385 where
386 go 0 s = f (0::Int) s
387 go !j !s = go (j - 1) (f j s)
388
389foldVectorG f s0 v = foldLoop g s0 (dim v)
390 where g !k !s = f k (at' v) s
391 {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)
392{-# INLINE foldVectorG #-}
393
394-------------------------------------------------------------------
395
396-- | monadic map over Vectors
397-- the monad @m@ must be strict
398mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b)
399mapVectorM f v = do
400 w <- return $! unsafePerformIO $! createVector (dim v)
401 mapVectorM' w 0 (dim v -1)
402 return w
403 where mapVectorM' w' !k !t
404 | k == t = do
405 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
406 y <- f x
407 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
408 | otherwise = do
409 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
410 y <- f x
411 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
412 mapVectorM' w' (k+1) t
413{-# INLINE mapVectorM #-}
414
415-- | monadic map over Vectors
416mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m ()
417mapVectorM_ f v = do
418 mapVectorM' 0 (dim v -1)
419 where mapVectorM' !k !t
420 | k == t = do
421 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
422 f x
423 | otherwise = do
424 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
425 _ <- f x
426 mapVectorM' (k+1) t
427{-# INLINE mapVectorM_ #-}
428
429-- | monadic map over Vectors with the zero-indexed index passed to the mapping function
430-- the monad @m@ must be strict
431mapVectorWithIndexM :: (Storable a, Storable b, Monad m) => (Int -> a -> m b) -> Vector a -> m (Vector b)
432mapVectorWithIndexM f v = do
433 w <- return $! unsafePerformIO $! createVector (dim v)
434 mapVectorM' w 0 (dim v -1)
435 return w
436 where mapVectorM' w' !k !t
437 | k == t = do
438 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
439 y <- f k x
440 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
441 | otherwise = do
442 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
443 y <- f k x
444 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
445 mapVectorM' w' (k+1) t
446{-# INLINE mapVectorWithIndexM #-}
447
448-- | monadic map over Vectors with the zero-indexed index passed to the mapping function
449mapVectorWithIndexM_ :: (Storable a, Monad m) => (Int -> a -> m ()) -> Vector a -> m ()
450mapVectorWithIndexM_ f v = do
451 mapVectorM' 0 (dim v -1)
452 where mapVectorM' !k !t
453 | k == t = do
454 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
455 f k x
456 | otherwise = do
457 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
458 _ <- f k x
459 mapVectorM' (k+1) t
460{-# INLINE mapVectorWithIndexM_ #-}
461
462
463mapVectorWithIndex :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b
464--mapVectorWithIndex g = head . mapVectorWithIndexM (\a b -> [g a b])
465mapVectorWithIndex f v = unsafePerformIO $ do
466 w <- createVector (dim v)
467 unsafeWith v $ \p ->
468 unsafeWith w $ \q -> do
469 let go (-1) = return ()
470 go !k = do x <- peekElemOff p k
471 pokeElemOff q k (f k x)
472 go (k-1)
473 go (dim v -1)
474 return w
475{-# INLINE mapVectorWithIndex #-}
476
477-------------------------------------------------------------------
478
479
480-- | Loads a vector from an ASCII file (the number of elements must be known in advance).
481fscanfVector :: FilePath -> Int -> IO (Vector Double)
482fscanfVector filename n = do
483 charname <- newCString filename
484 res <- createVector n
485 app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf"
486 free charname
487 return res
488
489foreign import ccall unsafe "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV
490
491-- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file.
492fprintfVector :: FilePath -> String -> Vector Double -> IO ()
493fprintfVector filename fmt v = do
494 charname <- newCString filename
495 charfmt <- newCString fmt
496 app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf"
497 free charname
498 free charfmt
499
500foreign import ccall unsafe "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV
501
502-- | Loads a vector from a binary file (the number of elements must be known in advance).
503freadVector :: FilePath -> Int -> IO (Vector Double)
504freadVector filename n = do
505 charname <- newCString filename
506 res <- createVector n
507 app1 (gsl_vector_fread charname) vec res "gsl_vector_fread"
508 free charname
509 return res
510
511foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV
512
513-- | Saves the elements of a vector to a binary file.
514fwriteVector :: FilePath -> Vector Double -> IO ()
515fwriteVector filename v = do
516 charname <- newCString filename
517 app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite"
518 free charname
519
520foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV
521