diff options
Diffstat (limited to 'lib/Data/Packed/Internal')
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 37 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 27 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/aux.c | 13 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/aux.h | 2 |
4 files changed, 68 insertions, 11 deletions
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index a6f7f0c..a2a70dd 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -98,6 +98,8 @@ createMatrix order r c = do | |||
98 | p <- createVector (r*c) | 98 | p <- createVector (r*c) |
99 | return (matrixFromVector order c p) | 99 | return (matrixFromVector order c p) |
100 | 100 | ||
101 | reshape c v = matrixFromVector RowMajor c v | ||
102 | |||
101 | transdataG :: Storable a => Int -> Vector a -> Int -> Vector a | 103 | transdataG :: Storable a => Int -> Vector a -> Int -> Vector a |
102 | transdataG c1 d c2 = fromList . concat . transpose . partit c1 . toList $ d | 104 | transdataG c1 d c2 = fromList . concat . transpose . partit c1 . toList $ d |
103 | 105 | ||
@@ -184,8 +186,41 @@ multiply ColumnMajor a b = trans $ multiplyT ColumnMajor a b | |||
184 | 186 | ||
185 | multiplyT order a b = multiplyD order (trans b) (trans a) | 187 | multiplyT order a b = multiplyD order (trans b) (trans a) |
186 | 188 | ||
187 | multiplyD order a b | 189 | multiplyD order a b |
188 | | isReal (baseOf.dat) a = scast $ multiplyAux order cmultiplyR (scast a) (scast b) | 190 | | isReal (baseOf.dat) a = scast $ multiplyAux order cmultiplyR (scast a) (scast b) |
189 | | isComp (baseOf.dat) a = scast $ multiplyAux order cmultiplyC (scast a) (scast b) | 191 | | isComp (baseOf.dat) a = scast $ multiplyAux order cmultiplyC (scast a) (scast b) |
190 | | otherwise = multiplyG a b | 192 | | otherwise = multiplyG a b |
191 | 193 | ||
194 | ---------------------------------------------------------------------- | ||
195 | |||
196 | -- | extraction of a submatrix of a real matrix | ||
197 | subMatrixR :: (Int,Int) -- ^ (r0,c0) starting position | ||
198 | -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix | ||
199 | -> Matrix Double -> Matrix Double | ||
200 | subMatrixR (r0,c0) (rt,ct) x = unsafePerformIO $ do | ||
201 | r <- createMatrix RowMajor rt ct | ||
202 | c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1) // mat cdat x // mat cdat r // check "subMatrixR" [dat r] | ||
203 | return r | ||
204 | foreign import ccall "aux.h submatrixR" | ||
205 | c_submatrixR :: Int -> Int -> Int -> Int -> Double ::> Double ::> IO Int | ||
206 | |||
207 | -- | extraction of a submatrix of a complex matrix | ||
208 | subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position | ||
209 | -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix | ||
210 | -> Matrix (Complex Double) -> Matrix (Complex Double) | ||
211 | subMatrixC (r0,c0) (rt,ct) x = | ||
212 | reshape ct . asComplex . cdat . | ||
213 | subMatrixR (r0,2*c0) (rt,2*ct) . | ||
214 | reshape (2*cols x) . asReal . cdat $ x | ||
215 | |||
216 | subMatrix :: (Field a) | ||
217 | => (Int,Int) -- ^ (r0,c0) starting position | ||
218 | -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix | ||
219 | -> Matrix a -> Matrix a | ||
220 | subMatrix st sz m | ||
221 | | isReal (baseOf.dat) m = scast $ subMatrixR st sz (scast m) | ||
222 | | isComp (baseOf.dat) m = scast $ subMatrixC st sz (scast m) | ||
223 | | otherwise = subMatrixG st sz m | ||
224 | |||
225 | subMatrixG (r0,c0) (rt,ct) x = reshape ct $ fromList $ concat $ map (subList c0 ct) (subList r0 rt (toLists x)) | ||
226 | where subList s n = take n . drop s | ||
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 7dcefeb..6ed9339 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -119,23 +119,30 @@ subVector' k l (v@V {dim=n, ptr=p, fptr=fp}) | |||
119 | | otherwise = v {dim=l, ptr=advancePtr p k} | 119 | | otherwise = v {dim=l, ptr=advancePtr p k} |
120 | 120 | ||
121 | 121 | ||
122 | {- | 122 | |
123 | -- | creates a new Vector by joining a list of Vectors | 123 | -- | creates a new Vector by joining a list of Vectors |
124 | join :: Field t => [Vector t] -> Vector t | 124 | join :: Field t => [Vector t] -> Vector t |
125 | join [] = error "joining an empty list" | 125 | join [] = error "joining zero vectors" |
126 | join as = unsafePerformIO $ do | 126 | join as = unsafePerformIO $ do |
127 | let tot = sum (map size as) | 127 | let tot = sum (map dim as) |
128 | p <- mallocForeignPtrArray tot | 128 | r@V {fptr = p, ptr = p'} <- createVector tot |
129 | withForeignPtr p $ \p -> | 129 | withForeignPtr p $ \_ -> |
130 | joiner as tot p | 130 | joiner as tot p' |
131 | return (V tot p) | 131 | return r |
132 | where joiner [] _ _ = return () | 132 | where joiner [] _ _ = return () |
133 | joiner (V n b : cs) _ p = do | 133 | joiner (V {dim = n, fptr = b, ptr = q} : cs) _ p = do |
134 | withForeignPtr b $ \b' -> copyArray p b' n | 134 | withForeignPtr b $ \_ -> copyArray p q n |
135 | joiner cs 0 (advancePtr p n) | 135 | joiner cs 0 (advancePtr p n) |
136 | -} | ||
137 | 136 | ||
138 | 137 | ||
138 | -- | transforms a complex vector into a real vector with alternating real and imaginary parts | ||
139 | asReal :: Vector (Complex Double) -> Vector Double | ||
140 | asReal v = V { dim = 2*dim v, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) } | ||
141 | |||
142 | -- | transforms a real vector into a complex vector with alternating real and imaginary parts | ||
143 | asComplex :: Vector Double -> Vector (Complex Double) | ||
144 | asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) } | ||
145 | |||
139 | constantG n x = fromList (replicate n x) | 146 | constantG n x = fromList (replicate n x) |
140 | 147 | ||
141 | constantR :: Int -> Double -> Vector Double | 148 | constantR :: Int -> Double -> Vector Double |
diff --git a/lib/Data/Packed/Internal/aux.c b/lib/Data/Packed/Internal/aux.c index da36035..01a2bb3 100644 --- a/lib/Data/Packed/Internal/aux.c +++ b/lib/Data/Packed/Internal/aux.c | |||
@@ -89,6 +89,19 @@ int transC(KCMAT(x),CMAT(t)) { | |||
89 | } | 89 | } |
90 | 90 | ||
91 | 91 | ||
92 | int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)) { | ||
93 | REQUIRES(0<=r1 && r1<=r2 && r2<xr && 0<=c1 && c1<=c2 && c2<xc && | ||
94 | rr==r2-r1+1 && rc==c2-c1+1,BAD_SIZE); | ||
95 | DEBUGMSG("submatrixR"); | ||
96 | KDMVIEW(x); | ||
97 | DMVIEW(r); | ||
98 | gsl_matrix_const_view S = gsl_matrix_const_submatrix(M(x),r1,c1,rr,rc); | ||
99 | int res = gsl_matrix_memcpy(M(r),M(S)); | ||
100 | CHECK(res,res); | ||
101 | OK | ||
102 | } | ||
103 | |||
104 | |||
92 | int constantR(double * pval, RVEC(r)) { | 105 | int constantR(double * pval, RVEC(r)) { |
93 | DEBUGMSG("constantR") | 106 | DEBUGMSG("constantR") |
94 | int k; | 107 | int k; |
diff --git a/lib/Data/Packed/Internal/aux.h b/lib/Data/Packed/Internal/aux.h index f45b55a..59d90db 100644 --- a/lib/Data/Packed/Internal/aux.h +++ b/lib/Data/Packed/Internal/aux.h | |||
@@ -19,3 +19,5 @@ int constantC(gsl_complex *val, CVEC(r)); | |||
19 | 19 | ||
20 | int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r)); | 20 | int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r)); |
21 | int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r)); | 21 | int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r)); |
22 | |||
23 | int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); | ||