diff options
Diffstat (limited to 'packages/base/src/Data/Packed/Internal')
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Numeric.hs | 98 |
1 files changed, 63 insertions, 35 deletions
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index cda9429..51bee5c 100644 --- a/packages/base/src/Data/Packed/Internal/Numeric.hs +++ b/packages/base/src/Data/Packed/Internal/Numeric.hs | |||
@@ -31,7 +31,7 @@ module Data.Packed.Internal.Numeric ( | |||
31 | mXm,mXv,vXm, | 31 | mXm,mXv,vXm, |
32 | outer, kronecker, | 32 | outer, kronecker, |
33 | -- * sorting | 33 | -- * sorting |
34 | sortVector, | 34 | sortV, sortI, |
35 | -- * Element conversion | 35 | -- * Element conversion |
36 | Convert(..), | 36 | Convert(..), |
37 | Complexable(), | 37 | Complexable(), |
@@ -39,7 +39,7 @@ module Data.Packed.Internal.Numeric ( | |||
39 | roundVector, fromInt, | 39 | roundVector, fromInt, |
40 | RealOf, ComplexOf, SingleOf, DoubleOf, | 40 | RealOf, ComplexOf, SingleOf, DoubleOf, |
41 | IndexOf, | 41 | IndexOf, |
42 | CInt, Extractor(..), (??), range, idxs, | 42 | I, Extractor(..), (??), range, idxs, |
43 | module Data.Complex | 43 | module Data.Complex |
44 | ) where | 44 | ) where |
45 | 45 | ||
@@ -70,15 +70,19 @@ type instance ArgOf Matrix a = a -> a -> a | |||
70 | data Extractor | 70 | data Extractor |
71 | = All | 71 | = All |
72 | | Range Int Int | 72 | | Range Int Int |
73 | | At Idxs | 73 | | Pos (Vector I) |
74 | | AtCyc Idxs | 74 | | PosCyc (Vector I) |
75 | | Take Int | 75 | | Take Int |
76 | | TakeLast Int | ||
76 | | Drop Int | 77 | | Drop Int |
78 | | DropLast Int | ||
77 | deriving Show | 79 | deriving Show |
78 | 80 | ||
79 | idxs :: [Int] -> Idxs | 81 | -- | Create a vector of indexes, useful for matrix extraction using '??' |
80 | idxs js = fromList (map fromIntegral js) :: Idxs | 82 | idxs :: [Int] -> Vector I |
83 | idxs js = fromList (map fromIntegral js) :: Vector I | ||
81 | 84 | ||
85 | -- | ||
82 | infixl 9 ?? | 86 | infixl 9 ?? |
83 | (??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t | 87 | (??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t |
84 | 88 | ||
@@ -88,26 +92,35 @@ extractError m e = error $ printf "can't extract %s from matrix %dx%d" (show e) | |||
88 | m ?? e@(Range a b,_) | a < 0 || b >= rows m = extractError m e | 92 | m ?? e@(Range a b,_) | a < 0 || b >= rows m = extractError m e |
89 | m ?? e@(_,Range a b) | a < 0 || b >= cols m = extractError m e | 93 | m ?? e@(_,Range a b) | a < 0 || b >= cols m = extractError m e |
90 | 94 | ||
91 | m ?? e@(At vs,_) | minElement vs < 0 || maxElement vs >= fromIntegral (rows m) = extractError m e | 95 | m ?? e@(Pos vs,_) | minElement vs < 0 || maxElement vs >= fromIntegral (rows m) = extractError m e |
92 | m ?? e@(_,At vs) | minElement vs < 0 || maxElement vs >= fromIntegral (cols m) = extractError m e | 96 | m ?? e@(_,Pos vs) | minElement vs < 0 || maxElement vs >= fromIntegral (cols m) = extractError m e |
93 | 97 | ||
94 | m ?? (All,All) = m | 98 | m ?? (All,All) = m |
95 | 99 | ||
96 | m ?? (Range a b,e) | a > b = m ?? (Take 0,e) | 100 | m ?? (Range a b,e) | a > b = m ?? (Take 0,e) |
97 | m ?? (e,Range a b) | a > b = m ?? (e,Take 0) | 101 | m ?? (e,Range a b) | a > b = m ?? (e,Take 0) |
98 | 102 | ||
99 | m ?? (Take 0,e) = (0><cols m) [] ?? (All,e) | 103 | m ?? (Take n,e) |
100 | m ?? (e,Take 0) = (rows m><0) [] ?? (e,All) | 104 | | n <= 0 = (0><cols m) [] ?? (All,e) |
105 | | n >= rows m = m ?? (All,e) | ||
106 | |||
107 | m ?? (e,Take n) | ||
108 | | n <= 0 = (rows m><0) [] ?? (e,All) | ||
109 | | n >= cols m = m ?? (e,All) | ||
101 | 110 | ||
102 | m ?? (Take n,e) | abs n > rows m = m ?? (All,e) | 111 | m ?? (Drop n,e) |
103 | m ?? (e,Take n) | abs n > cols m = m ?? (e,All) | 112 | | n <= 0 = m ?? (All,e) |
113 | | n >= rows m = (0><cols m) [] ?? (All,e) | ||
104 | 114 | ||
105 | m ?? (Drop 0,e) = m ?? (All,e) | 115 | m ?? (e,Drop n) |
106 | m ?? (e,Drop 0) = m ?? (e,All) | 116 | | n <= 0 = m ?? (e,All) |
117 | | n >= cols m = (rows m><0) [] ?? (e,All) | ||
107 | 118 | ||
108 | m ?? (Drop n,e) | abs n > rows m = m ?? (Take 0,e) | 119 | m ?? (TakeLast n, e) = m ?? (Drop (rows m - n), e) |
109 | m ?? (e,Drop n) | abs n > cols m = m ?? (e,Take 0) | 120 | m ?? (e, TakeLast n) = m ?? (e, Drop (cols m - n)) |
110 | 121 | ||
122 | m ?? (DropLast n, e) = m ?? (Take (rows m - n), e) | ||
123 | m ?? (e, DropLast n) = m ?? (e, Take (cols m - n)) | ||
111 | 124 | ||
112 | m ?? (er,ec) = extractR m moder rs modec cs | 125 | m ?? (er,ec) = extractR m moder rs modec cs |
113 | where | 126 | where |
@@ -115,19 +128,14 @@ m ?? (er,ec) = extractR m moder rs modec cs | |||
115 | (modec,cs) = mkExt (cols m) ec | 128 | (modec,cs) = mkExt (cols m) ec |
116 | ran a b = (0, idxs [a,b]) | 129 | ran a b = (0, idxs [a,b]) |
117 | pos ks = (1, ks) | 130 | pos ks = (1, ks) |
118 | mkExt _ (At ks) = pos ks | 131 | mkExt _ (Pos ks) = pos ks |
119 | mkExt n (AtCyc ks) | 132 | mkExt n (PosCyc ks) |
120 | | n == 0 = mkExt n (Take 0) | 133 | | n == 0 = mkExt n (Take 0) |
121 | | otherwise = pos (cmod n ks) | 134 | | otherwise = pos (cmod n ks) |
122 | mkExt n All = ran 0 (n-1) | ||
123 | mkExt _ (Range mn mx) = ran mn mx | 135 | mkExt _ (Range mn mx) = ran mn mx |
124 | mkExt n (Take k) | 136 | mkExt _ (Take k) = ran 0 (k-1) |
125 | | k >= 0 = ran 0 (k-1) | 137 | mkExt n (Drop k) = ran k (n-1) |
126 | | otherwise = mkExt n (Drop (n+k)) | 138 | mkExt n _ = ran 0 (n-1) -- All |
127 | mkExt n (Drop k) | ||
128 | | k >= 0 = ran k (n-1) | ||
129 | | otherwise = mkExt n (Take (n+k)) | ||
130 | |||
131 | 139 | ||
132 | ------------------------------------------------------------------- | 140 | ------------------------------------------------------------------- |
133 | 141 | ||
@@ -183,12 +191,12 @@ class Element e => Container c e | |||
183 | -- element by element inverse tangent | 191 | -- element by element inverse tangent |
184 | arctan2' :: Fractional e => c e -> c e -> c e | 192 | arctan2' :: Fractional e => c e -> c e -> c e |
185 | cmod' :: Integral e => e -> c e -> c e | 193 | cmod' :: Integral e => e -> c e -> c e |
186 | fromInt' :: c CInt -> c e | 194 | fromInt' :: c I -> c e |
187 | 195 | ||
188 | 196 | ||
189 | -------------------------------------------------------------------------- | 197 | -------------------------------------------------------------------------- |
190 | 198 | ||
191 | instance Container Vector CInt | 199 | instance Container Vector I |
192 | where | 200 | where |
193 | conj' = id | 201 | conj' = id |
194 | size' = dim | 202 | size' = dim |
@@ -424,10 +432,20 @@ scale = scale' | |||
424 | arctan2 :: (Fractional e, Container c e) => c e -> c e -> c e | 432 | arctan2 :: (Fractional e, Container c e) => c e -> c e -> c e |
425 | arctan2 = arctan2' | 433 | arctan2 = arctan2' |
426 | 434 | ||
435 | -- | 'mod' for integer arrays | ||
436 | -- | ||
437 | -- >>> cmod 3 (range 5) | ||
438 | -- fromList [0,1,2,0,1] | ||
427 | cmod :: (Integral e, Container c e) => Int -> c e -> c e | 439 | cmod :: (Integral e, Container c e) => Int -> c e -> c e |
428 | cmod m = cmod' (fromIntegral m) | 440 | cmod m = cmod' (fromIntegral m) |
429 | 441 | ||
430 | fromInt :: (Container c e) => c CInt -> c e | 442 | -- | |
443 | -- >>>fromInt ((2><2) [0..3]) :: Matrix (Complex Double) | ||
444 | -- (2><2) | ||
445 | -- [ 0.0 :+ 0.0, 1.0 :+ 0.0 | ||
446 | -- , 2.0 :+ 0.0, 3.0 :+ 0.0 ] | ||
447 | -- | ||
448 | fromInt :: (Container c e) => c I -> c e | ||
431 | fromInt = fromInt' | 449 | fromInt = fromInt' |
432 | 450 | ||
433 | 451 | ||
@@ -435,7 +453,14 @@ fromInt = fromInt' | |||
435 | cmap :: (Element b, Container c e) => (e -> b) -> c e -> c b | 453 | cmap :: (Element b, Container c e) => (e -> b) -> c e -> c b |
436 | cmap = cmap' | 454 | cmap = cmap' |
437 | 455 | ||
438 | -- | indexing function | 456 | -- | generic indexing function |
457 | -- | ||
458 | -- >>> vector [1,2,3] `atIndex` 1 | ||
459 | -- 2.0 | ||
460 | -- | ||
461 | -- >>> matrix 3 [0..8] `atIndex` (2,0) | ||
462 | -- 6.0 | ||
463 | -- | ||
439 | atIndex :: Container c e => c e -> IndexOf c -> e | 464 | atIndex :: Container c e => c e -> IndexOf c -> e |
440 | atIndex = atIndex' | 465 | atIndex = atIndex' |
441 | 466 | ||
@@ -596,7 +621,7 @@ instance Product (Complex Double) where | |||
596 | normInf = emptyVal (maxElement . fst . fromComplex . vectorMapC Abs) | 621 | normInf = emptyVal (maxElement . fst . fromComplex . vectorMapC Abs) |
597 | multiply = emptyMul multiplyC | 622 | multiply = emptyMul multiplyC |
598 | 623 | ||
599 | instance Product CInt where | 624 | instance Product I where |
600 | norm2 = undefined | 625 | norm2 = undefined |
601 | absSum = emptyVal (sumElements . vectorMapI Abs) | 626 | absSum = emptyVal (sumElements . vectorMapI Abs) |
602 | norm1 = absSum | 627 | norm1 = absSum |
@@ -738,7 +763,7 @@ type instance RealOf (Complex Double) = Double | |||
738 | type instance RealOf Float = Float | 763 | type instance RealOf Float = Float |
739 | type instance RealOf (Complex Float) = Float | 764 | type instance RealOf (Complex Float) = Float |
740 | 765 | ||
741 | type instance RealOf CInt = CInt | 766 | type instance RealOf I = I |
742 | 767 | ||
743 | type family ComplexOf x | 768 | type family ComplexOf x |
744 | 769 | ||
@@ -831,12 +856,15 @@ condV f a b l e t = f a' b' l' e' t' | |||
831 | 856 | ||
832 | class Transposable m mt | m -> mt, mt -> m | 857 | class Transposable m mt | m -> mt, mt -> m |
833 | where | 858 | where |
834 | -- | (conjugate) transpose | 859 | -- | conjugate transpose |
835 | tr :: m -> mt | 860 | tr :: m -> mt |
861 | -- | transpose | ||
862 | tr' :: m -> mt | ||
836 | 863 | ||
837 | instance (Container Vector t) => Transposable (Matrix t) (Matrix t) | 864 | instance (Container Vector t) => Transposable (Matrix t) (Matrix t) |
838 | where | 865 | where |
839 | tr = ctrans | 866 | tr = ctrans |
867 | tr' = trans | ||
840 | 868 | ||
841 | class Linear t v | 869 | class Linear t v |
842 | where | 870 | where |