summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hmatrix.cabal8
-rw-r--r--lib/Data/Packed/Internal/Vector.hs43
-rw-r--r--lib/Numeric/LinearAlgebra/Instances.hs25
3 files changed, 67 insertions, 9 deletions
diff --git a/hmatrix.cabal b/hmatrix.cabal
index e684acc..cbf4a55 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -65,6 +65,10 @@ flag unsafe
65 description: Compile the library with bound checking disabled. 65 description: Compile the library with bound checking disabled.
66 default: False 66 default: False
67 67
68flag vector
69 description: Use Data.Vector.Storable type from "vector" package.
70 default: False
71
68library 72library
69 73
70 Build-Depends: base >= 4 && < 5, 74 Build-Depends: base >= 4 && < 5,
@@ -110,6 +114,10 @@ library
110 C-sources: lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c, 114 C-sources: lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c,
111 lib/Numeric/GSL/gsl-aux.c 115 lib/Numeric/GSL/gsl-aux.c
112 116
117 if flag(vector)
118 Build-Depends: vector
119 cpp-options: -DVECTOR
120
113 if flag(tests) 121 if flag(tests)
114 Build-Depends: QuickCheck, HUnit 122 Build-Depends: QuickCheck, HUnit
115 exposed-modules: Numeric.LinearAlgebra.Tests 123 exposed-modules: Numeric.LinearAlgebra.Tests
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
47import GHC.IOBase 47import GHC.IOBase
48#endif 48#endif
49 49
50#ifdef VECTOR
51import qualified Data.Vector.Storable as Vector
52import Data.Vector.Storable(Vector,
53 unsafeToForeignPtr,
54 unsafeFromForeignPtr,
55 unsafeWith)
56#endif
57
58#ifdef VECTOR
59
60-- | Number of elements
61dim :: (Storable t) => Vector t -> Int
62dim = 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.
51data Vector t = 67data 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}
65unsafeWith (V i _ fp) m = withForeignPtr fp $ \p -> m (p `advancePtr` i) 81unsafeWith (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
70dim :: Vector t -> Int 85dim :: (Storable t) => Vector t -> Int
71dim = idim 86dim = 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
75vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b 93vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b
@@ -85,7 +103,7 @@ createVector :: Storable a => Int -> IO (Vector a)
85createVector n = do 103createVector 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
200subVector = Vector.slice
201
202#else
203
180subVector k l v@V{idim = n, ioff = i} 204subVector 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
241asReal :: Vector (Complex Double) -> Vector Double 267asReal :: Vector (Complex Double) -> Vector Double
242asReal 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) }
269asReal 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
245asComplex :: Vector Double -> Vector (Complex Double) 273asComplex :: Vector Double -> Vector (Complex Double)
246asComplex 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) }
275asComplex v = unsafeFromForeignPtr (castForeignPtr fp) (i `div` 2) (n `div` 2)
276 where (fp,i,n) = unsafeToForeignPtr v
247 277
248---------------------------------------------------------------- 278----------------------------------------------------------------
249 279
250cloneVector :: Storable t => Vector t -> IO (Vector t) 280cloneVector :: Storable t => Vector t -> IO (Vector t)
251cloneVector (v@V {idim=n}) = do 281cloneVector 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
24import Data.Packed.Matrix 24import Data.Packed.Matrix
25import Data.Complex 25import Data.Complex
26import Data.List(transpose,intersperse) 26import Data.List(transpose,intersperse)
27import Foreign(Storable)
28-- import Data.Monoid
29import Data.Packed.Internal.Vector 27import Data.Packed.Internal.Vector
30-- import Control.Parallel.Strategies 28
29#ifndef VECTOR
30import 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
46instance (Show a, Storable a) => (Show (Vector a)) where 49instance (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
51instance (Element a, Read a) => Read (Matrix a) where 56instance (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
65instance (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
58instance (Element a, Read a) => Read (Vector a) where 72instance (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
64breakAt c l = (a++[c],tail b) where 80breakAt 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
75instance Linear Vector a => Eq (Vector a) where 92instance Linear Vector a => Eq (Vector a) where
76 (==) = equal 93 (==) = equal
77 94
95#endif
96
78instance Num (Vector Double) where 97instance Num (Vector Double) where
79 (+) = adaptScalar addConstant add (flip addConstant) 98 (+) = adaptScalar addConstant add (flip addConstant)
80 negate = scale (-1) 99 negate = scale (-1)