1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Packed.Internal.Vector
-- Copyright : (c) Alberto Ruiz 2007
-- License : GPL-style
--
-- Maintainer : Alberto Ruiz <aruiz@um.es>
-- Stability : provisional
-- Portability : portable (uses FFI)
--
-- Vector implementation
--
-----------------------------------------------------------------------------
module Data.Packed.Internal.Vector where
import Data.Packed.Internal.Common
import Foreign
import Complex
import Control.Monad(when)
import Data.List(transpose)
import Debug.Trace(trace)
type Vc t s = Int -> Ptr t -> s
-- not yet admitted by my haddock version
-- infixr 5 :>
-- type t :> s = Vc t s
vec :: Vector t -> (Vc t s) -> s
vec v f = f (dim v) (ptr v)
--baseOf v = (v `at` 0)
createVector :: Storable a => Int -> IO (Vector a)
createVector n = do
when (n <= 0) $ error ("trying to createVector of dim "++show n)
fp <- mallocForeignPtrArray n
let p = unsafeForeignPtrToPtr fp
--putStrLn ("\n---------> V"++show n)
return $ V n fp p
fromList :: Storable a => [a] -> Vector a
fromList l = unsafePerformIO $ do
v <- createVector (length l)
let f _ p = pokeArray p l >> return 0
f // vec v // check "fromList" []
return v
toList :: Storable a => Vector a -> [a]
toList v = unsafePerformIO $ peekArray (dim v) (ptr v)
n |> l = if length l == n then fromList l else error "|> with wrong size"
at' :: Storable a => Vector a -> Int -> a
at' v n = unsafePerformIO $ peekElemOff (ptr v) n
at :: Storable a => Vector a -> Int -> a
at v n | n >= 0 && n < dim v = at' v n
| otherwise = error "vector index out of range"
instance (Show a, Storable a) => (Show (Vector a)) where
show v = (show (dim v))++" |> " ++ show (toList v)
-- | creates a Vector taking a number of consecutive toList from another Vector
subVector :: Storable t => Int -- ^ index of the starting element
-> Int -- ^ number of toList to extract
-> Vector t -- ^ source
-> Vector t -- ^ result
subVector k l (v@V {dim=n, ptr=p, fptr=fp})
| k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range"
| otherwise = unsafePerformIO $ do
r <- createVector l
let f = copyArray (ptr r) (advancePtr p k) l >> return 0
f // check "subVector" [v]
return r
subVector' k l (v@V {dim=n, ptr=p, fptr=fp})
| k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range"
| otherwise = v {dim=l, ptr=advancePtr p k}
-- | Reads a vector position.
(@>) :: Storable t => Vector t -> Int -> t
infixl 9 @>
(@>) = at
-- | creates a new Vector by joining a list of Vectors
join :: Storable t => [Vector t] -> Vector t
join [] = error "joining zero vectors"
join as = unsafePerformIO $ do
let tot = sum (map dim as)
r@V {fptr = p, ptr = p'} <- createVector tot
withForeignPtr p $ \_ ->
joiner as tot p'
return r
where joiner [] _ _ = return ()
joiner (V {dim = n, fptr = b, ptr = q} : cs) _ p = do
withForeignPtr b $ \_ -> copyArray p q n
joiner cs 0 (advancePtr p n)
-- | transforms a complex vector into a real vector with alternating real and imaginary parts
asReal :: Vector (Complex Double) -> Vector Double
asReal v = V { dim = 2*dim v, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) }
-- | transforms a real vector into a complex vector with alternating real and imaginary parts
asComplex :: Vector Double -> Vector (Complex Double)
asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) }
----------------------------------------------------------------
liftVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b
liftVector f = fromList . map f . toList
liftVector2 :: (Storable a, Storable b, Storable c) => (a-> b -> c) -> Vector a -> Vector b -> Vector c
liftVector2 f u v = fromList $ zipWith f (toList u) (toList v)
|
