diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-05-22 12:00:42 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-05-22 12:00:42 +0200 |
commit | e635f3889aed9b4bf7ef02c98945e9065d114df3 (patch) | |
tree | 1ae46c334e55052ec1eaa3b3c20bf5becdec164c /packages/base/src/Data/Packed/Internal/Numeric.hs | |
parent | 0c8a545e67ebef2b3a4e376fac8f23a651dfbe6d (diff) |
extraction modes
Diffstat (limited to 'packages/base/src/Data/Packed/Internal/Numeric.hs')
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Numeric.hs | 53 |
1 files changed, 50 insertions, 3 deletions
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index 9b6b55b..f1b4898 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, | 42 | CInt, Extractor(..), (??),(¿¿), |
43 | module Data.Complex | 43 | module Data.Complex |
44 | ) where | 44 | ) where |
45 | 45 | ||
@@ -53,6 +53,7 @@ import Data.Complex | |||
53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) | 53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) |
54 | import Data.Packed.Internal | 54 | import Data.Packed.Internal |
55 | import Foreign.C.Types(CInt) | 55 | import Foreign.C.Types(CInt) |
56 | import Text.Printf(printf) | ||
56 | 57 | ||
57 | ------------------------------------------------------------------- | 58 | ------------------------------------------------------------------- |
58 | 59 | ||
@@ -66,8 +67,53 @@ type family ArgOf (c :: * -> *) a | |||
66 | type instance ArgOf Vector a = a -> a | 67 | type instance ArgOf Vector a = a -> a |
67 | type instance ArgOf Matrix a = a -> a -> a | 68 | type instance ArgOf Matrix a = a -> a -> a |
68 | 69 | ||
70 | -------------------------------------------------------------------------- | ||
71 | |||
72 | data Extractor = All | Range Int Int | At [Int] | AtCyc [Int] | Take Int | Drop Int | ||
73 | |||
74 | idxs js = fromList (map fromIntegral js) :: Idxs | ||
75 | |||
76 | infixl 9 ??, ¿¿ | ||
77 | (??),(¿¿) :: Element t => Matrix t -> Extractor -> Matrix t | ||
78 | |||
79 | m ?? All = m | ||
80 | m ?? Take 0 = (0><cols m) [] | ||
81 | m ?? Take n | abs n >= rows m = m | ||
82 | m ?? Drop 0 = m | ||
83 | m ?? Drop n | abs n >= rows m = (0><cols m) [] | ||
84 | m ?? Range a b | a > b = m ?? Take 0 | ||
85 | m ?? Range a b | a < 0 || b >= cols m = error $ | ||
86 | printf "can't extract rows %d to %d from matrix %dx%d" a b (rows m) (cols m) | ||
87 | m ?? At ps | minimum ps < 0 || maximum ps >= rows m = error $ | ||
88 | printf "can't extract rows %s from matrix %dx%d" (show ps) (rows m) (cols m) | ||
89 | |||
90 | m ?? er = extractR m mode js | ||
91 | where | ||
92 | (mode,js) = mkExt (rows m) er | ||
93 | ran a b = (0, idxs [a,b]) | ||
94 | pos ks = (1, idxs ks) | ||
95 | mkExt _ (At ks) = pos ks | ||
96 | mkExt n (AtCyc ks) = pos (map (`mod` n) ks) | ||
97 | mkExt n All = ran 0 (n-1) | ||
98 | mkExt _ (Range mn mx) = ran mn mx | ||
99 | mkExt n (Take k) | ||
100 | | k >= 0 = ran 0 (k-1) | ||
101 | | otherwise = mkExt n (Drop (n+k)) | ||
102 | mkExt n (Drop k) | ||
103 | | k >= 0 = ran k (n-1) | ||
104 | | otherwise = mkExt n (Take (n+k)) | ||
105 | |||
106 | |||
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 | |||
69 | ------------------------------------------------------------------- | 114 | ------------------------------------------------------------------- |
70 | 115 | ||
116 | |||
71 | -- | Basic element-by-element functions for numeric containers | 117 | -- | Basic element-by-element functions for numeric containers |
72 | class Element e => SContainer c e | 118 | class Element e => SContainer c e |
73 | where | 119 | where |
@@ -123,6 +169,7 @@ class (Complexable c, Fractional e, SContainer c e) => Container c e | |||
123 | -- element by element inverse tangent | 169 | -- element by element inverse tangent |
124 | arctan2' :: c e -> c e -> c e | 170 | arctan2' :: c e -> c e -> c e |
125 | 171 | ||
172 | |||
126 | -------------------------------------------------------------------------- | 173 | -------------------------------------------------------------------------- |
127 | 174 | ||
128 | instance SContainer Vector CInt | 175 | instance SContainer Vector CInt |
@@ -245,14 +292,14 @@ instance SContainer Vector (Complex Double) | |||
245 | accum' = accumV | 292 | accum' = accumV |
246 | cond' = undefined -- cannot match | 293 | cond' = undefined -- cannot match |
247 | 294 | ||
248 | 295 | ||
249 | instance Container Vector (Complex Double) | 296 | instance Container Vector (Complex Double) |
250 | where | 297 | where |
251 | scaleRecip = vectorMapValC Recip | 298 | scaleRecip = vectorMapValC Recip |
252 | divide = vectorZipC Div | 299 | divide = vectorZipC Div |
253 | arctan2' = vectorZipC ATan2 | 300 | arctan2' = vectorZipC ATan2 |
254 | conj' = conjugateC | 301 | conj' = conjugateC |
255 | 302 | ||
256 | 303 | ||
257 | instance SContainer Vector (Complex Float) | 304 | instance SContainer Vector (Complex Float) |
258 | where | 305 | where |