diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 43 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Instances.hs | 25 |
2 files changed, 59 insertions, 9 deletions
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 9ca8e58..a6868d9 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -47,6 +47,22 @@ import GHC.Base | |||
47 | import GHC.IOBase | 47 | import GHC.IOBase |
48 | #endif | 48 | #endif |
49 | 49 | ||
50 | #ifdef VECTOR | ||
51 | import qualified Data.Vector.Storable as Vector | ||
52 | import Data.Vector.Storable(Vector, | ||
53 | unsafeToForeignPtr, | ||
54 | unsafeFromForeignPtr, | ||
55 | unsafeWith) | ||
56 | #endif | ||
57 | |||
58 | #ifdef VECTOR | ||
59 | |||
60 | -- | Number of elements | ||
61 | dim :: (Storable t) => Vector t -> Int | ||
62 | dim = Vector.length | ||
63 | |||
64 | #else | ||
65 | |||
50 | -- | One-dimensional array of objects stored in a contiguous memory block. | 66 | -- | One-dimensional array of objects stored in a contiguous memory block. |
51 | data Vector t = | 67 | data Vector t = |
52 | V { ioff :: {-# UNPACK #-} !Int -- ^ offset of first element | 68 | V { ioff :: {-# UNPACK #-} !Int -- ^ offset of first element |
@@ -65,11 +81,13 @@ unsafeFromForeignPtr fp i n | n > 0 = V {ioff = i, idim = n, fptr = fp} | |||
65 | unsafeWith (V i _ fp) m = withForeignPtr fp $ \p -> m (p `advancePtr` i) | 81 | unsafeWith (V i _ fp) m = withForeignPtr fp $ \p -> m (p `advancePtr` i) |
66 | {-# INLINE unsafeWith #-} | 82 | {-# INLINE unsafeWith #-} |
67 | 83 | ||
68 | |||
69 | -- | Number of elements | 84 | -- | Number of elements |
70 | dim :: Vector t -> Int | 85 | dim :: (Storable t) => Vector t -> Int |
71 | dim = idim | 86 | dim = idim |
72 | 87 | ||
88 | #endif | ||
89 | |||
90 | |||
73 | -- C-Haskell vector adapter | 91 | -- C-Haskell vector adapter |
74 | -- vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r | 92 | -- vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r |
75 | vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b | 93 | vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b |
@@ -85,7 +103,7 @@ createVector :: Storable a => Int -> IO (Vector a) | |||
85 | createVector n = do | 103 | createVector n = do |
86 | when (n <= 0) $ error ("trying to createVector of dim "++show n) | 104 | when (n <= 0) $ error ("trying to createVector of dim "++show n) |
87 | fp <- doMalloc undefined | 105 | fp <- doMalloc undefined |
88 | return $ V 0 n fp | 106 | return $ unsafeFromForeignPtr fp 0 n |
89 | where | 107 | where |
90 | -- | 108 | -- |
91 | -- Use the much cheaper Haskell heap allocated storage | 109 | -- Use the much cheaper Haskell heap allocated storage |
@@ -177,6 +195,12 @@ subVector :: Storable t => Int -- ^ index of the starting element | |||
177 | -> Vector t -- ^ source | 195 | -> Vector t -- ^ source |
178 | -> Vector t -- ^ result | 196 | -> Vector t -- ^ result |
179 | 197 | ||
198 | #ifdef VECTOR | ||
199 | |||
200 | subVector = Vector.slice | ||
201 | |||
202 | #else | ||
203 | |||
180 | subVector k l v@V{idim = n, ioff = i} | 204 | subVector k l v@V{idim = n, ioff = i} |
181 | | k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range" | 205 | | k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range" |
182 | | otherwise = v {idim = l, ioff = i+k} | 206 | | otherwise = v {idim = l, ioff = i+k} |
@@ -189,6 +213,8 @@ subVectorCopy k l (v@V {idim=n}) | |||
189 | app2 f vec v vec r "subVector" | 213 | app2 f vec v vec r "subVector" |
190 | return r | 214 | return r |
191 | 215 | ||
216 | #endif | ||
217 | |||
192 | {- | Reads a vector position: | 218 | {- | Reads a vector position: |
193 | 219 | ||
194 | @> fromList [0..9] \@\> 7 | 220 | @> fromList [0..9] \@\> 7 |
@@ -239,16 +265,21 @@ takesV ms w | sum ms > dim w = error $ "takesV " ++ show ms ++ " on dim = " ++ ( | |||
239 | 265 | ||
240 | -- | transforms a complex vector into a real vector with alternating real and imaginary parts | 266 | -- | transforms a complex vector into a real vector with alternating real and imaginary parts |
241 | asReal :: Vector (Complex Double) -> Vector Double | 267 | asReal :: Vector (Complex Double) -> Vector Double |
242 | asReal v = V { ioff = 2*ioff v, idim = 2*dim v, fptr = castForeignPtr (fptr v) } | 268 | --asReal v = V { ioff = 2*ioff v, idim = 2*dim v, fptr = castForeignPtr (fptr v) } |
269 | asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n) | ||
270 | where (fp,i,n) = unsafeToForeignPtr v | ||
243 | 271 | ||
244 | -- | transforms a real vector into a complex vector with alternating real and imaginary parts | 272 | -- | transforms a real vector into a complex vector with alternating real and imaginary parts |
245 | asComplex :: Vector Double -> Vector (Complex Double) | 273 | asComplex :: Vector Double -> Vector (Complex Double) |
246 | asComplex v = V { ioff = ioff v `div` 2, idim = dim v `div` 2, fptr = castForeignPtr (fptr v) } | 274 | --asComplex v = V { ioff = ioff v `div` 2, idim = dim v `div` 2, fptr = castForeignPtr (fptr v) } |
275 | asComplex v = unsafeFromForeignPtr (castForeignPtr fp) (i `div` 2) (n `div` 2) | ||
276 | where (fp,i,n) = unsafeToForeignPtr v | ||
247 | 277 | ||
248 | ---------------------------------------------------------------- | 278 | ---------------------------------------------------------------- |
249 | 279 | ||
250 | cloneVector :: Storable t => Vector t -> IO (Vector t) | 280 | cloneVector :: Storable t => Vector t -> IO (Vector t) |
251 | cloneVector (v@V {idim=n}) = do | 281 | cloneVector v = do |
282 | let n = dim v | ||
252 | r <- createVector n | 283 | r <- createVector n |
253 | let f _ s _ d = copyArray d s n >> return 0 | 284 | let f _ s _ d = copyArray d s n >> return 0 |
254 | app2 f vec v vec r "cloneVector" | 285 | app2 f vec v vec r "cloneVector" |
diff --git a/lib/Numeric/LinearAlgebra/Instances.hs b/lib/Numeric/LinearAlgebra/Instances.hs index b4a769e..1992db0 100644 --- a/lib/Numeric/LinearAlgebra/Instances.hs +++ b/lib/Numeric/LinearAlgebra/Instances.hs | |||
@@ -24,10 +24,11 @@ import Numeric.GSL.Vector | |||
24 | import Data.Packed.Matrix | 24 | import Data.Packed.Matrix |
25 | import Data.Complex | 25 | import Data.Complex |
26 | import Data.List(transpose,intersperse) | 26 | import Data.List(transpose,intersperse) |
27 | import Foreign(Storable) | ||
28 | -- import Data.Monoid | ||
29 | import Data.Packed.Internal.Vector | 27 | import Data.Packed.Internal.Vector |
30 | -- import Control.Parallel.Strategies | 28 | |
29 | #ifndef VECTOR | ||
30 | import Foreign(Storable) | ||
31 | #endif | ||
31 | 32 | ||
32 | ------------------------------------------------------------------ | 33 | ------------------------------------------------------------------ |
33 | 34 | ||
@@ -43,9 +44,13 @@ dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unw | |||
43 | pad n str = replicate (n - length str) ' ' ++ str | 44 | pad n str = replicate (n - length str) ' ' ++ str |
44 | unwords' = concat . intersperse ", " | 45 | unwords' = concat . intersperse ", " |
45 | 46 | ||
47 | #ifndef VECTOR | ||
48 | |||
46 | instance (Show a, Storable a) => (Show (Vector a)) where | 49 | instance (Show a, Storable a) => (Show (Vector a)) where |
47 | show v = (show (dim v))++" |> " ++ show (toList v) | 50 | show v = (show (dim v))++" |> " ++ show (toList v) |
48 | 51 | ||
52 | #endif | ||
53 | |||
49 | ------------------------------------------------------------------ | 54 | ------------------------------------------------------------------ |
50 | 55 | ||
51 | instance (Element a, Read a) => Read (Matrix a) where | 56 | instance (Element a, Read a) => Read (Matrix a) where |
@@ -55,12 +60,23 @@ instance (Element a, Read a) => Read (Matrix a) where | |||
55 | cs = read . init . fst. breakAt ')' . snd . breakAt '<' $ dims | 60 | cs = read . init . fst. breakAt ')' . snd . breakAt '<' $ dims |
56 | rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims | 61 | rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims |
57 | 62 | ||
63 | #ifdef VECTOR | ||
64 | |||
65 | instance (Element a, Read a) => Read (Vector a) where | ||
66 | readsPrec _ s = [(fromList . read $ listnums, rest)] | ||
67 | where (thing,trest) = breakAt ']' s | ||
68 | (dims,listnums) = breakAt ' ' (dropWhile (==' ') thing) | ||
69 | rest = drop 31 trest | ||
70 | #else | ||
71 | |||
58 | instance (Element a, Read a) => Read (Vector a) where | 72 | instance (Element a, Read a) => Read (Vector a) where |
59 | readsPrec _ s = [((d |>) . read $ listnums, rest)] | 73 | readsPrec _ s = [((d |>) . read $ listnums, rest)] |
60 | where (thing,rest) = breakAt ']' s | 74 | where (thing,rest) = breakAt ']' s |
61 | (dims,listnums) = breakAt '>' thing | 75 | (dims,listnums) = breakAt '>' thing |
62 | d = read . init . fst . breakAt '|' $ dims | 76 | d = read . init . fst . breakAt '|' $ dims |
63 | 77 | ||
78 | #endif | ||
79 | |||
64 | breakAt c l = (a++[c],tail b) where | 80 | breakAt c l = (a++[c],tail b) where |
65 | (a,b) = break (==c) l | 81 | (a,b) = break (==c) l |
66 | 82 | ||
@@ -71,10 +87,13 @@ adaptScalar f1 f2 f3 x y | |||
71 | | dim y == 1 = f3 x (y@>0) | 87 | | dim y == 1 = f3 x (y@>0) |
72 | | otherwise = f2 x y | 88 | | otherwise = f2 x y |
73 | 89 | ||
90 | #ifndef VECTOR | ||
74 | 91 | ||
75 | instance Linear Vector a => Eq (Vector a) where | 92 | instance Linear Vector a => Eq (Vector a) where |
76 | (==) = equal | 93 | (==) = equal |
77 | 94 | ||
95 | #endif | ||
96 | |||
78 | instance Num (Vector Double) where | 97 | instance Num (Vector Double) where |
79 | (+) = adaptScalar addConstant add (flip addConstant) | 98 | (+) = adaptScalar addConstant add (flip addConstant) |
80 | negate = scale (-1) | 99 | negate = scale (-1) |