summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Internal')
-rw-r--r--lib/Data/Packed/Internal/Matrix.hs37
-rw-r--r--lib/Data/Packed/Internal/Vector.hs27
-rw-r--r--lib/Data/Packed/Internal/aux.c13
-rw-r--r--lib/Data/Packed/Internal/aux.h2
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
101reshape c v = matrixFromVector RowMajor c v
102
101transdataG :: Storable a => Int -> Vector a -> Int -> Vector a 103transdataG :: Storable a => Int -> Vector a -> Int -> Vector a
102transdataG c1 d c2 = fromList . concat . transpose . partit c1 . toList $ d 104transdataG 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
185multiplyT order a b = multiplyD order (trans b) (trans a) 187multiplyT order a b = multiplyD order (trans b) (trans a)
186 188
187multiplyD order a b 189multiplyD 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
197subMatrixR :: (Int,Int) -- ^ (r0,c0) starting position
198 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
199 -> Matrix Double -> Matrix Double
200subMatrixR (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
204foreign 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
208subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position
209 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
210 -> Matrix (Complex Double) -> Matrix (Complex Double)
211subMatrixC (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
216subMatrix :: (Field a)
217 => (Int,Int) -- ^ (r0,c0) starting position
218 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
219 -> Matrix a -> Matrix a
220subMatrix 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
225subMatrixG (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
124join :: Field t => [Vector t] -> Vector t 124join :: Field t => [Vector t] -> Vector t
125join [] = error "joining an empty list" 125join [] = error "joining zero vectors"
126join as = unsafePerformIO $ do 126join 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
139asReal :: Vector (Complex Double) -> Vector Double
140asReal 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
143asComplex :: Vector Double -> Vector (Complex Double)
144asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) }
145
139constantG n x = fromList (replicate n x) 146constantG n x = fromList (replicate n x)
140 147
141constantR :: Int -> Double -> Vector Double 148constantR :: 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
92int 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
92int constantR(double * pval, RVEC(r)) { 105int 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
20int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r)); 20int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r));
21int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r)); 21int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r));
22
23int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r));