diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-05-24 12:45:23 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-05-24 12:45:23 +0200 |
commit | 8ede2ed162f3d00172ee3fa4835e3ee2184bcd99 (patch) | |
tree | cdb3025dc5e469603d32d4e200cc753d3502c6d8 /packages/base/src/Data/Packed/Internal/Numeric.hs | |
parent | b1b445697db31b1603a31747ca31151f97ee7263 (diff) |
joint extractor of rows and columns
Diffstat (limited to 'packages/base/src/Data/Packed/Internal/Numeric.hs')
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Numeric.hs | 66 |
1 files changed, 41 insertions, 25 deletions
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index 00ec70c..353877a 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, | 39 | roundVector, |
40 | RealOf, ComplexOf, SingleOf, DoubleOf, | 40 | RealOf, ComplexOf, SingleOf, DoubleOf, |
41 | IndexOf, | 41 | IndexOf, |
42 | CInt, Extractor(..), (??),(¿¿), | 42 | CInt, Extractor(..), (??), |
43 | module Data.Complex | 43 | module Data.Complex |
44 | ) where | 44 | ) where |
45 | 45 | ||
@@ -69,27 +69,50 @@ type instance ArgOf Matrix a = a -> a -> a | |||
69 | 69 | ||
70 | -------------------------------------------------------------------------- | 70 | -------------------------------------------------------------------------- |
71 | 71 | ||
72 | data Extractor = All | Range Int Int | At [Int] | AtCyc [Int] | Take Int | Drop Int | 72 | data Extractor |
73 | = All | ||
74 | | Range Int Int | ||
75 | | At [Int] | ||
76 | | AtCyc [Int] | ||
77 | | Take Int | ||
78 | | Drop Int | ||
79 | deriving Show | ||
73 | 80 | ||
74 | idxs js = fromList (map fromIntegral js) :: Idxs | 81 | idxs js = fromList (map fromIntegral js) :: Idxs |
75 | 82 | ||
76 | infixl 9 ??, ¿¿ | 83 | infixl 9 ?? |
77 | (??),(¿¿) :: Element t => Matrix t -> Extractor -> Matrix t | 84 | (??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t |
78 | 85 | ||
79 | m ?? All = m | 86 | |
80 | m ?? Take 0 = (0><cols m) [] | 87 | extractError m e = error $ printf "can't extract %s from matrix %dx%d" (show e) (rows m) (cols m) |
81 | m ?? Take n | abs n >= rows m = m | 88 | |
82 | m ?? Drop 0 = m | 89 | m ?? e@(Range a b,_) | a < 0 || b >= rows m = extractError m e |
83 | m ?? Drop n | abs n >= rows m = (0><cols m) [] | 90 | m ?? e@(_,Range a b) | a < 0 || b >= cols m = extractError m e |
84 | m ?? Range a b | a > b = m ?? Take 0 | 91 | m ?? e@(At ps,_) | minimum ps < 0 || maximum ps >= rows m = extractError m e |
85 | m ?? Range a b | a < 0 || b >= cols m = error $ | 92 | m ?? e@(_,At ps) | minimum ps < 0 || maximum ps >= cols m = extractError m e |
86 | printf "can't extract rows %d to %d from matrix %dx%d" a b (rows m) (cols m) | 93 | |
87 | m ?? At ps | minimum ps < 0 || maximum ps >= rows m = error $ | 94 | m ?? (All,All) = m |
88 | printf "can't extract rows %s from matrix %dx%d" (show ps) (rows m) (cols m) | 95 | |
89 | 96 | m ?? (Range a b,e) | a > b = m ?? (Take 0,e) | |
90 | m ?? er = extractR m mode js | 97 | m ?? (e,Range a b) | a > b = m ?? (e,Take 0) |
98 | |||
99 | m ?? (Take 0,e) = (0><cols m) [] ?? (All,e) | ||
100 | m ?? (e,Take 0) = (rows m><0) [] ?? (e,All) | ||
101 | |||
102 | m ?? (Take n,e) | abs n > rows m = m ?? (All,e) | ||
103 | m ?? (e,Take n) | abs n > cols m = m ?? (e,All) | ||
104 | |||
105 | m ?? (Drop 0,e) = m ?? (All,e) | ||
106 | m ?? (e,Drop 0) = m ?? (e,All) | ||
107 | |||
108 | m ?? (Drop n,e) | abs n > rows m = m ?? (Take 0,e) | ||
109 | m ?? (e,Drop n) | abs n > cols m = m ?? (e,Take 0) | ||
110 | |||
111 | |||
112 | m ?? (er,ec) = extractR m moder rs modec cs | ||
91 | where | 113 | where |
92 | (mode,js) = mkExt (rows m) er | 114 | (moder,rs) = mkExt (rows m) er |
115 | (modec,cs) = mkExt (cols m) ec | ||
93 | ran a b = (0, idxs [a,b]) | 116 | ran a b = (0, idxs [a,b]) |
94 | pos ks = (1, idxs ks) | 117 | pos ks = (1, idxs ks) |
95 | mkExt _ (At ks) = pos ks | 118 | mkExt _ (At ks) = pos ks |
@@ -104,13 +127,6 @@ m ?? er = extractR m mode js | |||
104 | | otherwise = mkExt n (Take (n+k)) | 127 | | otherwise = mkExt n (Take (n+k)) |
105 | 128 | ||
106 | 129 | ||
107 | m ¿¿ Range a b | a < 0 || b > cols m -1 = error $ | ||
108 | printf "can't extract columns %d to %d from matrix %dx%d" a b (rows m) (cols m) | ||
109 | |||
110 | m ¿¿ At ps | minimum ps < 0 || maximum ps >= cols m = error $ | ||
111 | printf "can't extract columns %s from matrix %dx%d" (show ps) (rows m) (cols m) | ||
112 | m ¿¿ ec = trans (trans m ?? ec) | ||
113 | |||
114 | ------------------------------------------------------------------- | 130 | ------------------------------------------------------------------- |
115 | 131 | ||
116 | 132 | ||