diff options
Diffstat (limited to 'packages/base/src/Internal/Element.hs')
-rw-r--r-- | packages/base/src/Internal/Element.hs | 81 |
1 files changed, 79 insertions, 2 deletions
diff --git a/packages/base/src/Internal/Element.hs b/packages/base/src/Internal/Element.hs index 6fc2981..0f61370 100644 --- a/packages/base/src/Internal/Element.hs +++ b/packages/base/src/Internal/Element.hs | |||
@@ -24,9 +24,10 @@ module Internal.Element where | |||
24 | import Internal.Tools | 24 | import Internal.Tools |
25 | import Internal.Vector | 25 | import Internal.Vector |
26 | import Internal.Matrix | 26 | import Internal.Matrix |
27 | import Internal.Vectorized | ||
27 | import qualified Internal.ST as ST | 28 | import qualified Internal.ST as ST |
28 | import Data.Array | 29 | import Data.Array |
29 | 30 | import Text.Printf | |
30 | import Data.Vector.Storable(fromList) | 31 | import Data.Vector.Storable(fromList) |
31 | import Data.List(transpose,intersperse) | 32 | import Data.List(transpose,intersperse) |
32 | import Foreign.Storable(Storable) | 33 | import Foreign.Storable(Storable) |
@@ -78,7 +79,83 @@ instance (Element a, Read a) => Read (Matrix a) where | |||
78 | breakAt c l = (a++[c],tail b) where | 79 | breakAt c l = (a++[c],tail b) where |
79 | (a,b) = break (==c) l | 80 | (a,b) = break (==c) l |
80 | 81 | ||
81 | ------------------------------------------------------------------ | 82 | -------------------------------------------------------------------------------- |
83 | |||
84 | data Extractor | ||
85 | = All | ||
86 | | Range Int Int Int | ||
87 | | Pos (Vector I) | ||
88 | | PosCyc (Vector I) | ||
89 | | Take Int | ||
90 | | TakeLast Int | ||
91 | | Drop Int | ||
92 | | DropLast Int | ||
93 | deriving Show | ||
94 | |||
95 | |||
96 | -- | ||
97 | infixl 9 ?? | ||
98 | (??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t | ||
99 | |||
100 | minEl = toScalarI Min | ||
101 | maxEl = toScalarI Max | ||
102 | cmodi = vectorMapValI ModVS | ||
103 | |||
104 | extractError m e = error $ printf "can't extract %s from matrix %dx%d" (show e) (rows m) (cols m) | ||
105 | |||
106 | m ?? (Range a s b,e) | s /= 1 = m ?? (Pos (idxs [a,a+s .. b]), e) | ||
107 | m ?? (e,Range a s b) | s /= 1 = m ?? (e, Pos (idxs [a,a+s .. b])) | ||
108 | |||
109 | m ?? e@(Range a _ b,_) | a < 0 || b >= rows m = extractError m e | ||
110 | m ?? e@(_,Range a _ b) | a < 0 || b >= cols m = extractError m e | ||
111 | |||
112 | m ?? e@(Pos vs,_) | dim vs>0 && (minEl vs < 0 || maxEl vs >= fi (rows m)) = extractError m e | ||
113 | m ?? e@(_,Pos vs) | dim vs>0 && (minEl vs < 0 || maxEl vs >= fi (cols m)) = extractError m e | ||
114 | |||
115 | m ?? (All,All) = m | ||
116 | |||
117 | m ?? (Range a _ b,e) | a > b = m ?? (Take 0,e) | ||
118 | m ?? (e,Range a _ b) | a > b = m ?? (e,Take 0) | ||
119 | |||
120 | m ?? (Take n,e) | ||
121 | | n <= 0 = (0><cols m) [] ?? (All,e) | ||
122 | | n >= rows m = m ?? (All,e) | ||
123 | |||
124 | m ?? (e,Take n) | ||
125 | | n <= 0 = (rows m><0) [] ?? (e,All) | ||
126 | | n >= cols m = m ?? (e,All) | ||
127 | |||
128 | m ?? (Drop n,e) | ||
129 | | n <= 0 = m ?? (All,e) | ||
130 | | n >= rows m = (0><cols m) [] ?? (All,e) | ||
131 | |||
132 | m ?? (e,Drop n) | ||
133 | | n <= 0 = m ?? (e,All) | ||
134 | | n >= cols m = (rows m><0) [] ?? (e,All) | ||
135 | |||
136 | m ?? (TakeLast n, e) = m ?? (Drop (rows m - n), e) | ||
137 | m ?? (e, TakeLast n) = m ?? (e, Drop (cols m - n)) | ||
138 | |||
139 | m ?? (DropLast n, e) = m ?? (Take (rows m - n), e) | ||
140 | m ?? (e, DropLast n) = m ?? (e, Take (cols m - n)) | ||
141 | |||
142 | m ?? (er,ec) = extractR m moder rs modec cs | ||
143 | where | ||
144 | (moder,rs) = mkExt (rows m) er | ||
145 | (modec,cs) = mkExt (cols m) ec | ||
146 | ran a b = (0, idxs [a,b]) | ||
147 | pos ks = (1, ks) | ||
148 | mkExt _ (Pos ks) = pos ks | ||
149 | mkExt n (PosCyc ks) | ||
150 | | n == 0 = mkExt n (Take 0) | ||
151 | | otherwise = pos (cmodi (fi n) ks) | ||
152 | mkExt _ (Range mn _ mx) = ran mn mx | ||
153 | mkExt _ (Take k) = ran 0 (k-1) | ||
154 | mkExt n (Drop k) = ran k (n-1) | ||
155 | mkExt n _ = ran 0 (n-1) -- All | ||
156 | |||
157 | -------------------------------------------------------------------------------- | ||
158 | |||
82 | 159 | ||
83 | -- | creates a matrix from a vertical list of matrices | 160 | -- | creates a matrix from a vertical list of matrices |
84 | joinVert :: Element t => [Matrix t] -> Matrix t | 161 | joinVert :: Element t => [Matrix t] -> Matrix t |