diff options
Diffstat (limited to 'packages/base')
-rw-r--r-- | packages/base/src/C/lapack-aux.c | 19 | ||||
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Matrix.hs | 28 |
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 | ||
1644 | int extractD(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KDMAT(m), DMAT(r)) { | 1639 | int extractD(int modei, int modej, KIVEC(i), KIVEC(j), KODMAT(m), ODMAT(r)) { |
1645 | EXTRACT_IMP | 1640 | EXTRACT_IMP |
1646 | } | 1641 | } |
1647 | 1642 | ||
1648 | int extractF(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KFMAT(m), FMAT(r)) { | 1643 | int extractF(int modei, int modej, KIVEC(i), KIVEC(j), KOFMAT(m), OFMAT(r)) { |
1649 | EXTRACT_IMP | 1644 | EXTRACT_IMP |
1650 | } | 1645 | } |
1651 | 1646 | ||
1652 | int extractC(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KCMAT(m), CMAT(r)) { | 1647 | int extractC(int modei, int modej, KIVEC(i), KIVEC(j), KOCMAT(m), OCMAT(r)) { |
1653 | EXTRACT_IMP | 1648 | EXTRACT_IMP |
1654 | } | 1649 | } |
1655 | 1650 | ||
1656 | int extractQ(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KQMAT(m), QMAT(r)) { | 1651 | int extractQ(int modei, int modej, KIVEC(i), KIVEC(j), KOQMAT(m), OQMAT(r)) { |
1657 | EXTRACT_IMP | 1652 | EXTRACT_IMP |
1658 | } | 1653 | } |
1659 | 1654 | ||
1660 | int extractI(int modei, int modej, int tm, KIVEC(i), KIVEC(j), KIMAT(m), IMAT(r)) { | 1655 | int 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 | ||
488 | isT Matrix{order = ColumnMajor} = 1 | ||
489 | isT Matrix{order = RowMajor} = 0 | ||
490 | |||
491 | tt x@Matrix{order = ColumnMajor} = trans x | ||
492 | tt x@Matrix{order = RowMajor} = x | ||
493 | |||
494 | |||
495 | extractAux f m moder vr modec vc = unsafePerformIO $ do | 488 | extractAux 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 | ||
502 | foreign import ccall unsafe "extractD" c_extractD | 495 | type 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 | |||
505 | foreign import ccall unsafe "extractF" c_extractF | ||
506 | :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM Float (CM Float (IO CInt)))) | ||
507 | |||
508 | foreign import ccall unsafe "extractC" c_extractC | ||
509 | :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM (Complex Double) (CM (Complex Double) (IO CInt)))) | ||
510 | |||
511 | foreign import ccall unsafe "extractQ" c_extractQ | ||
512 | :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM (Complex Float) (CM (Complex Float) (IO CInt)))) | ||
513 | 496 | ||
514 | foreign import ccall unsafe "extractI" c_extractI | 497 | foreign import ccall unsafe "extractD" c_extractD :: Extr Double |
515 | :: CInt -> CInt -> CInt -> CIdxs (CIdxs (CM CInt (CM CInt (IO CInt)))) | 498 | foreign import ccall unsafe "extractF" c_extractF :: Extr Float |
499 | foreign import ccall unsafe "extractC" c_extractC :: Extr (Complex Double) | ||
500 | foreign import ccall unsafe "extractQ" c_extractQ :: Extr (Complex Float) | ||
501 | foreign import ccall unsafe "extractI" c_extractI :: Extr CInt | ||
516 | 502 | ||
517 | -------------------------------------------------------------------------------- | 503 | -------------------------------------------------------------------------------- |
518 | 504 | ||