diff options
Diffstat (limited to 'lib/Data')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 8 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 25 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/auxi.c | 26 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/auxi.h | 3 | ||||
-rw-r--r-- | lib/Data/Packed/Matrix.hs | 11 |
5 files changed, 10 insertions, 63 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index bce9922..1b63dd8 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -101,9 +101,6 @@ check msg f = do | |||
101 | foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) | 101 | foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) |
102 | 102 | ||
103 | --------------------------------------------------- | 103 | --------------------------------------------------- |
104 | -- ugly, but my haddock version doesn't understand | ||
105 | -- yet infix type constructors | ||
106 | --------------------------------------------------- | ||
107 | ---------- signatures of the C functions --------- | 104 | ---------- signatures of the C functions --------- |
108 | -------------------------------------------------- | 105 | -------------------------------------------------- |
109 | type PD = Ptr Double -- | 106 | type PD = Ptr Double -- |
@@ -141,8 +138,3 @@ type TCVM = CInt -> PC -> TM -- | |||
141 | type TMCVM = CInt -> CInt -> PD -> TCVM -- | 138 | type TMCVM = CInt -> CInt -> PD -> TCVM -- |
142 | type TMMCVM = CInt -> CInt -> PD -> TMCVM -- | 139 | type TMMCVM = CInt -> CInt -> PD -> TMCVM -- |
143 | -------------------------------------------------- | 140 | -------------------------------------------------- |
144 | |||
145 | type TauxMul a = CInt -> CInt -> CInt -> Ptr a | ||
146 | -> CInt -> CInt -> CInt -> Ptr a | ||
147 | -> CInt -> CInt -> Ptr a | ||
148 | -> IO CInt | ||
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index 63f0a8d..51fb6f8 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -213,19 +213,16 @@ class (Storable a, Floating a) => Element a where | |||
213 | subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position | 213 | subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position |
214 | -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix | 214 | -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix |
215 | -> Matrix a -> Matrix a | 215 | -> Matrix a -> Matrix a |
216 | diagD :: Vector a -> Matrix a | ||
217 | 216 | ||
218 | instance Element Double where | 217 | instance Element Double where |
219 | constantD = constantR | 218 | constantD = constantR |
220 | transdata = transdataR | 219 | transdata = transdataR |
221 | subMatrixD = subMatrixR | 220 | subMatrixD = subMatrixR |
222 | diagD = diagR | ||
223 | 221 | ||
224 | instance Element (Complex Double) where | 222 | instance Element (Complex Double) where |
225 | constantD = constantC | 223 | constantD = constantC |
226 | transdata = transdataC | 224 | transdata = transdataC |
227 | subMatrixD = subMatrixC | 225 | subMatrixD = subMatrixC |
228 | diagD = diagC | ||
229 | 226 | ||
230 | ------------------------------------------------------------------ | 227 | ------------------------------------------------------------------ |
231 | 228 | ||
@@ -287,28 +284,6 @@ subMatrix :: Element a | |||
287 | -> Matrix a -- ^ result | 284 | -> Matrix a -- ^ result |
288 | subMatrix = subMatrixD | 285 | subMatrix = subMatrixD |
289 | 286 | ||
290 | |||
291 | --------------------------------------------------------------------- | ||
292 | |||
293 | diagAux fun msg (v@V {dim = n}) = unsafePerformIO $ do | ||
294 | m <- createMatrix RowMajor n n | ||
295 | app2 fun vec v mat m msg | ||
296 | return m | ||
297 | |||
298 | -- | diagonal matrix from a real vector | ||
299 | diagR :: Vector Double -> Matrix Double | ||
300 | diagR = diagAux c_diagR "diagR" | ||
301 | foreign import ccall "auxi.h diagR" c_diagR :: TVM | ||
302 | |||
303 | -- | diagonal matrix from a real vector | ||
304 | diagC :: Vector (Complex Double) -> Matrix (Complex Double) | ||
305 | diagC = diagAux c_diagC "diagC" | ||
306 | foreign import ccall "auxi.h diagC" c_diagC :: TCVCM | ||
307 | |||
308 | -- | creates a square matrix with the given diagonal | ||
309 | diag :: Element a => Vector a -> Matrix a | ||
310 | diag = diagD | ||
311 | |||
312 | ------------------------------------------------------------------------ | 287 | ------------------------------------------------------------------------ |
313 | 288 | ||
314 | constantAux fun x n = unsafePerformIO $ do | 289 | constantAux fun x n = unsafePerformIO $ do |
diff --git a/lib/Data/Packed/Internal/auxi.c b/lib/Data/Packed/Internal/auxi.c index bbb8cd4..c449b9a 100644 --- a/lib/Data/Packed/Internal/auxi.c +++ b/lib/Data/Packed/Internal/auxi.c | |||
@@ -113,32 +113,6 @@ int constantC(gsl_complex* pval, CVEC(r)) { | |||
113 | } | 113 | } |
114 | 114 | ||
115 | 115 | ||
116 | int diagR(KRVEC(d),RMAT(r)) { | ||
117 | REQUIRES(dn==rr && rr==rc,BAD_SIZE); | ||
118 | DEBUGMSG("diagR"); | ||
119 | int i,j; | ||
120 | for (i=0;i<rr;i++) { | ||
121 | for(j=0;j<rc;j++) { | ||
122 | rp[i*rc+j] = i==j?dp[i]:0.; | ||
123 | } | ||
124 | } | ||
125 | OK | ||
126 | } | ||
127 | |||
128 | int diagC(KCVEC(d),CMAT(r)) { | ||
129 | REQUIRES(dn==rr && rr==rc,BAD_SIZE); | ||
130 | DEBUGMSG("diagC"); | ||
131 | int i,j; | ||
132 | gsl_complex zero; | ||
133 | GSL_SET_COMPLEX(&zero,0.,0.); | ||
134 | for (i=0;i<rr;i++) { | ||
135 | for(j=0;j<rc;j++) { | ||
136 | rp[i*rc+j] = i==j?dp[i]:zero; | ||
137 | } | ||
138 | } | ||
139 | OK | ||
140 | } | ||
141 | |||
142 | int conjugate(KCVEC(x),CVEC(t)) { | 116 | int conjugate(KCVEC(x),CVEC(t)) { |
143 | REQUIRES(xn==tn,BAD_SIZE); | 117 | REQUIRES(xn==tn,BAD_SIZE); |
144 | DEBUGMSG("conjugate"); | 118 | DEBUGMSG("conjugate"); |
diff --git a/lib/Data/Packed/Internal/auxi.h b/lib/Data/Packed/Internal/auxi.h index 507a30d..b57fdaf 100644 --- a/lib/Data/Packed/Internal/auxi.h +++ b/lib/Data/Packed/Internal/auxi.h | |||
@@ -18,9 +18,6 @@ int constantC(gsl_complex *val, CVEC(r)); | |||
18 | 18 | ||
19 | int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); | 19 | int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); |
20 | 20 | ||
21 | int diagR(KRVEC(d),RMAT(r)); | ||
22 | int diagC(KCVEC(d),CMAT(r)); | ||
23 | |||
24 | const char * gsl_strerror (const int gsl_errno); | 21 | const char * gsl_strerror (const int gsl_errno); |
25 | 22 | ||
26 | int matrix_fscanf(char*filename, RMAT(a)); | 23 | int matrix_fscanf(char*filename, RMAT(a)); |
diff --git a/lib/Data/Packed/Matrix.hs b/lib/Data/Packed/Matrix.hs index 7d2c564..c56bf3d 100644 --- a/lib/Data/Packed/Matrix.hs +++ b/lib/Data/Packed/Matrix.hs | |||
@@ -33,6 +33,7 @@ module Data.Packed.Matrix ( | |||
33 | ) where | 33 | ) where |
34 | 34 | ||
35 | import Data.Packed.Internal | 35 | import Data.Packed.Internal |
36 | import qualified Data.Packed.ST as ST | ||
36 | import Data.Packed.Vector | 37 | import Data.Packed.Vector |
37 | import Data.List(transpose,intersperse) | 38 | import Data.List(transpose,intersperse) |
38 | import Data.Array | 39 | import Data.Array |
@@ -73,6 +74,14 @@ fliprl m = fromColumns . reverse . toColumns $ m | |||
73 | 74 | ||
74 | ------------------------------------------------------------ | 75 | ------------------------------------------------------------ |
75 | 76 | ||
77 | -- | Creates a square matrix with a given diagonal. | ||
78 | diag :: Element a => Vector a -> Matrix a | ||
79 | diag v = ST.runSTMatrix $ do | ||
80 | let d = dim v | ||
81 | m <- ST.newMatrix 0 d d | ||
82 | mapM_ (\k -> ST.writeMatrix m k k (v@>k)) [0..d-1] | ||
83 | return m | ||
84 | |||
76 | {- | creates a rectangular diagonal matrix | 85 | {- | creates a rectangular diagonal matrix |
77 | 86 | ||
78 | @> diagRect (constant 5 3) 3 4 | 87 | @> diagRect (constant 5 3) 3 4 |
@@ -87,7 +96,7 @@ diagRect s r c | |||
87 | | r == c = diag s | 96 | | r == c = diag s |
88 | | r < c = trans $ diagRect s c r | 97 | | r < c = trans $ diagRect s c r |
89 | | otherwise = joinVert [diag s , zeros (r-c,c)] | 98 | | otherwise = joinVert [diag s , zeros (r-c,c)] |
90 | where zeros (r',c') = reshape c' $ constantD 0 (r'*c') | 99 | where zeros (r',c') = reshape c' $ constant 0 (r'*c') |
91 | 100 | ||
92 | -- | extracts the diagonal from a rectangular matrix | 101 | -- | extracts the diagonal from a rectangular matrix |
93 | takeDiag :: (Element t) => Matrix t -> Vector t | 102 | takeDiag :: (Element t) => Matrix t -> Vector t |