summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2015-05-28 11:53:40 +0200
committerAlberto Ruiz <aruiz@um.es>2015-05-28 12:26:32 +0200
commitb717b2962e962812f9562915cf317b88599e5eb4 (patch)
tree5fe689dc4b85523f30adf2253f0dca02e20ba9cb
parenta4250d0887462b123aa4d2a3d21dddc323ee4ee1 (diff)
extract using omat
-rw-r--r--packages/base/src/C/lapack-aux.c19
-rw-r--r--packages/base/src/Data/Packed/Internal/Matrix.hs28
2 files changed, 14 insertions, 33 deletions
diff --git a/packages/base/src/C/lapack-aux.c b/packages/base/src/C/lapack-aux.c
index ac03120..1402050 100644
--- a/packages/base/src/C/lapack-aux.c
+++ b/packages/base/src/C/lapack-aux.c
@@ -1621,12 +1621,7 @@ int chooseQ(KIVEC(cond),KQVEC(lt),KQVEC(eq),KQVEC(gt),QVEC(r)) {
1621//////////////////////// extract ///////////////////////////////// 1621//////////////////////// extract /////////////////////////////////
1622 1622
1623#define EXTRACT_IMP \ 1623#define EXTRACT_IMP \
1624 int i,j,si,sj,ni,nj,ai,aj; \ 1624 int i,j,si,sj,ni,nj; \
1625 if (tm==0) { \
1626 ai=mc; aj=1; \
1627 } else { \
1628 ai=1, aj=mc; \
1629 } \
1630 ni = modei ? in : ip[1]-ip[0]+1; \ 1625 ni = modei ? in : ip[1]-ip[0]+1; \
1631 nj = modej ? jn : jp[1]-jp[0]+1; \ 1626 nj = modej ? jn : jp[1]-jp[0]+1; \
1632 \ 1627 \
@@ -1636,28 +1631,28 @@ int chooseQ(KIVEC(cond),KQVEC(lt),KQVEC(eq),KQVEC(gt),QVEC(r)) {
1636 for (j=0; j<nj; j++) { \ 1631 for (j=0; j<nj; j++) { \
1637 sj = modej ? jp[j] : j+jp[0]; \ 1632 sj = modej ? jp[j] : j+jp[0]; \
1638 \ 1633 \
1639 rp[rc*i+j] = mp[ai*si+aj*sj]; \ 1634 AT(r,i,j) = AT(m,si,sj); \
1640 } \ 1635 } \
1641 } \ 1636 } \
1642 OK 1637 OK
1643 1638
1644int extractD(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KDMAT(m), DMAT(r)) { 1639int extractD(int modei, int modej, KIVEC(i), KIVEC(j), KODMAT(m), ODMAT(r)) {
1645 EXTRACT_IMP 1640 EXTRACT_IMP
1646} 1641}
1647 1642
1648int extractF(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KFMAT(m), FMAT(r)) { 1643int extractF(int modei, int modej, KIVEC(i), KIVEC(j), KOFMAT(m), OFMAT(r)) {
1649 EXTRACT_IMP 1644 EXTRACT_IMP
1650} 1645}
1651 1646
1652int extractC(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KCMAT(m), CMAT(r)) { 1647int extractC(int modei, int modej, KIVEC(i), KIVEC(j), KOCMAT(m), OCMAT(r)) {
1653 EXTRACT_IMP 1648 EXTRACT_IMP
1654} 1649}
1655 1650
1656int extractQ(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KQMAT(m), QMAT(r)) { 1651int extractQ(int modei, int modej, KIVEC(i), KIVEC(j), KOQMAT(m), OQMAT(r)) {
1657 EXTRACT_IMP 1652 EXTRACT_IMP
1658} 1653}
1659 1654
1660int extractI(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KIMAT(m), IMAT(r)) { 1655int extractI(int modei, int modej, KIVEC(i), KIVEC(j), KOIMAT(m), OIMAT(r)) {
1661 EXTRACT_IMP 1656 EXTRACT_IMP
1662} 1657}
1663 1658
diff --git a/packages/base/src/Data/Packed/Internal/Matrix.hs b/packages/base/src/Data/Packed/Internal/Matrix.hs
index ddeddae..9f446b2 100644
--- a/packages/base/src/Data/Packed/Internal/Matrix.hs
+++ b/packages/base/src/Data/Packed/Internal/Matrix.hs
@@ -485,34 +485,20 @@ instance (Storable t, NFData t) => NFData (Matrix t)
485 485
486--------------------------------------------------------------- 486---------------------------------------------------------------
487 487
488isT Matrix{order = ColumnMajor} = 1
489isT Matrix{order = RowMajor} = 0
490
491tt x@Matrix{order = ColumnMajor} = trans x
492tt x@Matrix{order = RowMajor} = x
493
494
495extractAux f m moder vr modec vc = unsafePerformIO $ do 488extractAux f m moder vr modec vc = unsafePerformIO $ do
496 let nr = if moder == 0 then fromIntegral $ vr@>1 - vr@>0 + 1 else dim vr 489 let nr = if moder == 0 then fromIntegral $ vr@>1 - vr@>0 + 1 else dim vr
497 nc = if modec == 0 then fromIntegral $ vc@>1 - vc@>0 + 1 else dim vc 490 nc = if modec == 0 then fromIntegral $ vc@>1 - vc@>0 + 1 else dim vc
498 r <- createMatrix RowMajor nr nc 491 r <- createMatrix RowMajor nr nc
499 app4 (f moder modec (isT m)) vec vr vec vc mat (tt m) mat r "extractAux" 492 app4 (f moder modec) vec vr vec vc omat m omat r "extractAux"
500 return r 493 return r
501 494
502foreign import ccall unsafe "extractD" c_extractD 495type Extr x = CInt -> CInt -> CIdxs (CIdxs (OM x (OM x (IO CInt))))
503 :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM Double (CM Double (IO CInt))))
504
505foreign import ccall unsafe "extractF" c_extractF
506 :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM Float (CM Float (IO CInt))))
507
508foreign import ccall unsafe "extractC" c_extractC
509 :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM (Complex Double) (CM (Complex Double) (IO CInt))))
510
511foreign import ccall unsafe "extractQ" c_extractQ
512 :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM (Complex Float) (CM (Complex Float) (IO CInt))))
513 496
514foreign import ccall unsafe "extractI" c_extractI 497foreign import ccall unsafe "extractD" c_extractD :: Extr Double
515 :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM CInt (CM CInt (IO CInt)))) 498foreign import ccall unsafe "extractF" c_extractF :: Extr Float
499foreign import ccall unsafe "extractC" c_extractC :: Extr (Complex Double)
500foreign import ccall unsafe "extractQ" c_extractQ :: Extr (Complex Float)
501foreign import ccall unsafe "extractI" c_extractI :: Extr CInt
516 502
517-------------------------------------------------------------------------------- 503--------------------------------------------------------------------------------
518 504