summaryrefslogtreecommitdiff
path: root/packages/base/src/Data/Packed/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Data/Packed/Internal')
-rw-r--r--packages/base/src/Data/Packed/Internal/Numeric.hs98
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
70data Extractor 70data 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
79idxs :: [Int] -> Idxs 81-- | Create a vector of indexes, useful for matrix extraction using '??'
80idxs js = fromList (map fromIntegral js) :: Idxs 82idxs :: [Int] -> Vector I
83idxs js = fromList (map fromIntegral js) :: Vector I
81 84
85--
82infixl 9 ?? 86infixl 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)
88m ?? e@(Range a b,_) | a < 0 || b >= rows m = extractError m e 92m ?? e@(Range a b,_) | a < 0 || b >= rows m = extractError m e
89m ?? e@(_,Range a b) | a < 0 || b >= cols m = extractError m e 93m ?? e@(_,Range a b) | a < 0 || b >= cols m = extractError m e
90 94
91m ?? e@(At vs,_) | minElement vs < 0 || maxElement vs >= fromIntegral (rows m) = extractError m e 95m ?? e@(Pos vs,_) | minElement vs < 0 || maxElement vs >= fromIntegral (rows m) = extractError m e
92m ?? e@(_,At vs) | minElement vs < 0 || maxElement vs >= fromIntegral (cols m) = extractError m e 96m ?? e@(_,Pos vs) | minElement vs < 0 || maxElement vs >= fromIntegral (cols m) = extractError m e
93 97
94m ?? (All,All) = m 98m ?? (All,All) = m
95 99
96m ?? (Range a b,e) | a > b = m ?? (Take 0,e) 100m ?? (Range a b,e) | a > b = m ?? (Take 0,e)
97m ?? (e,Range a b) | a > b = m ?? (e,Take 0) 101m ?? (e,Range a b) | a > b = m ?? (e,Take 0)
98 102
99m ?? (Take 0,e) = (0><cols m) [] ?? (All,e) 103m ?? (Take n,e)
100m ?? (e,Take 0) = (rows m><0) [] ?? (e,All) 104 | n <= 0 = (0><cols m) [] ?? (All,e)
105 | n >= rows m = m ?? (All,e)
106
107m ?? (e,Take n)
108 | n <= 0 = (rows m><0) [] ?? (e,All)
109 | n >= cols m = m ?? (e,All)
101 110
102m ?? (Take n,e) | abs n > rows m = m ?? (All,e) 111m ?? (Drop n,e)
103m ?? (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
105m ?? (Drop 0,e) = m ?? (All,e) 115m ?? (e,Drop n)
106m ?? (e,Drop 0) = m ?? (e,All) 116 | n <= 0 = m ?? (e,All)
117 | n >= cols m = (rows m><0) [] ?? (e,All)
107 118
108m ?? (Drop n,e) | abs n > rows m = m ?? (Take 0,e) 119m ?? (TakeLast n, e) = m ?? (Drop (rows m - n), e)
109m ?? (e,Drop n) | abs n > cols m = m ?? (e,Take 0) 120m ?? (e, TakeLast n) = m ?? (e, Drop (cols m - n))
110 121
122m ?? (DropLast n, e) = m ?? (Take (rows m - n), e)
123m ?? (e, DropLast n) = m ?? (e, Take (cols m - n))
111 124
112m ?? (er,ec) = extractR m moder rs modec cs 125m ?? (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
191instance Container Vector CInt 199instance 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'
424arctan2 :: (Fractional e, Container c e) => c e -> c e -> c e 432arctan2 :: (Fractional e, Container c e) => c e -> c e -> c e
425arctan2 = arctan2' 433arctan2 = arctan2'
426 434
435-- | 'mod' for integer arrays
436--
437-- >>> cmod 3 (range 5)
438-- fromList [0,1,2,0,1]
427cmod :: (Integral e, Container c e) => Int -> c e -> c e 439cmod :: (Integral e, Container c e) => Int -> c e -> c e
428cmod m = cmod' (fromIntegral m) 440cmod m = cmod' (fromIntegral m)
429 441
430fromInt :: (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--
448fromInt :: (Container c e) => c I -> c e
431fromInt = fromInt' 449fromInt = fromInt'
432 450
433 451
@@ -435,7 +453,14 @@ fromInt = fromInt'
435cmap :: (Element b, Container c e) => (e -> b) -> c e -> c b 453cmap :: (Element b, Container c e) => (e -> b) -> c e -> c b
436cmap = cmap' 454cmap = 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--
439atIndex :: Container c e => c e -> IndexOf c -> e 464atIndex :: Container c e => c e -> IndexOf c -> e
440atIndex = atIndex' 465atIndex = 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
599instance Product CInt where 624instance 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
738type instance RealOf Float = Float 763type instance RealOf Float = Float
739type instance RealOf (Complex Float) = Float 764type instance RealOf (Complex Float) = Float
740 765
741type instance RealOf CInt = CInt 766type instance RealOf I = I
742 767
743type family ComplexOf x 768type family ComplexOf x
744 769
@@ -831,12 +856,15 @@ condV f a b l e t = f a' b' l' e' t'
831 856
832class Transposable m mt | m -> mt, mt -> m 857class 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
837instance (Container Vector t) => Transposable (Matrix t) (Matrix t) 864instance (Container Vector t) => Transposable (Matrix t) (Matrix t)
838 where 865 where
839 tr = ctrans 866 tr = ctrans
867 tr' = trans
840 868
841class Linear t v 869class Linear t v
842 where 870 where