summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/base/src/C/lapack-aux.c28
-rw-r--r--packages/base/src/C/lapack-aux.h18
-rw-r--r--packages/base/src/Data/Packed/Internal/Matrix.hs52
-rw-r--r--packages/base/src/Data/Packed/Internal/Numeric.hs2
-rw-r--r--packages/base/src/Data/Packed/Internal/Signatures.hs2
-rw-r--r--packages/base/src/Data/Packed/Numeric.hs8
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Data.hs2
7 files changed, 103 insertions, 9 deletions
diff --git a/packages/base/src/C/lapack-aux.c b/packages/base/src/C/lapack-aux.c
index 77381cc..a977d5f 100644
--- a/packages/base/src/C/lapack-aux.c
+++ b/packages/base/src/C/lapack-aux.c
@@ -1670,3 +1670,31 @@ int extractI(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KIMAT(m), IMAT(r)
1670 EXTRACT_IMP 1670 EXTRACT_IMP
1671} 1671}
1672 1672
1673//////////////////////// remap /////////////////////////////////
1674
1675#define REMAP_IMP \
1676 REQUIRES(ir==jr && ic==jc && ir==rr && ic==rc ,BAD_SIZE); \
1677 { TRAV(r,a,b) { AT(r,a,b) = AT(m,AT(i,a,b),AT(j,a,b)); } \
1678 } \
1679 OK
1680
1681int remapD(KOIMAT(i), KOIMAT(j), KODMAT(m), ODMAT(r)) {
1682 REMAP_IMP
1683}
1684
1685int remapF(KOIMAT(i), KOIMAT(j), KOFMAT(m), OFMAT(r)) {
1686 REMAP_IMP
1687}
1688
1689int remapI(KOIMAT(i), KOIMAT(j), KOIMAT(m), OIMAT(r)) {
1690 REMAP_IMP
1691}
1692
1693int remapC(KOIMAT(i), KOIMAT(j), KOCMAT(m), OCMAT(r)) {
1694 REMAP_IMP
1695}
1696
1697int remapQ(KOIMAT(i), KOIMAT(j), KOQMAT(m), OQMAT(r)) {
1698 REMAP_IMP
1699}
1700
diff --git a/packages/base/src/C/lapack-aux.h b/packages/base/src/C/lapack-aux.h
index b49c7c9..6ffbef1 100644
--- a/packages/base/src/C/lapack-aux.h
+++ b/packages/base/src/C/lapack-aux.h
@@ -42,6 +42,7 @@ typedef short ftnlen;
42#define QVEC(A) int A##n, complex*A##p 42#define QVEC(A) int A##n, complex*A##p
43#define CVEC(A) int A##n, doublecomplex*A##p 43#define CVEC(A) int A##n, doublecomplex*A##p
44#define PVEC(A) int A##n, void* A##p, int A##s 44#define PVEC(A) int A##n, void* A##p, int A##s
45
45#define IMAT(A) int A##r, int A##c, int* A##p 46#define IMAT(A) int A##r, int A##c, int* A##p
46#define FMAT(A) int A##r, int A##c, float* A##p 47#define FMAT(A) int A##r, int A##c, float* A##p
47#define DMAT(A) int A##r, int A##c, double* A##p 48#define DMAT(A) int A##r, int A##c, double* A##p
@@ -49,12 +50,20 @@ typedef short ftnlen;
49#define CMAT(A) int A##r, int A##c, doublecomplex* A##p 50#define CMAT(A) int A##r, int A##c, doublecomplex* A##p
50#define PMAT(A) int A##r, int A##c, void* A##p, int A##s 51#define PMAT(A) int A##r, int A##c, void* A##p, int A##s
51 52
53#define OIMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, int* A##p
54#define OFMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, float* A##p
55#define ODMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, double* A##p
56#define OQMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, complex* A##p
57#define OCMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, doublecomplex* A##p
58
59
52#define KIVEC(A) int A##n, const int*A##p 60#define KIVEC(A) int A##n, const int*A##p
53#define KFVEC(A) int A##n, const float*A##p 61#define KFVEC(A) int A##n, const float*A##p
54#define KDVEC(A) int A##n, const double*A##p 62#define KDVEC(A) int A##n, const double*A##p
55#define KQVEC(A) int A##n, const complex*A##p 63#define KQVEC(A) int A##n, const complex*A##p
56#define KCVEC(A) int A##n, const doublecomplex*A##p 64#define KCVEC(A) int A##n, const doublecomplex*A##p
57#define KPVEC(A) int A##n, const void* A##p, int A##s 65#define KPVEC(A) int A##n, const void* A##p, int A##s
66
58#define KIMAT(A) int A##r, int A##c, const int* A##p 67#define KIMAT(A) int A##r, int A##c, const int* A##p
59#define KFMAT(A) int A##r, int A##c, const float* A##p 68#define KFMAT(A) int A##r, int A##c, const float* A##p
60#define KDMAT(A) int A##r, int A##c, const double* A##p 69#define KDMAT(A) int A##r, int A##c, const double* A##p
@@ -62,3 +71,12 @@ typedef short ftnlen;
62#define KCMAT(A) int A##r, int A##c, const doublecomplex* A##p 71#define KCMAT(A) int A##r, int A##c, const doublecomplex* A##p
63#define KPMAT(A) int A##r, int A##c, const void* A##p, int A##s 72#define KPMAT(A) int A##r, int A##c, const void* A##p, int A##s
64 73
74#define KOIMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, const int* A##p
75#define KOFMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, const float* A##p
76#define KODMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, const double* A##p
77#define KOQMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, const complex* A##p
78#define KOCMAT(A) int A##r, int A##c, int A##Xr, int A##Xc, const doublecomplex* A##p
79
80#define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc])
81#define TRAV(m,i,j) int i,j; for (i=0;i<m##r;i++) for (j=0;j<m##c;j++)
82
diff --git a/packages/base/src/Data/Packed/Internal/Matrix.hs b/packages/base/src/Data/Packed/Internal/Matrix.hs
index 82a9d8f..ddeddae 100644
--- a/packages/base/src/Data/Packed/Internal/Matrix.hs
+++ b/packages/base/src/Data/Packed/Internal/Matrix.hs
@@ -105,6 +105,14 @@ cols = icols
105orderOf :: Matrix t -> MatrixOrder 105orderOf :: Matrix t -> MatrixOrder
106orderOf = order 106orderOf = order
107 107
108stepRow :: Matrix t -> CInt
109stepRow Matrix {icols = c, order = RowMajor } = fromIntegral c
110stepRow _ = 1
111
112stepCol :: Matrix t -> CInt
113stepCol Matrix {irows = r, order = ColumnMajor } = fromIntegral r
114stepCol _ = 1
115
108 116
109-- | Matrix transpose. 117-- | Matrix transpose.
110trans :: Matrix t -> Matrix t 118trans :: Matrix t -> Matrix t
@@ -128,6 +136,14 @@ mat a f =
128 g (fi (rows a)) (fi (cols a)) p 136 g (fi (rows a)) (fi (cols a)) p
129 f m 137 f m
130 138
139omat :: (Storable t) => Matrix t -> (((CInt -> CInt -> CInt -> CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b
140omat a f =
141 unsafeWith (xdat a) $ \p -> do
142 let m g = do
143 g (fi (rows a)) (fi (cols a)) (stepRow a) (stepCol a) p
144 f m
145
146
131{- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose. 147{- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose.
132 148
133>>> flatten (ident 3) 149>>> flatten (ident 3)
@@ -257,7 +273,7 @@ compat m1 m2 = rows m1 == rows m2 && cols m1 == cols m2
257 >instance Element Foo 273 >instance Element Foo
258-} 274-}
259class (Storable a) => Element a where 275class (Storable a) => Element a where
260 subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position 276 subMatrixD :: (Int,Int) -- ^ (r0,c0) starting position
261 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix 277 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
262 -> Matrix a -> Matrix a 278 -> Matrix a -> Matrix a
263 subMatrixD = subMatrix' 279 subMatrixD = subMatrix'
@@ -270,6 +286,7 @@ class (Storable a) => Element a where
270 sortV :: Ord a => Vector a -> Vector a 286 sortV :: Ord a => Vector a -> Vector a
271 compareV :: Ord a => Vector a -> Vector a -> Vector CInt 287 compareV :: Ord a => Vector a -> Vector a -> Vector CInt
272 selectV :: Vector CInt -> Vector a -> Vector a -> Vector a -> Vector a 288 selectV :: Vector CInt -> Vector a -> Vector a -> Vector a -> Vector a
289 remapM :: Matrix CInt -> Matrix CInt -> Matrix a -> Matrix a
273 290
274 291
275instance Element Float where 292instance Element Float where
@@ -280,7 +297,7 @@ instance Element Float where
280 sortV = sortValF 297 sortV = sortValF
281 compareV = compareF 298 compareV = compareF
282 selectV = selectF 299 selectV = selectF
283 300 remapM = remapF
284 301
285instance Element Double where 302instance Element Double where
286 transdata = transdataAux ctransR 303 transdata = transdataAux ctransR
@@ -290,6 +307,7 @@ instance Element Double where
290 sortV = sortValD 307 sortV = sortValD
291 compareV = compareD 308 compareV = compareD
292 selectV = selectD 309 selectV = selectD
310 remapM = remapD
293 311
294 312
295instance Element (Complex Float) where 313instance Element (Complex Float) where
@@ -300,6 +318,7 @@ instance Element (Complex Float) where
300 sortV = undefined 318 sortV = undefined
301 compareV = undefined 319 compareV = undefined
302 selectV = selectQ 320 selectV = selectQ
321 remapM = remapQ
303 322
304 323
305instance Element (Complex Double) where 324instance Element (Complex Double) where
@@ -310,8 +329,8 @@ instance Element (Complex Double) where
310 sortV = undefined 329 sortV = undefined
311 compareV = undefined 330 compareV = undefined
312 selectV = selectC 331 selectV = selectC
332 remapM = remapC
313 333
314
315instance Element (CInt) where 334instance Element (CInt) where
316 transdata = transdataAux ctransI 335 transdata = transdataAux ctransI
317 constantD = constantAux cconstantI 336 constantD = constantAux cconstantI
@@ -320,7 +339,7 @@ instance Element (CInt) where
320 sortV = sortValI 339 sortV = sortValI
321 compareV = compareI 340 compareV = compareI
322 selectV = selectI 341 selectV = selectI
323 342 remapM = remapI
324 343
325------------------------------------------------------------------- 344-------------------------------------------------------------------
326 345
@@ -394,7 +413,7 @@ foreign import ccall unsafe "constantP" cconstantP :: Ptr () -> CInt -> Ptr () -
394 413
395-- | Extracts a submatrix from a matrix. 414-- | Extracts a submatrix from a matrix.
396subMatrix :: Element a 415subMatrix :: Element a
397 => (Int,Int) -- ^ (r0,c0) starting position 416 => (Int,Int) -- ^ (r0,c0) starting position
398 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix 417 -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
399 -> Matrix a -- ^ input matrix 418 -> Matrix a -- ^ input matrix
400 -> Matrix a -- ^ result 419 -> Matrix a -- ^ result
@@ -427,7 +446,7 @@ conformMs ms = map (conformMTo (r,c)) ms
427 where 446 where
428 r = maxZ (map rows ms) 447 r = maxZ (map rows ms)
429 c = maxZ (map cols ms) 448 c = maxZ (map cols ms)
430 449
431 450
432conformVs vs = map (conformVTo n) vs 451conformVs vs = map (conformVTo n) vs
433 where 452 where
@@ -554,4 +573,25 @@ foreign import ccall unsafe "chooseI" c_selectI :: Sel CInt
554foreign import ccall unsafe "chooseC" c_selectC :: Sel (Complex Double) 573foreign import ccall unsafe "chooseC" c_selectC :: Sel (Complex Double)
555foreign import ccall unsafe "chooseQ" c_selectQ :: Sel (Complex Float) 574foreign import ccall unsafe "chooseQ" c_selectQ :: Sel (Complex Float)
556 575
576---------------------------------------------------------------------------
577
578remapG f i j m = unsafePerformIO $ do
579 r <- createMatrix RowMajor (rows i) (cols i)
580 app4 f omat i omat j omat m omat r "remapG"
581 return r
582
583remapD = remapG c_remapD
584remapF = remapG c_remapF
585remapI = remapG c_remapI
586remapC = remapG c_remapC
587remapQ = remapG c_remapQ
588
589type Rem x = OM CInt (OM CInt (OM x (OM x (IO CInt))))
590
591foreign import ccall unsafe "remapD" c_remapD :: Rem Double
592foreign import ccall unsafe "remapF" c_remapF :: Rem Float
593foreign import ccall unsafe "remapI" c_remapI :: Rem CInt
594foreign import ccall unsafe "remapC" c_remapC :: Rem (Complex Double)
595foreign import ccall unsafe "remapQ" c_remapQ :: Rem (Complex Float)
596
557 597
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs
index a241c48..67d047c 100644
--- a/packages/base/src/Data/Packed/Internal/Numeric.hs
+++ b/packages/base/src/Data/Packed/Internal/Numeric.hs
@@ -39,7 +39,7 @@ module Data.Packed.Internal.Numeric (
39 roundVector, fromInt, toInt, 39 roundVector, fromInt, toInt,
40 RealOf, ComplexOf, SingleOf, DoubleOf, 40 RealOf, ComplexOf, SingleOf, DoubleOf,
41 IndexOf, 41 IndexOf,
42 I, Extractor(..), (??), range, idxs, 42 I, Extractor(..), (??), range, idxs, remapM,
43 module Data.Complex 43 module Data.Complex
44) where 44) where
45 45
diff --git a/packages/base/src/Data/Packed/Internal/Signatures.hs b/packages/base/src/Data/Packed/Internal/Signatures.hs
index 37dac16..5c54498 100644
--- a/packages/base/src/Data/Packed/Internal/Signatures.hs
+++ b/packages/base/src/Data/Packed/Internal/Signatures.hs
@@ -71,5 +71,7 @@ type TMMCVM = CInt -> CInt -> PD -> TMCVM --
71type CM b r = CInt -> CInt -> Ptr b -> r 71type CM b r = CInt -> CInt -> Ptr b -> r
72type CV b r = CInt -> Ptr b -> r 72type CV b r = CInt -> Ptr b -> r
73 73
74type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r
75
74type CIdxs r = CV CInt r 76type CIdxs r = CV CInt r
75 77
diff --git a/packages/base/src/Data/Packed/Numeric.hs b/packages/base/src/Data/Packed/Numeric.hs
index 906bc83..80f1718 100644
--- a/packages/base/src/Data/Packed/Numeric.hs
+++ b/packages/base/src/Data/Packed/Numeric.hs
@@ -31,7 +31,7 @@ module Data.Packed.Numeric (
31 diag, ident, 31 diag, ident,
32 ctrans, 32 ctrans,
33 -- * Generic operations 33 -- * Generic operations
34 Container(..), Numeric, Extractor(..), (??), range, idxs, I, 34 Container(..), Numeric, Extractor(..), (??), range, idxs, I, remap,
35 -- add, mul, sub, divide, equal, scaleRecip, addConstant, 35 -- add, mul, sub, divide, equal, scaleRecip, addConstant,
36 scalar, conj, scale, arctan2, cmap, cmod, 36 scalar, conj, scale, arctan2, cmap, cmod,
37 atIndex, minIndex, maxIndex, minElement, maxElement, 37 atIndex, minIndex, maxIndex, minElement, maxElement,
@@ -315,3 +315,9 @@ ccompare = ccompare'
315cselect :: (Container c t) => c I -> c t -> c t -> c t -> c t 315cselect :: (Container c t) => c I -> c t -> c t -> c t -> c t
316cselect = cselect' 316cselect = cselect'
317 317
318remap :: Element t => Matrix I -> Matrix I -> Matrix t -> Matrix t
319remap i j m
320 | minElement i >= 0 && maxElement i < fromIntegral (rows m) &&
321 minElement j >= 0 && maxElement j < fromIntegral (cols m) = remapM i j m
322 | otherwise = error $ "out of range index in rmap"
323
diff --git a/packages/base/src/Numeric/LinearAlgebra/Data.hs b/packages/base/src/Numeric/LinearAlgebra/Data.hs
index 79dd06b..8bacb09 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Data.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Data.hs
@@ -53,7 +53,7 @@ module Numeric.LinearAlgebra.Data(
53 -- * Matrix extraction 53 -- * Matrix extraction
54 Extractor(..), (??), 54 Extractor(..), (??),
55 takeRows, dropRows, takeColumns, dropColumns, subMatrix, (?), (¿), fliprl, flipud, 55 takeRows, dropRows, takeColumns, dropColumns, subMatrix, (?), (¿), fliprl, flipud,
56 56 remap,
57 57
58 -- * Block matrix 58 -- * Block matrix
59 fromBlocks, (|||), (===), diagBlock, repmat, toBlocks, toBlocksEvery, 59 fromBlocks, (|||), (===), diagBlock, repmat, toBlocks, toBlocksEvery,