orthotope 0.1.7.2 → 0.1.8.0
raw patch · 11 files changed
+146/−86 lines, 11 filesdep −test-framework-quickcheck2dep ~QuickCheckdep ~basenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies removed: test-framework-quickcheck2
Dependency ranges changed: QuickCheck, base
API changes (from Hackage documentation)
+ Data.Array.Internal: toUnorderedVectorListT :: (Vector v, VecElem v a) => ShapeL -> T v a -> [v a]
+ Data.Array.Internal: toVectorListT :: (Vector v, VecElem v a) => ShapeL -> T v a -> [v a]
+ Data.Array.Internal: vFromListN :: (Vector v, VecElem v a) => Int -> [a] -> v a
Files
- CHANGELOG.md +5/−1
- Data/Array/Internal.hs +55/−34
- Data/Array/Internal/Dynamic.hs +2/−0
- Data/Array/Internal/DynamicG.hs +29/−29
- Data/Array/Internal/DynamicS.hs +2/−0
- Data/Array/Internal/DynamicU.hs +2/−0
- Data/Array/Internal/RankedG.hs +14/−10
- Data/Array/Internal/RankedS.hs +26/−1
- Data/Array/Internal/Shape.hs +1/−1
- Data/Array/Internal/ShapedG.hs +3/−3
- orthotope.cabal +7/−7
CHANGELOG.md view
@@ -10,4 +10,8 @@ #### 0.1.1.0 -- Remove toArrayG function and add some documentation.+- Remove toArrayG function and add some documentation++#### 0.1.8.0++- Various bugfixes, speedups and the new internal operations toVectorListT and toUnorderedVectorListT
Data/Array/Internal.hs view
@@ -54,6 +54,7 @@ vLength :: (VecElem v a) => v a -> Int vToList :: (VecElem v a) => v a -> [a] vFromList :: (VecElem v a) => [a] -> v a+ vFromListN:: (VecElem v a) => Int -> [a] -> v a vSingleton:: (VecElem v a) => a -> v a vReplicate:: (VecElem v a) => Int -> a -> v a vMap :: (VecElem v a, VecElem v b) => (a -> b) -> v a -> v b@@ -84,6 +85,7 @@ vLength = length vToList = id vFromList = id+ vFromListN _ = id vSingleton = pure vReplicate = replicate vMap = map@@ -209,17 +211,18 @@ constantT :: (Vector v, VecElem v a) => ShapeL -> a -> T v a constantT sh x = T (map (const 0) sh) 0 (vSingleton x) --- TODO: change to return a list of vectors.--- Convert an array to a vector in the natural order.-{-# INLINE toVectorT #-}-toVectorT :: (Vector v, VecElem v a) => ShapeL -> T v a -> v a-toVectorT sh a@(T ats ao v) =+-- Convert an array to a list of vectors, which together contain+-- all the elements in the natural order.+-- An invariant: if the input array is non-empty the returned list+-- will have no empty vectors.+-- The minimum/maximum operations rely on this invariant.+{-# INLINE toVectorListT #-}+toVectorListT :: (Vector v, VecElem v a) => ShapeL -> T v a -> [v a]+toVectorListT sh a@(T ats ao v) = let l : ts' = getStridesT sh -- Are strides ok from this point? oks = scanr (&&) True (zipWith (==) ats ts')- loop _ [] _ o =- DL.singleton (vSlice o 1 v)- loop (b:bs) (s:ss) (t:ts) o =+ loop (b:bs) (s:ss) (t:ts) !o = if b then -- All strides normal from this point, -- so just take a slice of the underlying vector.@@ -227,23 +230,31 @@ else -- Strides are not normal, collect slices. DL.concat [ loop bs ss ts (i*t + o) | i <- [0 .. s-1] ]- loop _ _ _ _ = error "impossible"- in if head oks && vLength v == l then+ loop _ _ _ _ = error "impossible" -- due to how @loop@ is called+ in if ats == ts' && vLength v == l then -- All strides are normal, return entire vector- v- else if oks !! length sh then -- Special case for speed.+ [v]+ else if null sh then+ [vSlice ao 1 v]+ else if oks !! (length sh - 1) then -- Special case for speed. -- Innermost dimension is normal, so slices are non-trivial.- vConcat $ DL.toList $ loop oks sh ats ao+ DL.toList $ loop oks sh ats ao else -- All slices would have length 1, going via a list is faster.- vFromList $ toListT sh a+ [vFromListN l $ toListT sh a] --- Convert to a vector containing the right elements,+{-# INLINE toVectorT #-}+toVectorT :: (Vector v, VecElem v a) => ShapeL -> T v a -> v a+toVectorT sh a = case toVectorListT sh a of+ [v] -> v+ l -> vConcat l++-- Convert to a list of vectors containing altogether the right elements, -- but not necessarily in the right order. -- This is used for reduction with commutative&associative operations.-{-# INLINE toUnorderedVectorT #-}-toUnorderedVectorT :: (Vector v, VecElem v a) => ShapeL -> T v a -> v a-toUnorderedVectorT sh a@(T ats ao v) =+{-# INLINE toUnorderedVectorListT #-}+toUnorderedVectorListT :: (Vector v, VecElem v a) => ShapeL -> T v a -> [v a]+toUnorderedVectorListT sh a@(T ats ao v) = -- Figure out if the array maps onto some contiguous slice of the vector. -- Do this by checking if a transposition of the array corresponds to -- normal strides.@@ -256,10 +267,16 @@ l : ts' = getStridesT sh' in if ats' == ts' then- vSlice ao l v+ [vSlice ao l v] else- toVectorT sh a+ toVectorListT sh a +{-# INLINE toUnorderedVectorT #-}+toUnorderedVectorT :: (Vector v, VecElem v a) => ShapeL -> T v a -> v a+toUnorderedVectorT sh a = case toUnorderedVectorListT sh a of+ [v] -> v+ l -> vConcat l+ -- Convert from a vector. {-# INLINE fromVectorT #-} fromVectorT :: ShapeL -> v a -> T v a@@ -268,7 +285,7 @@ -- Convert from a list {-# INLINE fromListT #-} fromListT :: (Vector v, VecElem v a) => [Int] -> [a] -> T v a-fromListT sh = fromVectorT sh . vFromList+fromListT sh = fromVectorT sh . vFromListN (product sh) -- Index into the outermost dimension of an array. {-# INLINE indexT #-}@@ -373,7 +390,7 @@ {-# INLINE reduceT #-} reduceT :: (Vector v, VecElem v a) => ShapeL -> (a -> a -> a) -> a -> T v a -> T v a-reduceT sh f z = scalarT . vFold f z . toVectorT sh+reduceT sh f z = scalarT . foldl' (vFold f) z . toVectorListT sh -- Right fold via toListT. {-# INLINE foldrT #-}@@ -389,13 +406,14 @@ traverseT sh f a = fmap (fromListT sh) (traverse f (toListT sh a)) -- Fast check if all elements are equal.+{-# INLINABLE allSameT #-} allSameT :: (Vector v, VecElem v a, Eq a) => ShapeL -> T v a -> Bool allSameT sh t@(T _ _ v) | vLength v <= 1 = True | otherwise =- let !v' = toVectorT sh t- !x = vIndex v' 0- in vAll (x ==) v'+ let !l = toVectorListT sh t+ !x = vIndex (l !! 0) 0+ in all (vAll (x ==)) l newtype Rect = Rect { unRect :: [String] } -- A rectangle of text @@ -482,13 +500,14 @@ zipWithLong2 f (a:as) (b:bs) = f a b : zipWithLong2 f as bs zipWithLong2 _ _ bs = bs +{-# INLINABLE padT #-} padT :: forall v a . (Vector v, VecElem v a) => a -> [(Int, Int)] -> ShapeL -> T v a -> ([Int], T v a) padT v aps ash at = (ss, fromVectorT ss $ vConcat $ pad' aps ash st at) where pad' :: [(Int, Int)] -> ShapeL -> [Int] -> T v a -> [v a]- pad' [] sh _ t = [toVectorT sh t]+ pad' [] sh _ t = toVectorListT sh t pad' ((l,h):ps) (s:sh) (n:ns) t = [vReplicate (n*l) v] ++ concatMap (pad' ps sh ns . indexT t) [0..s-1] ++ [vReplicate (n*h) v]- pad' _ _ _ _ = error $ "pad: rank mismatch: " ++ show (length aps, length ash)+ pad' _ _ _ _ = error $ "pad: rank mismatch " ++ show (length aps, length ash) _ : st = getStridesT ss ss = zipWithLong2 (\ (l,h) s -> l+s+h) aps ash @@ -507,36 +526,36 @@ loop [] [] = [] loop (1:ss) sts = 0 : loop ss sts loop (_:ss) (st:sts) = st : loop ss sts- loop _ _ = error $ "simpleReshape: shouldn't happen: " ++ show (osts, os, ns)+ loop _ _ = error $ "simpleReshape: shouldn't happen " ++ show (osts, os, ns) simpleReshape _ _ _ = Nothing -- Note: assumes + is commutative&associative. {-# INLINE sumT #-} sumT :: (Vector v, VecElem v a, Num a) => ShapeL -> T v a -> a-sumT sh = vSum . toUnorderedVectorT sh+sumT sh = sum . map vSum . toUnorderedVectorListT sh -- Note: assumes * is commutative&associative. {-# INLINE productT #-} productT :: (Vector v, VecElem v a, Num a) => ShapeL -> T v a -> a-productT sh = vProduct . toUnorderedVectorT sh+productT sh = product . map vProduct . toUnorderedVectorListT sh -- Note: assumes max is commutative&associative. {-# INLINE maximumT #-} maximumT :: (Vector v, VecElem v a, Ord a) => ShapeL -> T v a -> a-maximumT sh = vMaximum . toUnorderedVectorT sh+maximumT sh = maximum . map vMaximum . toUnorderedVectorListT sh -- Note: assumes min is commutative&associative. {-# INLINE minimumT #-} minimumT :: (Vector v, VecElem v a, Ord a) => ShapeL -> T v a -> a-minimumT sh = vMinimum . toUnorderedVectorT sh+minimumT sh = minimum . map vMinimum . toUnorderedVectorListT sh {-# INLINE anyT #-} anyT :: (Vector v, VecElem v a) => ShapeL -> (a -> Bool) -> T v a -> Bool-anyT sh p = vAny p . toUnorderedVectorT sh+anyT sh p = or . map (vAny p) . toUnorderedVectorListT sh {-# INLINE allT #-} allT :: (Vector v, VecElem v a) => ShapeL -> (a -> Bool) -> T v a -> Bool-allT sh p = vAll p . toUnorderedVectorT sh+allT sh p = and . map (vAll p) . toUnorderedVectorListT sh {-# INLINE updateT #-} updateT :: (Vector v, VecElem v a) => ShapeL -> T v a -> [([Int], a)] -> T v a@@ -563,6 +582,7 @@ ------- -- | Permute the elements of a list, the first argument is indices into the original list.+{-# INLINE permute #-} permute :: [Int] -> [a] -> [a] permute is xs = map (xs!!) is @@ -570,6 +590,7 @@ revDropWhile :: (a -> Bool) -> [a] -> [a] revDropWhile p = reverse . dropWhile p . reverse +{-# INLINABLE allSame #-} allSame :: (Eq a) => [a] -> Bool allSame [] = True allSame (x : xs) = all (x ==) xs
Data/Array/Internal/Dynamic.hs view
@@ -65,6 +65,8 @@ vToList = V.toList {-# INLINE vFromList #-} vFromList = V.fromList+ {-# INLINE vFromListN #-}+ vFromListN = V.fromListN {-# INLINE vSingleton #-} vSingleton = V.singleton {-# INLINE vReplicate #-}
Data/Array/Internal/DynamicG.hs view
@@ -13,13 +13,13 @@ -- limitations under the License. {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-} -- | Arrays of dynamic size. The arrays are polymorphic in the underlying -- linear data structure used to store the actual values. module Data.Array.Internal.DynamicG(@@ -43,16 +43,16 @@ update, generate, iterateN, iota, ) where-import Control.DeepSeq-import Control.Monad(replicateM)-import Data.Data(Data)-import Data.List(sort)-import GHC.Generics(Generic)-import GHC.Stack-import Test.QuickCheck hiding (generate)-import Text.PrettyPrint.HughesPJClass hiding ((<>))+import Control.DeepSeq+import Control.Monad (replicateM)+import Data.Data (Data)+import Data.List (sort)+import GHC.Generics (Generic)+import GHC.Stack+import Test.QuickCheck hiding (generate)+import Text.PrettyPrint.HughesPJClass hiding ((<>)) -import Data.Array.Internal+import Data.Array.Internal -- | Arrays stored in a /v/ with values of type /a/. type role Array representational nominal@@ -125,8 +125,8 @@ -- O(n) time. {-# INLINE fromList #-} fromList :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> [a] -> Array v a-fromList ss vs | n /= l = error $ "fromList: size mismatch" ++ show (n, l)- | otherwise = A ss $ T st 0 $ vFromList vs+fromList ss vs | n /= l = error $ "fromList: size mismatch " ++ show (n, l)+ | otherwise = A ss $ T st 0 $ vFromListN l vs where n : st = getStridesT ss l = length vs @@ -135,7 +135,7 @@ -- O(1) time. {-# INLINE fromVector #-} fromVector :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> v a -> Array v a-fromVector ss v | n /= l = error $ "fromList: size mismatch" ++ show (n, l)+fromVector ss v | n /= l = error $ "fromList: size mismatch " ++ show (n, l) | otherwise = A ss $ T st 0 v where n : st = getStridesT ss l = vLength v@@ -190,7 +190,7 @@ {-# INLINE unScalar #-} unScalar :: (HasCallStack, Vector v, VecElem v a) => Array v a -> a unScalar (A [] t) = unScalarT t-unScalar _ = error "unScalar: not a scalar"+unScalar _ = error "unScalar: not a scalar" -- | Make an array with all elements having the same value. -- O(1) time@@ -211,7 +211,7 @@ zipWithA :: (HasCallStack, Vector v, VecElem v a, VecElem v b, VecElem v c) => (a -> b -> c) -> Array v a -> Array v b -> Array v c zipWithA f (A s t) (A s' t') | s == s' = A s (zipWithT s f t t')- | otherwise = error $ "zipWithA: shape mismatch: " ++ show (s, s')+ | otherwise = error $ "zipWithA: shape mismatch " ++ show (s, s') -- | Map over the array elements. -- O(n) time.@@ -219,7 +219,7 @@ zipWith3A :: (HasCallStack, Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d) => (a -> b -> c -> d) -> Array v a -> Array v b -> Array v c -> Array v d zipWith3A f (A s t) (A s' t') (A s'' t'') | s == s' && s == s'' = A s (zipWith3T s f t t' t'')- | otherwise = error $ "zipWith3A: shape mismatch: " ++ show (s, s', s'')+ | otherwise = error $ "zipWith3A: shape mismatch " ++ show (s, s', s'') -- | Map over the array elements. -- O(n) time.@@ -227,7 +227,7 @@ zipWith4A :: (HasCallStack, Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d, VecElem v e) => (a -> b -> c -> d -> e) -> Array v a -> Array v b -> Array v c -> Array v d -> Array v e zipWith4A f (A s t) (A s' t') (A s'' t'') (A s''' t''') | s == s' && s == s'' && s == s''' = A s (zipWith4T s f t t' t'' t''')- | otherwise = error $ "zipWith4A: shape mismatch: " ++ show (s, s', s'', s''')+ | otherwise = error $ "zipWith4A: shape mismatch " ++ show (s, s', s'', s''') -- | Map over the array elements. -- O(n) time.@@ -235,7 +235,7 @@ zipWith5A :: (HasCallStack, Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d, VecElem v e, VecElem v f) => (a -> b -> c -> d -> e -> f) -> Array v a -> Array v b -> Array v c -> Array v d -> Array v e -> Array v f zipWith5A f (A s t) (A s' t') (A s'' t'') (A s''' t''') (A s'''' t'''') | s == s' && s == s'' && s == s''' && s == s'''' = A s (zipWith5T s f t t' t'' t''' t'''')- | otherwise = error $ "zipWith5A: shape mismatch: " ++ show (s, s', s'', s''', s'''')+ | otherwise = error $ "zipWith5A: shape mismatch " ++ show (s, s', s'', s''', s'''') -- | Pad each dimension on the low and high side with the given value. -- O(n) time.@@ -317,9 +317,9 @@ window aws (A ash (T ss o v)) = A (win aws ash) (T (ss' ++ ss) o v) where ss' = zipWith const ss aws win (w:ws) (s:sh) | w <= s = s - w + 1 : win ws sh- | otherwise = error $ "window: bad window size : " ++ show (w, s)+ | otherwise = error $ "window: bad window size " ++ show (w, s) win [] sh = aws ++ sh- win _ _ = error $ "window: rank mismatch: " ++ show (aws, ash)+ win _ _ = error $ "window: rank mismatch " ++ show (aws, ash) -- | Stride the outermost dimensions. -- E.g., if the array shape is @[10,12,8]@ and the strides are@@ -330,8 +330,8 @@ stride :: (HasCallStack, Vector v) => [Int] -> Array v a -> Array v a stride ats (A ash (T ss o v)) = A (str ats ash) (T (zipWith (*) (ats ++ repeat 1) ss) o v) where str (t:ts) (s:sh) = (s+t-1) `quot` t : str ts sh- str [] sh = sh- str _ _ = error $ "stride: rank mismatch: " ++ show (ats, ash)+ str [] sh = sh+ str _ _ = error $ "stride: rank mismatch " ++ show (ats, ash) -- | Rotate the array k times along the d'th dimension. -- E.g., if the array shape is @[2, 3, 2]@, d is 1, and k is 4,@@ -490,13 +490,13 @@ where r = length sh rsh = [ if i `elem` ds then s else 1 | (i, s) <- zip [0..] sh ] ascending (x:y:ys) = x < y && ascending (y:ys)- ascending _ = True+ ascending _ = True -- | Update the array at the specified indicies to the associated value. update :: (HasCallStack, Vector v, VecElem v a) => Array v a -> [([Int], a)] -> Array v a update (A sh t) us | all (ok . fst) us = A sh $ updateT sh t us- | otherwise = error $ "update: index out of bounds " ++ show (filter (not . ok) $ map fst us)+ | otherwise = error $ "update: index out of bounds: " ++ show (filter (not . ok) $ map fst us) where ok is = length is == r && and (zipWith (\ i s -> 0 <= i && i < s) is sh) r = length sh
Data/Array/Internal/DynamicS.hs view
@@ -72,6 +72,8 @@ vToList = V.toList {-# INLINE vFromList #-} vFromList = V.fromList+ {-# INLINE vFromListN #-}+ vFromListN = V.fromListN {-# INLINE vSingleton #-} vSingleton = V.singleton {-# INLINE vReplicate #-}
Data/Array/Internal/DynamicU.hs view
@@ -69,6 +69,8 @@ vToList = V.toList {-# INLINE vFromList #-} vFromList = V.fromList+ {-# INLINE vFromListN #-}+ vFromListN = V.fromListN {-# INLINE vSingleton #-} vSingleton = V.singleton {-# INLINE vReplicate #-}
Data/Array/Internal/RankedG.hs view
@@ -69,9 +69,9 @@ deriving (Generic, Data) instance (Vector v, Show a, VecElem v a) => Show (Array n v a) where- {-# INLINABLE showsPrec #-} showsPrec p a@(A s _) = showParen (p > 10) $ showString "fromList " . showsPrec 11 s . showString " " . showsPrec 11 (toList a)+ {-# INLINABLE showsPrec #-} instance (KnownNat n, Vector v, Read a, VecElem v a) => Read (Array n v a) where readsPrec p = readParen (p > 10) $ \ r1 ->@@ -92,6 +92,7 @@ instance (NFData (v a)) => NFData (Array n v a) where rnf (A sh v) = rnf sh `seq` rnf v+ {-# INLINE rnf #-} -- | The number of elements in the array. -- O(1) time.@@ -141,7 +142,7 @@ ShapeL -> [a] -> Array n v a fromList ss vs | n /= l = error $ "fromList: size mismatch " ++ show (n, l) | length ss /= valueOf @n = error $ "fromList: rank mismatch " ++ show (length ss, valueOf @n :: Int)- | otherwise = A ss $ T st 0 $ vFromList vs+ | otherwise = A ss $ T st 0 $ vFromListN l vs where n : st = getStridesT ss l = length vs @@ -151,7 +152,7 @@ {-# INLINE fromVector #-} fromVector :: forall n v a . (HasCallStack, Vector v, VecElem v a, KnownNat n) => ShapeL -> v a -> Array n v a-fromVector ss v | n /= l = error $ "fromVector: size mismatch" ++ show (n, l)+fromVector ss v | n /= l = error $ "fromVector: size mismatch " ++ show (n, l) | length ss /= valueOf @n = error $ "fromVector: rank mismatch " ++ show (length ss, valueOf @n :: Int) | otherwise = A ss $ T st 0 v where n : st = getStridesT ss@@ -218,7 +219,7 @@ ShapeL -> a -> Array n v a constant sh | badShape sh = error $ "constant: bad shape: " ++ show sh | length sh /= valueOf @n = error "constant: rank mismatch"- | otherwise = A sh . constantT sh+ | otherwise = A sh . constantT sh -- | Map over the array elements. -- O(n) time.@@ -233,7 +234,7 @@ zipWithA :: (Vector v, VecElem v a, VecElem v b, VecElem v c) => (a -> b -> c) -> Array n v a -> Array n v b -> Array n v c zipWithA f (A s t) (A s' t') | s == s' = A s (zipWithT s f t t')- | otherwise = error $ "zipWithA: shape mismatch: " ++ show (s, s')+ | otherwise = error $ "zipWithA: shape mismatch " ++ show (s, s') -- | Map over the array elements. -- O(n) time.@@ -241,7 +242,7 @@ zipWith3A :: (Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d) => (a -> b -> c -> d) -> Array n v a -> Array n v b -> Array n v c -> Array n v d zipWith3A f (A s t) (A s' t') (A s'' t'') | s == s' && s == s'' = A s (zipWith3T s f t t' t'')- | otherwise = error $ "zipWith3A: shape mismatch: " ++ show (s, s', s'')+ | otherwise = error $ "zipWith3A: shape mismatch " ++ show (s, s', s'') -- | Pad each dimension on the low and high side with the given value. -- O(n) time.@@ -322,13 +323,13 @@ {-# INLINE window #-} window :: forall n n' v a . (Vector v, KnownNat n, KnownNat n') => [Int] -> Array n v a -> Array n' v a-window aws _ | valueOf @n' /= length aws + valueOf @n = error $ "window: rank mismatch: " ++ show (valueOf @n' :: Int, length aws, valueOf @n :: Int)+window aws _ | valueOf @n' /= length aws + valueOf @n = error $ "window: rank mismatch " ++ show (valueOf @n' :: Int, length aws, valueOf @n :: Int) window aws (A ash (T ss o v)) = A (win aws ash) (T (ss' ++ ss) o v) where ss' = zipWith const ss aws win (w:ws) (s:sh) | w <= s = s - w + 1 : win ws sh- | otherwise = error $ "window: bad window size : " ++ show (w, s)+ | otherwise = error $ "window: bad window size " ++ show (w, s) win [] sh = aws ++ sh- win _ _ = error $ "window: rank mismatch: " ++ show (aws, ash)+ win _ _ = error $ "window: rank mismatch " ++ show (aws, ash) -- | Stride the outermost dimensions. -- E.g., if the array shape is @[10,12,8]@ and the strides are@@ -339,11 +340,12 @@ stride ats (A ash (T ss o v)) = A (str ats ash) (T (zipWith (*) (ats ++ repeat 1) ss) o v) where str (t:ts) (s:sh) = (s+t-1) `quot` t : str ts sh str [] sh = sh- str _ _ = error $ "stride: rank mismatch: " ++ show (ats, ash)+ str _ _ = error $ "stride: rank mismatch " ++ show (ats, ash) -- | Rotate the array k times along the d'th dimension. -- E.g., if the array shape is @[2, 3, 2]@, d is 1, and k is 4, -- the resulting shape will be @[2, 4, 3, 2]@.+{-# INLINABLE rotate #-} rotate :: forall d p v a. (KnownNat p, KnownNat d, Vector v, VecElem v a,@@ -455,6 +457,7 @@ traverseA f (A sh t) = A sh <$> traverseT sh f t -- | Check if all elements of the array are equal.+{-# INLINE allSameA #-} allSameA :: (Vector v, VecElem v a, Eq a) => Array r v a -> Bool allSameA (A sh t) = allSameT sh t @@ -500,6 +503,7 @@ -- and just replicate the data along all other dimensions. -- The list of dimensions indicies must have the same rank as the argument array -- and it must be strictly ascending.+{-# INLINABLE broadcast #-} broadcast :: forall r' r v a . (HasCallStack, Vector v, VecElem v a, KnownNat r, KnownNat r') => [Int] -> ShapeL -> Array r v a -> Array r' v a
Data/Array/Internal/RankedS.hs view
@@ -94,17 +94,20 @@ -- In the linearization of the array the outermost (i.e. first list element) -- varies most slowly. -- O(1) time.+{-# INLINE shapeL #-} shapeL :: Array n a -> ShapeL shapeL = G.shapeL . unA -- | The rank of an array, i.e., the number of dimensions it has, -- which is the @n@ in @Array n a@. -- O(1) time.+{-# INLINE rank #-} rank :: (KnownNat n) => Array n a -> Int rank = G.rank . unA -- | Index into an array. Fails if the index is out of bounds. -- O(1) time.+{-# INLINABLE index #-} index :: (Unbox a) => Array (1+n) a -> Int -> Array n a index a = A . G.index (unA a) @@ -138,6 +141,7 @@ -- This is semantically an identity function, but can have big performance -- implications. -- O(n) or O(1) time.+{-# INLINABLE normalize #-} normalize :: (Unbox a, KnownNat n) => Array n a -> Array n a normalize = A . G.normalize . unA @@ -150,20 +154,24 @@ -- | Change the size of dimensions with size 1. These dimension can be changed to any size. -- All other dimensions must remain the same. -- O(1) time.+{-# INLINABLE stretch #-} stretch :: ShapeL -> Array n a -> Array n a stretch s = A . G.stretch s . unA -- | Change the size of the outermost dimension by replication.+{-# INLINABLE stretchOuter #-} stretchOuter :: (HasCallStack, 1 <= n) => Int -> Array n a -> Array n a stretchOuter s = A . G.stretchOuter s . unA -- | Convert a value to a scalar (rank 0) array. -- O(1) time.+{-# INLINE scalar #-} scalar :: (Unbox a) => a -> Array 0 a scalar = A . G.scalar -- | Convert a scalar (rank 0) array to a value. -- O(1) time.+{-# INLINE unScalar #-} unScalar :: (Unbox a) => Array 0 a -> a unScalar = G.unScalar . unA @@ -182,18 +190,21 @@ -- | Map over the array elements. -- O(n) time.+{-# INLINABLE zipWithA #-} zipWithA :: (Unbox a, Unbox b, Unbox c) => (a -> b -> c) -> Array n a -> Array n b -> Array n c zipWithA f a b = A $ G.zipWithA f (unA a) (unA b) -- | Map over the array elements. -- O(n) time.+{-# INLINABLE zipWith3A #-} zipWith3A :: (Unbox a, Unbox b, Unbox c, Unbox d) => (a -> b -> c -> d) -> Array n a -> Array n b -> Array n c -> Array n d zipWith3A f a b c = A $ G.zipWith3A f (unA a) (unA b) (unA c) -- | Pad each dimension on the low and high side with the given value. -- O(n) time.+{-# INLINABLE pad #-} pad :: (Unbox a, KnownNat n) => [(Int, Int)] -> a -> Array n a -> Array n a pad ps v = A . G.pad ps v . unA @@ -215,6 +226,7 @@ -- | Concatenate a number of arrays into a single array. -- Fails if any, but the outer, dimensions differ. -- O(n) time.+{-# INLINABLE concatOuter #-} concatOuter :: (Unbox a, KnownNat n) => [Array n a] -> Array n a concatOuter = A . G.concatOuter . coerce @@ -244,6 +256,7 @@ -- -- If the window parameter @ws = [w1,...,wk]@ and @wa = window ws a@ then -- @wa `index` i1 ... `index` ik == slice [(i1,w1),...,(ik,wk)] a@.+{-# INLINABLE window #-} window :: (KnownNat n, KnownNat n') => [Int] -> Array n a -> Array n' a window ws = A . G.window ws . unA @@ -251,12 +264,14 @@ -- E.g., if the array shape is @[10,12,8]@ and the strides are -- @[2,2]@ then the resulting shape will be @[5,6,8]@. -- O(1) time.+{-# INLINABLE stride #-} stride :: [Int] -> Array n a -> Array n a stride ws = A . G.stride ws . unA -- | Rotate the array k times along the d'th dimension. -- E.g., if the array shape is @[2, 3, 2]@, d is 1, and k is 4, -- the resulting shape will be @[2, 4, 3, 2]@.+{-# INLINABLE rotate #-} rotate :: forall d p a. (KnownNat p, KnownNat d, Unbox a, -- Nonsense@@ -276,6 +291,7 @@ -- The extracted slice must fall within the array dimensions. -- E.g. @slice [1,2] (fromList [4] [1,2,3,4]) == [2,3]@. -- O(1) time.+{-# INLINABLE slice #-} slice :: [(Int, Int)] -> Array n a -> Array n a slice ss = A . G.slice ss . unA @@ -283,6 +299,7 @@ -- the results into an array with the same /n/ outermost dimensions. -- The /n/ must not exceed the rank of the array. -- O(1) time.+{-# INLINABLE rerank #-} rerank :: forall n i o a b . (Unbox a, Unbox b, KnownNat n, KnownNat o, KnownNat (n+o), KnownNat (1+o)) => (Array i a -> Array o b) -> Array (n+i) a -> Array (n+o) b@@ -292,6 +309,7 @@ -- the results into an array with the same /n/ outermost dimensions. -- The /n/ must not exceed the rank of the array. -- O(n) time.+{-# INLINABLE rerank2 #-} rerank2 :: forall n i o a b c . (Unbox a, Unbox b, Unbox c, KnownNat n, KnownNat o, KnownNat (n+o), KnownNat (1+o)) => (Array i a -> Array i b -> Array o c) -> Array (n+i) a -> Array (n+i) b -> Array (n+o) c@@ -299,30 +317,36 @@ -- | Reverse the given dimensions, with the outermost being dimension 0. -- O(1) time.+{-# INLINABLE rev #-} rev :: [Int] -> Array n a -> Array n a rev rs = A . G.rev rs . unA -- | Reduce all elements of an array into a rank 0 array. -- To reduce parts use 'rerank' and 'transpose' together with 'reduce'. -- O(n) time.+{-# INLINABLE reduce #-} reduce :: (Unbox a) => (a -> a -> a) -> a -> Array n a -> Array 0 a reduce f z = A . G.reduce f z . unA -- | Constrained version of 'foldr' for Arrays.+{-# INLINABLE foldrA #-} foldrA :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Array n a -> b foldrA f z = G.foldrA f z . unA -- | Constrained version of 'traverse' for Arrays.+{-# INLINABLE traverseA #-} traverseA :: (Unbox a, Unbox b, Applicative f) => (a -> f b) -> Array n a -> f (Array n b) traverseA f = fmap A . G.traverseA f . unA -- | Check if all elements of the array are equal.+{-# INLINABLE allSameA #-} allSameA :: (Unbox a, Eq a) => Array n a -> Bool allSameA = G.allSameA . unA -instance (KnownNat r, Arbitrary a, Unbox a) => Arbitrary (Array r a) where arbitrary = A <$> arbitrary+instance (KnownNat r, Arbitrary a, Unbox a) => Arbitrary (Array r a) where+ arbitrary = A <$> arbitrary -- | Sum of all elements. {-# INLINE sumA #-}@@ -358,6 +382,7 @@ -- and just replicate the data along all other dimensions. -- The list of dimensions indicies must have the same rank as the argument array -- and it must be strictly ascending.+{-# INLINABLE broadcast #-} broadcast :: forall r' r a . (HasCallStack, Unbox a, KnownNat r, KnownNat r') => [Int] -> ShapeL -> Array r a -> Array r' a
Data/Array/Internal/Shape.hs view
@@ -203,7 +203,7 @@ withShapeP (n:ns) f = case someNatVal (toInteger n) of Just (SomeNat (_ :: Proxy n)) -> withShapeP ns (\ (_ :: Proxy ns) -> f (Proxy :: Proxy (n ': ns)))- _ -> error $ "withShape: bad size " ++ show n+ _ -> error $ "withShape: bad size: " ++ show n withShape :: [Int] -> (forall sh . (Shape sh) => r) -> r withShape sh f = withShapeP sh (\ (_ :: Proxy sh) -> f @sh)
Data/Array/Internal/ShapedG.hs view
@@ -121,7 +121,7 @@ {-# INLINE index #-} index :: forall s sh v a . (HasCallStack, Vector v, KnownNat s) => Array (s:sh) v a -> Int -> Array sh v a-index (A t) i | i < 0 || i >= s = error $ "index: out of bounds " ++ show i ++ " >= " ++ show s+index (A t) i | i < 0 || i >= s = error $ "index: out of bounds: " ++ show i ++ " >= " ++ show s | otherwise = A $ indexT t i where s = valueOf @s @@ -144,7 +144,7 @@ fromList :: forall sh v a . (HasCallStack, Vector v, VecElem v a, Shape sh) => [a] -> Array sh v a fromList vs | n /= l = error $ "fromList: size mismatch " ++ show (n, l)- | otherwise = A $ T st 0 $ vFromList vs+ | otherwise = A $ T st 0 $ vFromListN l vs where n : st = getStridesT ss l = length vs ss = shapeP (Proxy :: Proxy sh)@@ -155,7 +155,7 @@ {-# INLINE fromVector #-} fromVector :: forall sh v a . (HasCallStack, Vector v, VecElem v a, Shape sh) => v a -> Array sh v a-fromVector v | n /= l = error $ "fromVector: size mismatch" ++ show (n, l)+fromVector v | n /= l = error $ "fromVector: size mismatch " ++ show (n, l) | otherwise = A $ T st 0 v where n : st = getStridesT ss l = vLength v
orthotope.cabal view
@@ -1,5 +1,5 @@ name: orthotope-version: 0.1.7.2+version: 0.1.8.0 synopsis: Multidimensional arrays inspired by APL license: Apache license-file: LICENSE@@ -18,7 +18,7 @@ LICENSE README.md -tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2+tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 || ==9.14.1 source-repository head type: git@@ -26,7 +26,8 @@ library hs-source-dirs: .- ghc-options: -Wall -Wno-unrecognised-warning-flags -Wno-x-partial+ ghc-options: -Wall -Wno-unrecognised-warning-flags -Wno-x-partial -Widentities -Wmissing-export-lists -Wpartial-fields -Wunused-packages -Wredundant-bang-patterns -Wredundant-strictness-flags+-- -Wredundant-constraints -Wterm-variable-capture -Wmissed-specialisations -- if impl(ghc >= 9.8) -- ghc-options: -Wmissing-role-annotations exposed-modules: Data.Array.Convert@@ -60,7 +61,7 @@ , Data.Array.Internal.ShapedS , Data.Array.Internal.ShapedU - build-depends: base >= 4.12 && < 4.22,+ build-depends: base >= 4.12 && < 4.23, QuickCheck >= 2.14.3 && < 2.18, deepseq >= 1.4.4 && < 1.7, pretty >= 1.1.3 && < 1.2,@@ -71,6 +72,7 @@ test-suite tests type: exitcode-stdio-1.0+ ghc-options: -Wall -Wno-unrecognised-warning-flags -Wno-x-partial -Widentities -Wmissing-export-lists -Wpartial-fields -Wunused-packages -Wredundant-bang-patterns -Wredundant-strictness-flags hs-source-dirs: tests main-is: Tests.hs @@ -93,9 +95,7 @@ base, deepseq, orthotope,- QuickCheck, vector, HUnit >= 1.6.2 && < 1.7, test-framework >= 0.8.2 && < 0.9,- test-framework-hunit >= 0.3.0 && < 0.4,- test-framework-quickcheck2 >= 0.3.0 && < 0.4+ test-framework-hunit >= 0.3.0 && < 0.4