-- Copyright 2020 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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(
  Array(..), Vector, VecElem,
  size, shapeL, rank,
  toList, fromList, toVector, fromVector,
  normalize,
  scalar, unScalar, constant,
  reshape, stretch, stretchOuter, transpose,
  index, pad,
  mapA, zipWithA, zipWith3A, zipWith4A, zipWith5A,
  append, concatOuter,
  ravel, unravel,
  window, stride, rotate,
  slice, rerank, rerank2, rev,
  reduce, foldrA, traverseA,
  allSameA,
  sumA, productA, maximumA, minimumA,
  anyA, allA,
  broadcast,
  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 Data.Array.Internal

-- | Arrays stored in a /v/ with values of type /a/.
data Array v a = A !ShapeL !(T v a)
  deriving ((forall x. Array v a -> Rep (Array v a) x)
-> (forall x. Rep (Array v a) x -> Array v a)
-> Generic (Array v a)
forall x. Rep (Array v a) x -> Array v a
forall x. Array v a -> Rep (Array v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: * -> *) a x. Rep (Array v a) x -> Array v a
forall (v :: * -> *) a x. Array v a -> Rep (Array v a) x
$cto :: forall (v :: * -> *) a x. Rep (Array v a) x -> Array v a
$cfrom :: forall (v :: * -> *) a x. Array v a -> Rep (Array v a) x
Generic, Typeable (Array v a)
DataType
Constr
Typeable (Array v a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Array v a -> c (Array v a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Array v a))
-> (Array v a -> Constr)
-> (Array v a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Array v a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Array v a)))
-> ((forall b. Data b => b -> b) -> Array v a -> Array v a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Array v a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Array v a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Array v a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Array v a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Array v a -> m (Array v a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Array v a -> m (Array v a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Array v a -> m (Array v a))
-> Data (Array v a)
Array v a -> DataType
Array v a -> Constr
(forall b. Data b => b -> b) -> Array v a -> Array v a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array v a -> c (Array v a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array v a)
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Array v a -> u
forall u. (forall d. Data d => d -> u) -> Array v a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array v a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array v a -> c (Array v a)
forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Typeable (Array v a)
forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Array v a -> DataType
forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Array v a -> Constr
forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
(forall b. Data b => b -> b) -> Array v a -> Array v a
forall (v :: * -> *) a u.
(Typeable v, Typeable a, Data (v a)) =>
Int -> (forall d. Data d => d -> u) -> Array v a -> u
forall (v :: * -> *) a u.
(Typeable v, Typeable a, Data (v a)) =>
(forall d. Data d => d -> u) -> Array v a -> [u]
forall (v :: * -> *) a r r'.
(Typeable v, Typeable a, Data (v a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
forall (v :: * -> *) a r r'.
(Typeable v, Typeable a, Data (v a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Typeable a, Data (v a), Monad m) =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Typeable a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Typeable a, Data (v a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array v a)
forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Typeable a, Data (v a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array v a -> c (Array v a)
forall (v :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable v, Typeable a, Data (v a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Array v a))
forall (v :: * -> *) a (t :: * -> * -> *) (c :: * -> *).
(Typeable v, Typeable a, Data (v a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array v a))
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Array v a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array v a))
$cA :: Constr
$tArray :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
$cgmapMo :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Typeable a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
gmapMp :: (forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
$cgmapMp :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Typeable a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
gmapM :: (forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
$cgmapM :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Typeable a, Data (v a), Monad m) =>
(forall d. Data d => d -> m d) -> Array v a -> m (Array v a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Array v a -> u
$cgmapQi :: forall (v :: * -> *) a u.
(Typeable v, Typeable a, Data (v a)) =>
Int -> (forall d. Data d => d -> u) -> Array v a -> u
gmapQ :: (forall d. Data d => d -> u) -> Array v a -> [u]
$cgmapQ :: forall (v :: * -> *) a u.
(Typeable v, Typeable a, Data (v a)) =>
(forall d. Data d => d -> u) -> Array v a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
$cgmapQr :: forall (v :: * -> *) a r r'.
(Typeable v, Typeable a, Data (v a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
$cgmapQl :: forall (v :: * -> *) a r r'.
(Typeable v, Typeable a, Data (v a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Array v a -> r
gmapT :: (forall b. Data b => b -> b) -> Array v a -> Array v a
$cgmapT :: forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
(forall b. Data b => b -> b) -> Array v a -> Array v a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array v a))
$cdataCast2 :: forall (v :: * -> *) a (t :: * -> * -> *) (c :: * -> *).
(Typeable v, Typeable a, Data (v a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Array v a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Array v a))
$cdataCast1 :: forall (v :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable v, Typeable a, Data (v a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Array v a))
dataTypeOf :: Array v a -> DataType
$cdataTypeOf :: forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Array v a -> DataType
toConstr :: Array v a -> Constr
$ctoConstr :: forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Array v a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array v a)
$cgunfold :: forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Typeable a, Data (v a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array v a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array v a -> c (Array v a)
$cgfoldl :: forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Typeable a, Data (v a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array v a -> c (Array v a)
$cp1Data :: forall (v :: * -> *) a.
(Typeable v, Typeable a, Data (v a)) =>
Typeable (Array v a)
Data)

instance (Vector v, Show a, VecElem v a) => Show (Array v a) where
  showsPrec :: Int -> Array v a -> ShowS
showsPrec Int
p a :: Array v a
a@(A ShapeL
s T v a
_) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShapeL -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShapeL
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Array v a -> [a]
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> [a]
toList Array v a
a)

instance (Vector v, Read a, VecElem v a) => Read (Array v a) where
  readsPrec :: Int -> ReadS (Array v a)
readsPrec Int
p = Bool -> ReadS (Array v a) -> ReadS (Array v a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Array v a) -> ReadS (Array v a))
-> ReadS (Array v a) -> ReadS (Array v a)
forall a b. (a -> b) -> a -> b
$ \ String
r1 ->
    [(ShapeL -> [a] -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> [a] -> Array v a
fromList ShapeL
s [a]
xs, String
r4) | (String
"fromList", String
r2) <- ReadS String
lex String
r1, (ShapeL
s, String
r3) <- Int -> ReadS ShapeL
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
r2,
                    ([a]
xs, String
r4) <- Int -> ReadS [a]
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
r3, ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ShapeL
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs]

instance (Vector v, Eq a, VecElem v a, Eq (v a)) => Eq (Array v a) where
  (A ShapeL
s T v a
v) == :: Array v a -> Array v a -> Bool
== (A ShapeL
s' T v a
v') = ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s' Bool -> Bool -> Bool
&& ShapeL -> T v a -> T v a -> Bool
forall (v :: * -> *) a.
(Vector v, VecElem v a, Eq a, Eq (v a)) =>
ShapeL -> T v a -> T v a -> Bool
equalT ShapeL
s T v a
v T v a
v'
  {-# INLINE (==) #-}

instance (Vector v, Ord a, Ord (v a), VecElem v a) => Ord (Array v a) where
  (A ShapeL
s T v a
v) compare :: Array v a -> Array v a -> Ordering
`compare` (A ShapeL
s' T v a
v') = ShapeL -> ShapeL -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ShapeL
s ShapeL
s' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> ShapeL -> T v a -> T v a -> Ordering
forall (v :: * -> *) a.
(Vector v, VecElem v a, Ord a, Ord (v a)) =>
ShapeL -> T v a -> T v a -> Ordering
compareT ShapeL
s T v a
v T v a
v'
  {-# INLINE compare #-}

instance (Vector v, Pretty a, VecElem v a) => Pretty (Array v a) where
  pPrintPrec :: PrettyLevel -> Rational -> Array v a -> Doc
pPrintPrec PrettyLevel
l Rational
p (A ShapeL
sh T v a
t) = PrettyLevel -> Rational -> ShapeL -> T v a -> Doc
forall (v :: * -> *) a.
(Vector v, VecElem v a, Pretty a) =>
PrettyLevel -> Rational -> ShapeL -> T v a -> Doc
ppT PrettyLevel
l Rational
p ShapeL
sh T v a
t

instance (NFData (v a)) => NFData (Array v a)

-- | The number of elements in the array.
{-# INLINE size #-}
size :: Array v a -> Int
size :: Array v a -> Int
size = ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (ShapeL -> Int) -> (Array v a -> ShapeL) -> Array v a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL

-- | The shape of an array, i.e., a list of the sizes of its dimensions.
-- In the linearization of the array the outermost (i.e. first list element)
-- varies most slowly.
-- O(1) time.
{-# INLINE shapeL #-}
shapeL :: Array v a -> ShapeL
shapeL :: Array v a -> ShapeL
shapeL (A ShapeL
s T v a
_) = ShapeL
s

-- | The rank of an array, i.e., the number if dimensions it has.
-- O(1) time.
{-# INLINE rank #-}
rank :: Array v a -> Int
rank :: Array v a -> Int
rank (A ShapeL
s T v a
_) = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
s

-- | Index into an array.  Fails if the array has rank 0 or if the index is out of bounds.
-- O(1) time.
{-# INLINE index #-}
index :: (HasCallStack, Vector v) => Array v a -> Int -> Array v a
index :: Array v a -> Int -> Array v a
index (A (Int
s:ShapeL
ss) T v a
t) Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"index: out of bounds " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
i, Int
s)
                     | Bool
otherwise = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
ss (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ T v a -> Int -> T v a
forall (v :: * -> *) a. T v a -> Int -> T v a
indexT T v a
t Int
i
index (A [] T v a
_) Int
_ = String -> Array v a
forall a. HasCallStack => String -> a
error String
"index: scalar"

-- | Convert to a list with the elements in the linearization order.
-- O(n) time.
{-# INLINE toList #-}
toList :: (Vector v, VecElem v a) => Array v a -> [a]
toList :: Array v a -> [a]
toList (A ShapeL
sh T v a
t) = ShapeL -> T v a -> [a]
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> T v a -> [a]
toListT ShapeL
sh T v a
t

-- | Convert to a vector with the elements in the linearization order.
-- O(n) or O(1) time (the latter if the vector is already in the linearization order).
{-# INLINE toVector #-}
toVector :: (Vector v, VecElem v a) => Array v a -> v a
toVector :: Array v a -> v a
toVector (A ShapeL
sh T v a
t) = ShapeL -> T v a -> v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> T v a -> v a
toVectorT ShapeL
sh T v a
t

-- | Convert from a list with the elements given in the linearization order.
-- Fails if the given shape does not have the same number of elements as the list.
-- O(n) time.
{-# INLINE fromList #-}
fromList :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> [a] -> Array v a
fromList :: ShapeL -> [a] -> Array v a
fromList ShapeL
ss [a]
vs | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"fromList: size mismatch" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
n, Int
l)
               | Bool
otherwise = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
ss (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ShapeL
st Int
0 (v a -> T v a) -> v a -> T v a
forall a b. (a -> b) -> a -> b
$ [a] -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => [a] -> v a
vFromList [a]
vs
  where Int
n : ShapeL
st = ShapeL -> ShapeL
getStridesT ShapeL
ss
        l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs

-- | Convert from a vector with the elements given in the linearization order.
-- Fails if the given shape does not have the same number of elements as the list.
-- O(1) time.
{-# INLINE fromVector #-}
fromVector :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> v a -> Array v a
fromVector :: ShapeL -> v a -> Array v a
fromVector ShapeL
ss v a
v | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"fromList: size mismatch" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
n, Int
l)
                | Bool
otherwise = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
ss (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ShapeL
st Int
0 v a
v
  where Int
n : ShapeL
st = ShapeL -> ShapeL
getStridesT ShapeL
ss
        l :: Int
l = v a -> Int
forall (v :: * -> *) a. (Vector v, VecElem v a) => v a -> Int
vLength v a
v

-- | Make sure the underlying vector is in the linearization order.
-- This is semantically an identity function, but can have big performance
-- implications.
-- O(n) or O(1) time.
{-# INLINE normalize #-}
normalize :: (Vector v, VecElem v a) => Array v a -> Array v a
normalize :: Array v a -> Array v a
normalize Array v a
a = ShapeL -> v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> v a -> Array v a
fromVector (Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL Array v a
a) (v a -> Array v a) -> v a -> Array v a
forall a b. (a -> b) -> a -> b
$ Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector Array v a
a

-- | Change the shape of an array.  Fails if the arrays have different number of elements.
-- O(n) or O(1) time.
{-# INLINE reshape #-}
reshape :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> Array v a -> Array v a
reshape :: ShapeL -> Array v a -> Array v a
reshape ShapeL
sh (A ShapeL
sh' t :: T v a
t@(T ShapeL
ost Int
oo v a
v))
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n' = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"reshape: size mismatch " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
sh, ShapeL
sh')
  | v a -> Int
forall (v :: * -> *) a. (Vector v, VecElem v a) => v a -> Int
vLength v a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ((Int -> Int) -> ShapeL -> ShapeL
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0) ShapeL
sh) Int
0 v a
v  -- Fast special case for singleton vector
  | Just ShapeL
nst <- ShapeL -> ShapeL -> ShapeL -> Maybe ShapeL
simpleReshape ShapeL
ost ShapeL
sh' ShapeL
sh = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ShapeL
nst Int
oo v a
v
  | Bool
otherwise = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ShapeL
st Int
0 (v a -> T v a) -> v a -> T v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> T v a -> v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> T v a -> v a
toVectorT ShapeL
sh' T v a
t
  where Int
n : ShapeL
st = ShapeL -> ShapeL
getStridesT ShapeL
sh
        n' :: Int
n' = ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ShapeL
sh'

-- | 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.
{-# INLINE stretch #-}
stretch :: (HasCallStack) => ShapeL -> Array v a -> Array v a
stretch :: ShapeL -> Array v a -> Array v a
stretch ShapeL
sh (A ShapeL
sh' T v a
vs) | Just [Bool]
bs <- ShapeL -> ShapeL -> Maybe [Bool]
forall a. (Eq a, Num a) => [a] -> [a] -> Maybe [Bool]
str ShapeL
sh ShapeL
sh' = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ [Bool] -> T v a -> T v a
forall (v :: * -> *) a. [Bool] -> T v a -> T v a
stretchT [Bool]
bs T v a
vs
                      | Bool
otherwise = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"stretch: incompatible " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
sh, ShapeL
sh')
  where str :: [a] -> [a] -> Maybe [Bool]
str [] [] = [Bool] -> Maybe [Bool]
forall a. a -> Maybe a
Just []
        str (a
x:[a]
xs) (a
y:[a]
ys) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> Maybe [Bool] -> Maybe [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe [Bool]
str [a]
xs [a]
ys
                          | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = (Bool
True  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> Maybe [Bool] -> Maybe [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe [Bool]
str [a]
xs [a]
ys
        str [a]
_ [a]
_ = Maybe [Bool]
forall a. Maybe a
Nothing

-- | Change the size of the outermost dimension by replication.
{-# INLINE stretchOuter #-}
stretchOuter :: (HasCallStack) => Int -> Array v a -> Array v a
stretchOuter :: Int -> Array v a -> Array v a
stretchOuter Int
s (A (Int
1:ShapeL
sh) T v a
vs) =
  ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A (Int
sInt -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:ShapeL
sh) (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ [Bool] -> T v a -> T v a
forall (v :: * -> *) a. [Bool] -> T v a -> T v a
stretchT (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Int -> Bool) -> ShapeL -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
False) (T v a -> ShapeL
forall (v :: * -> *) a. T v a -> ShapeL
strides T v a
vs)) T v a
vs
stretchOuter Int
_ Array v a
_ = String -> Array v a
forall a. HasCallStack => String -> a
error String
"stretchOuter: needs outermost dimension of size 1"

-- | Convert a value to a scalar (rank 0) array.
-- O(1) time.
{-# INLINE scalar #-}
scalar :: (Vector v, VecElem v a) => a -> Array v a
scalar :: a -> Array v a
scalar = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A [] (T v a -> Array v a) -> (a -> T v a) -> a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => a -> T v a
scalarT

-- | Convert a scalar (rank 0) array to a value.
-- O(1) time.
{-# INLINE unScalar #-}
unScalar :: (HasCallStack, Vector v, VecElem v a) => Array v a -> a
unScalar :: Array v a -> a
unScalar (A [] T v a
t) = T v a -> a
forall (v :: * -> *) a. (Vector v, VecElem v a) => T v a -> a
unScalarT T v a
t
unScalar Array v a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"unScalar: not a scalar"

-- | Make an array with all elements having the same value.
-- O(1) time
{-# INLINE constant #-}
constant :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> a -> Array v a
constant :: ShapeL -> a -> Array v a
constant ShapeL
sh | ShapeL -> Bool
badShape ShapeL
sh = String -> a -> Array v a
forall a. HasCallStack => String -> a
error String
"constant: bad shape"
            | Bool
otherwise   = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> (a -> T v a) -> a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> a -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> a -> T v a
constantT ShapeL
sh

-- | Map over the array elements.
-- O(n) time.
{-# INLINE mapA #-}
mapA :: (Vector v, VecElem v a, VecElem v b) => (a -> b) -> Array v a -> Array v b
mapA :: (a -> b) -> Array v a -> Array v b
mapA a -> b
f (A ShapeL
s T v a
t) = ShapeL -> T v b -> Array v b
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
s (ShapeL -> (a -> b) -> T v a -> T v b
forall (v :: * -> *) a b.
(Vector v, VecElem v a, VecElem v b) =>
ShapeL -> (a -> b) -> T v a -> T v b
mapT ShapeL
s a -> b
f T v a
t)

-- | Map over the array elements.
-- O(n) time.
{-# INLINE zipWithA #-}
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 :: (a -> b -> c) -> Array v a -> Array v b -> Array v c
zipWithA a -> b -> c
f (A ShapeL
s T v a
t) (A ShapeL
s' T v b
t') | ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s' = ShapeL -> T v c -> Array v c
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
s (ShapeL -> (a -> b -> c) -> T v a -> T v b -> T v c
forall (v :: * -> *) a b c.
(Vector v, VecElem v a, VecElem v b, VecElem v c) =>
ShapeL -> (a -> b -> c) -> T v a -> T v b -> T v c
zipWithT ShapeL
s a -> b -> c
f T v a
t T v b
t')
                             | Bool
otherwise = String -> Array v c
forall a. HasCallStack => String -> a
error (String -> Array v c) -> String -> Array v c
forall a b. (a -> b) -> a -> b
$ String
"zipWithA: shape mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
s, ShapeL
s')

-- | Map over the array elements.
-- O(n) time.
{-# INLINE zipWith3A #-}
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 :: (a -> b -> c -> d)
-> Array v a -> Array v b -> Array v c -> Array v d
zipWith3A a -> b -> c -> d
f (A ShapeL
s T v a
t) (A ShapeL
s' T v b
t') (A ShapeL
s'' T v c
t'') | ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s'' = ShapeL -> T v d -> Array v d
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
s (ShapeL -> (a -> b -> c -> d) -> T v a -> T v b -> T v c -> T v d
forall (v :: * -> *) a b c d.
(Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d) =>
ShapeL -> (a -> b -> c -> d) -> T v a -> T v b -> T v c -> T v d
zipWith3T ShapeL
s a -> b -> c -> d
f T v a
t T v b
t' T v c
t'')
                                          | Bool
otherwise = String -> Array v d
forall a. HasCallStack => String -> a
error (String -> Array v d) -> String -> Array v d
forall a b. (a -> b) -> a -> b
$ String
"zipWith3A: shape mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
s, ShapeL
s', ShapeL
s'')

-- | Map over the array elements.
-- O(n) time.
{-# INLINE zipWith4A #-}
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 :: (a -> b -> c -> d -> e)
-> Array v a -> Array v b -> Array v c -> Array v d -> Array v e
zipWith4A a -> b -> c -> d -> e
f (A ShapeL
s T v a
t) (A ShapeL
s' T v b
t') (A ShapeL
s'' T v c
t'') (A ShapeL
s''' T v d
t''') | ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s'' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s''' = ShapeL -> T v e -> Array v e
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
s (ShapeL
-> (a -> b -> c -> d -> e)
-> T v a
-> T v b
-> T v c
-> T v d
-> T v e
forall (v :: * -> *) a b c d e.
(Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d,
 VecElem v e) =>
ShapeL
-> (a -> b -> c -> d -> e)
-> T v a
-> T v b
-> T v c
-> T v d
-> T v e
zipWith4T ShapeL
s a -> b -> c -> d -> e
f T v a
t T v b
t' T v c
t'' T v d
t''')
                                                        | Bool
otherwise = String -> Array v e
forall a. HasCallStack => String -> a
error (String -> Array v e) -> String -> Array v e
forall a b. (a -> b) -> a -> b
$ String
"zipWith4A: shape mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL, ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
s, ShapeL
s', ShapeL
s'', ShapeL
s''')

-- | Map over the array elements.
-- O(n) time.
{-# INLINE zipWith5A #-}
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 :: (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 a -> b -> c -> d -> e -> f
f (A ShapeL
s T v a
t) (A ShapeL
s' T v b
t') (A ShapeL
s'' T v c
t'') (A ShapeL
s''' T v d
t''') (A ShapeL
s'''' T v e
t'''') | ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s'' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s''' Bool -> Bool -> Bool
&& ShapeL
s ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
s'''' = ShapeL -> T v f -> Array v f
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
s (ShapeL
-> (a -> b -> c -> d -> e -> f)
-> T v a
-> T v b
-> T v c
-> T v d
-> T v e
-> T v f
forall (v :: * -> *) a b c d e f.
(Vector v, VecElem v a, VecElem v b, VecElem v c, VecElem v d,
 VecElem v e, VecElem v f) =>
ShapeL
-> (a -> b -> c -> d -> e -> f)
-> T v a
-> T v b
-> T v c
-> T v d
-> T v e
-> T v f
zipWith5T ShapeL
s a -> b -> c -> d -> e -> f
f T v a
t T v b
t' T v c
t'' T v d
t''' T v e
t'''')
                                                                        | Bool
otherwise = String -> Array v f
forall a. HasCallStack => String -> a
error (String -> Array v f) -> String -> Array v f
forall a b. (a -> b) -> a -> b
$ String
"zipWith5A: shape mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL, ShapeL, ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
s, ShapeL
s', ShapeL
s'', ShapeL
s''', ShapeL
s'''')

-- | Pad each dimension on the low and high side with the given value.
-- O(n) time.
{-# INLINE pad #-}
pad :: forall a v . (Vector v, VecElem v a) =>
       [(Int, Int)] -> a -> Array v a -> Array v a
pad :: [(Int, Int)] -> a -> Array v a -> Array v a
pad [(Int, Int)]
aps a
v (A ShapeL
ash T v a
at) = (ShapeL -> T v a -> Array v a) -> (ShapeL, T v a) -> Array v a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ((ShapeL, T v a) -> Array v a) -> (ShapeL, T v a) -> Array v a
forall a b. (a -> b) -> a -> b
$ a -> [(Int, Int)] -> ShapeL -> T v a -> (ShapeL, T v a)
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
a -> [(Int, Int)] -> ShapeL -> T v a -> (ShapeL, T v a)
padT a
v [(Int, Int)]
aps ShapeL
ash T v a
at

-- | Do an arbitrary array transposition.
-- Fails if the transposition argument is not a permutation of the numbers
-- [0..r-1], where r is the rank of the array.
-- O(1) time.
{-# INLINE transpose #-}
transpose :: (HasCallStack) => [Int] -> Array v a -> Array v a
transpose :: ShapeL -> Array v a -> Array v a
transpose ShapeL
is (A ShapeL
sh T v a
t) | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"transpose: rank exceeded " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
is, ShapeL
sh)
                      | ShapeL -> ShapeL
forall a. Ord a => [a] -> [a]
sort ShapeL
is ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int
0 .. Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] =
                          String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"transpose: not a permutation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShapeL -> String
forall a. Show a => a -> String
show ShapeL
is
                      | Bool
otherwise = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A (ShapeL -> ShapeL -> ShapeL
forall a. ShapeL -> [a] -> [a]
permute ShapeL
is' ShapeL
sh) (ShapeL -> T v a -> T v a
forall (v :: * -> *) a. ShapeL -> T v a -> T v a
transposeT ShapeL
is' T v a
t)
  where l :: Int
l = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
is
        n :: Int
n = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sh
        is' :: ShapeL
is' = ShapeL
is ShapeL -> ShapeL -> ShapeL
forall a. [a] -> [a] -> [a]
++ [Int
l .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

-- | Append two arrays along the outermost dimension.
-- All dimensions, except the outermost, must be the same.
-- O(n) time.
{-# INLINE append #-}
append :: (HasCallStack, Vector v, VecElem v a) => Array v a -> Array v a -> Array v a
append :: Array v a -> Array v a -> Array v a
append a :: Array v a
a@(A (Int
sa:ShapeL
sh) T v a
_) b :: Array v a
b@(A (Int
sb:ShapeL
sh') T v a
_) | ShapeL
sh ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeL
sh' =
  ShapeL -> v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> v a -> Array v a
fromVector (Int
saInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sb Int -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
: ShapeL
sh) (v a -> v a -> v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
v a -> v a -> v a
vAppend (Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector Array v a
a) (Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector Array v a
b))
append Array v a
_ Array v a
_ = String -> Array v a
forall a. HasCallStack => String -> a
error String
"append: bad shape"

-- | Concatenate a number of arrays into a single array.
-- Fails if any, but the outer, dimensions differ.
-- O(n) time.
{-# INLINE concatOuter #-}
concatOuter :: (HasCallStack, Vector v, VecElem v a) => [Array v a] -> Array v a
concatOuter :: [Array v a] -> Array v a
concatOuter [] = String -> Array v a
forall a. HasCallStack => String -> a
error String
"concatOuter: empty list"
concatOuter [Array v a]
as | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ShapeL] -> Bool
forall a. Eq a => [a] -> Bool
allSame ([ShapeL] -> Bool) -> [ShapeL] -> Bool
forall a b. (a -> b) -> a -> b
$ (ShapeL -> ShapeL) -> [ShapeL] -> [ShapeL]
forall a b. (a -> b) -> [a] -> [b]
map ShapeL -> ShapeL
forall a. [a] -> [a]
tail [ShapeL]
shs =
                 String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"concatOuter: non-conforming inner dimensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShapeL] -> String
forall a. Show a => a -> String
show [ShapeL]
shs
               | Bool
otherwise = ShapeL -> v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> v a -> Array v a
fromVector ShapeL
sh' (v a -> Array v a) -> v a -> Array v a
forall a b. (a -> b) -> a -> b
$ [v a] -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => [v a] -> v a
vConcat ([v a] -> v a) -> [v a] -> v a
forall a b. (a -> b) -> a -> b
$ (Array v a -> v a) -> [Array v a] -> [v a]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector [Array v a]
as
  where shs :: [ShapeL]
shs@(ShapeL
sh:[ShapeL]
_) = (Array v a -> ShapeL) -> [Array v a] -> [ShapeL]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL [Array v a]
as
        sh' :: ShapeL
sh' = ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ShapeL -> Int) -> [ShapeL] -> ShapeL
forall a b. (a -> b) -> [a] -> [b]
map ShapeL -> Int
forall a. [a] -> a
head [ShapeL]
shs) Int -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
: ShapeL -> ShapeL
forall a. [a] -> [a]
tail ShapeL
sh

-- | Turn a rank-1 array of arrays into a single array by making the outer array into the outermost
-- dimension of the result array.  All the arrays must have the same shape.
-- O(n) time.
{-# INLINE ravel #-}
ravel :: (HasCallStack, Vector v, Vector v', VecElem v a, VecElem v' (Array v a)) =>
         Array v' (Array v a) -> Array v a
ravel :: Array v' (Array v a) -> Array v a
ravel Array v' (Array v a)
aa | Array v' (Array v a) -> Int
forall (v :: * -> *) a. Array v a -> Int
rank Array v' (Array v a)
aa Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 = String -> Array v a
forall a. HasCallStack => String -> a
error String
"ravel: outermost array does not have rank 1"
         | Bool
otherwise =
  case Array v' (Array v a) -> [Array v a]
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> [a]
toList Array v' (Array v a)
aa of
    [] -> String -> Array v a
forall a. HasCallStack => String -> a
error String
"ravel: empty array"
    [Array v a]
as | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ShapeL] -> Bool
forall a. Eq a => [a] -> Bool
allSame [ShapeL]
shs -> String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"ravel: non-conforming inner dimensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShapeL] -> String
forall a. Show a => a -> String
show [ShapeL]
shs
       | Bool
otherwise -> ShapeL -> v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> v a -> Array v a
fromVector ShapeL
sh' (v a -> Array v a) -> v a -> Array v a
forall a b. (a -> b) -> a -> b
$ [v a] -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => [v a] -> v a
vConcat ([v a] -> v a) -> [v a] -> v a
forall a b. (a -> b) -> a -> b
$ (Array v a -> v a) -> [Array v a] -> [v a]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector [Array v a]
as
      where shs :: [ShapeL]
shs@(ShapeL
sh:[ShapeL]
_) = (Array v a -> ShapeL) -> [Array v a] -> [ShapeL]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL [Array v a]
as
            sh' :: ShapeL
sh' = [Array v a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Array v a]
as Int -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
: ShapeL
sh

-- | Turn an array into a nested array, this is the inverse of 'ravel'.
-- I.e., @ravel . unravel == id@.
{-# INLINE unravel #-}
unravel :: (Vector v, Vector v', VecElem v a, VecElem v' (Array v a)) =>
           Array v a -> Array v' (Array v a)
unravel :: Array v a -> Array v' (Array v a)
unravel = Int
-> (Array v a -> Array v' (Array v a))
-> Array v a
-> Array v' (Array v a)
forall (v :: * -> *) (v' :: * -> *) a b.
(HasCallStack, Vector v, Vector v', VecElem v a, VecElem v' b) =>
Int -> (Array v a -> Array v' b) -> Array v a -> Array v' b
rerank Int
1 Array v a -> Array v' (Array v a)
forall (v :: * -> *) a. (Vector v, VecElem v a) => a -> Array v a
scalar

-- | Make a window of the outermost dimensions.
-- The rank increases with the length of the window list.
-- E.g., if the shape of the array is @[10,12,8]@ and
-- the window size is @[3,3]@ then the resulting array will have shape
-- @[8,10,3,3,8]@.
--
-- E.g., @window [2] (fromList [4] [1,2,3,4]) == fromList [3,2] [1,2, 2,3, 3,4]@
-- O(1) time.
--
-- If the window parameter @ws = [w1,...,wk]@ and @wa = window ws a@ then
-- @wa `index` i1 ... `index` ik == slice [(i1,w1),...,(ik,wk)] a@.
{-# INLINE window #-}
window :: (HasCallStack, Vector v) => [Int] -> Array v a -> Array v a
window :: ShapeL -> Array v a -> Array v a
window ShapeL
aws (A ShapeL
ash (T ShapeL
ss Int
o v a
v)) = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A (ShapeL -> ShapeL -> ShapeL
win ShapeL
aws ShapeL
ash) (ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T (ShapeL
ss' ShapeL -> ShapeL -> ShapeL
forall a. [a] -> [a] -> [a]
++ ShapeL
ss) Int
o v a
v)
  where ss' :: ShapeL
ss' = (Int -> Int -> Int) -> ShapeL -> ShapeL -> ShapeL
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a b. a -> b -> a
const ShapeL
ss ShapeL
aws
        win :: ShapeL -> ShapeL -> ShapeL
win (Int
w:ShapeL
ws) (Int
s:ShapeL
sh) | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
: ShapeL -> ShapeL -> ShapeL
win ShapeL
ws ShapeL
sh
                          | Bool
otherwise = String -> ShapeL
forall a. HasCallStack => String -> a
error (String -> ShapeL) -> String -> ShapeL
forall a b. (a -> b) -> a -> b
$ String
"window: bad window size : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
w, Int
s)
        win [] ShapeL
sh = ShapeL
aws ShapeL -> ShapeL -> ShapeL
forall a. [a] -> [a] -> [a]
++ ShapeL
sh
        win ShapeL
_ ShapeL
_ = String -> ShapeL
forall a. HasCallStack => String -> a
error (String -> ShapeL) -> String -> ShapeL
forall a b. (a -> b) -> a -> b
$ String
"window: rank mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
aws, ShapeL
ash)

-- | Stride the outermost dimensions.
-- 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]@.
-- The rank of the stride list must not exceed the rank of the array.
-- O(1) time.
{-# INLINE stride #-}
stride :: (HasCallStack, Vector v) => [Int] -> Array v a -> Array v a
stride :: ShapeL -> Array v a -> Array v a
stride ShapeL
ats (A ShapeL
ash (T ShapeL
ss Int
o v a
v)) = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A (ShapeL -> ShapeL -> ShapeL
forall a. Integral a => [a] -> [a] -> [a]
str ShapeL
ats ShapeL
ash) (ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ((Int -> Int -> Int) -> ShapeL -> ShapeL -> ShapeL
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (ShapeL
ats ShapeL -> ShapeL -> ShapeL
forall a. [a] -> [a] -> [a]
++ Int -> ShapeL
forall a. a -> [a]
repeat Int
1) ShapeL
ss) Int
o v a
v)
  where str :: [a] -> [a] -> [a]
str (a
t:[a]
ts) (a
s:[a]
sh) = (a
sa -> a -> a
forall a. Num a => a -> a -> a
+a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
str [a]
ts [a]
sh
        str [] [a]
sh = [a]
sh
        str [a]
_ [a]
_ = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"stride: rank mismatch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShapeL, ShapeL) -> String
forall a. Show a => a -> String
show (ShapeL
ats, ShapeL
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]@.
{-# INLINE rotate #-}
rotate :: (HasCallStack, Vector v, VecElem v a) => Int -> Int -> Array v a -> Array v a
rotate :: Int -> Int -> Array v a -> Array v a
rotate Int
d Int
k Array v a
a | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array v a -> Int
forall (v :: * -> *) a. Array v a -> Int
rank Array v a
a, Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> (Array v a -> Array v a) -> Array v a -> Array v a
forall (v :: * -> *) (v' :: * -> *) a b.
(HasCallStack, Vector v, Vector v', VecElem v a, VecElem v' b) =>
Int -> (Array v a -> Array v' b) -> Array v a -> Array v' b
rerank Int
d Array v a -> Array v a
forall (v :: * -> *) a.
(VecElem v a, Vector v) =>
Array v a -> Array v a
f Array v a
a
 where
  f :: Array v a -> Array v a
f Array v a
arr = let Int
h:ShapeL
t = Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL Array v a
arr
              m :: Int
m = ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ShapeL
t
              n :: Int
n = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m
          in ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
HasCallStack =>
ShapeL -> Array v a -> Array v a
rev [Int
0]
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> Array v a -> Array v a
reshape (Int
kInt -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:Int
hInt -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:ShapeL
t)
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v) =>
ShapeL -> Array v a -> Array v a
stride [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m]
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v) =>
ShapeL -> Array v a -> Array v a
window [Int
n]
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> Array v a -> Array v a
reshape [(Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n]
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Array v a -> Array v a
forall (v :: * -> *) a.
HasCallStack =>
Int -> Array v a -> Array v a
stretchOuter (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
             (Array v a -> Array v a)
-> (Array v a -> Array v a) -> Array v a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> Array v a -> Array v a
reshape (Int
1Int -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:Int
hInt -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:ShapeL
t) (Array v a -> Array v a) -> Array v a -> Array v a
forall a b. (a -> b) -> a -> b
$ Array v a
arr
rotate Int
d Int
k Array v a
a = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"Incorrect arguments to rotate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
d, Int
k, Array v a -> Int
forall (v :: * -> *) a. Array v a -> Int
rank Array v a
a)

-- | Extract a slice of an array.
-- The first argument is a list of (offset, length) pairs.
-- The length of the slicing argument must not exceed the rank of the arrar.
-- The extracted slice mul fall within the array dimensions.
-- E.g. @slice [1,2] (fromList [4] [1,2,3,4]) == [2,3]@.
-- O(1) time.
{-# INLINE slice #-}
slice :: (HasCallStack) => [(Int, Int)] -> Array v a -> Array v a
slice :: [(Int, Int)] -> Array v a -> Array v a
slice [(Int, Int)]
asl (A ShapeL
ash (T ShapeL
ats Int
ao v a
v)) = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
rsh (ShapeL -> Int -> v a -> T v a
forall (v :: * -> *) a. ShapeL -> Int -> v a -> T v a
T ShapeL
ats Int
o v a
v)
  where (Int
o, ShapeL
rsh) = [(Int, Int)] -> ShapeL -> ShapeL -> (Int, ShapeL)
slc [(Int, Int)]
asl ShapeL
ash ShapeL
ats
        slc :: [(Int, Int)] -> ShapeL -> ShapeL -> (Int, ShapeL)
slc ((Int
k,Int
n):[(Int, Int)]
sl) (Int
s:ShapeL
sh) (Int
t:ShapeL
ts) | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
s Bool -> Bool -> Bool
|| Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
s = String -> (Int, ShapeL)
forall a. HasCallStack => String -> a
error (String -> (Int, ShapeL)) -> String -> (Int, ShapeL)
forall a b. (a -> b) -> a -> b
$ String
"slice: out of bounds: slice=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
k, Int
n) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" size=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s
                                     | Bool
otherwise = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
t, Int
nInt -> ShapeL -> ShapeL
forall a. a -> [a] -> [a]
:ShapeL
ns) where (Int
i, ShapeL
ns) = [(Int, Int)] -> ShapeL -> ShapeL -> (Int, ShapeL)
slc [(Int, Int)]
sl ShapeL
sh ShapeL
ts
        slc ((Int, Int)
_:[(Int, Int)]
_) [] ShapeL
_ = String -> (Int, ShapeL)
forall a. HasCallStack => String -> a
error String
"slice: slice list too long"
        slc [] ShapeL
sh ShapeL
_ = (Int
ao, ShapeL
sh)
        slc [(Int, Int)]
_ ShapeL
_ ShapeL
_ = String -> (Int, ShapeL)
forall a. HasCallStack => String -> a
error String
"impossible"

-- | Apply a function to the subarrays /n/ levels down and make
-- the results into an array with the same /n/ outermost dimensions.
-- The /n/ must not exceed the rank of the array.
-- O(n) time.
{-# INLINE rerank #-}
rerank :: (HasCallStack, Vector v, Vector v', VecElem v a, VecElem v' b) =>
          Int -> (Array v a -> Array v' b) -> Array v a -> Array v' b
rerank :: Int -> (Array v a -> Array v' b) -> Array v a -> Array v' b
rerank Int
n Array v a -> Array v' b
f (A ShapeL
sh T v a
t) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sh = String -> Array v' b
forall a. HasCallStack => String -> a
error String
"rerank: rank exceeded"
                    | Bool
otherwise =
  ShapeL -> [Array v' b] -> Array v' b
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> [Array v a] -> Array v a
ravelOuter ShapeL
osh ([Array v' b] -> Array v' b) -> [Array v' b] -> Array v' b
forall a b. (a -> b) -> a -> b
$
  (T v a -> Array v' b) -> [T v a] -> [Array v' b]
forall a b. (a -> b) -> [a] -> [b]
map (Array v a -> Array v' b
f (Array v a -> Array v' b)
-> (T v a -> Array v a) -> T v a -> Array v' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
ish) ([T v a] -> [Array v' b]) -> [T v a] -> [Array v' b]
forall a b. (a -> b) -> a -> b
$
  ShapeL -> T v a -> [T v a]
forall (v :: * -> *) a. ShapeL -> T v a -> [T v a]
subArraysT ShapeL
osh T v a
t
  where (ShapeL
osh, ShapeL
ish) = Int -> ShapeL -> (ShapeL, ShapeL)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ShapeL
sh

ravelOuter :: (HasCallStack, Vector v, VecElem v a) => ShapeL -> [Array v a] -> Array v a
ravelOuter :: ShapeL -> [Array v a] -> Array v a
ravelOuter ShapeL
_ [] = String -> Array v a
forall a. HasCallStack => String -> a
error String
"ravelOuter: empty list"
ravelOuter ShapeL
osh [Array v a]
as | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ShapeL] -> Bool
forall a. Eq a => [a] -> Bool
allSame [ShapeL]
shs = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"ravelOuter: non-conforming inner dimensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShapeL] -> String
forall a. Show a => a -> String
show [ShapeL]
shs
                  | Bool
otherwise = ShapeL -> v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> v a -> Array v a
fromVector ShapeL
sh' (v a -> Array v a) -> v a -> Array v a
forall a b. (a -> b) -> a -> b
$ [v a] -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => [v a] -> v a
vConcat ([v a] -> v a) -> [v a] -> v a
forall a b. (a -> b) -> a -> b
$ (Array v a -> v a) -> [Array v a] -> [v a]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> v a
forall (v :: * -> *) a. (Vector v, VecElem v a) => Array v a -> v a
toVector [Array v a]
as
  where shs :: [ShapeL]
shs@(ShapeL
sh:[ShapeL]
_) = (Array v a -> ShapeL) -> [Array v a] -> [ShapeL]
forall a b. (a -> b) -> [a] -> [b]
map Array v a -> ShapeL
forall (v :: * -> *) a. Array v a -> ShapeL
shapeL [Array v a]
as
        sh' :: ShapeL
sh' = ShapeL
osh ShapeL -> ShapeL -> ShapeL
forall a. [a] -> [a] -> [a]
++ ShapeL
sh

-- | Apply a two-argument function to the subarrays /n/ levels down and make
-- the results into an array with the same /n/ outermost dimensions.
-- The /n/ must not exceed the rank of the array.
-- O(n) time.
{-# INLINE rerank2 #-}
rerank2 :: (HasCallStack, Vector v, VecElem v a, VecElem v b, VecElem v c) =>
           Int -> (Array v a -> Array v b -> Array v c) -> Array v a -> Array v b -> Array v c
rerank2 :: Int
-> (Array v a -> Array v b -> Array v c)
-> Array v a
-> Array v b
-> Array v c
rerank2 Int
n Array v a -> Array v b -> Array v c
f (A ShapeL
sha T v a
ta) (A ShapeL
shb T v b
tb) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sha Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
shb = String -> Array v c
forall a. HasCallStack => String -> a
error String
"rerank: rank exceeded"
                                  | Int -> ShapeL -> ShapeL
forall a. Int -> [a] -> [a]
take Int
n ShapeL
sha ShapeL -> ShapeL -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> ShapeL -> ShapeL
forall a. Int -> [a] -> [a]
take Int
n ShapeL
shb = String -> Array v c
forall a. HasCallStack => String -> a
error String
"rerank2: shape mismatch"
                                  | Bool
otherwise =
  ShapeL -> [Array v c] -> Array v c
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> [Array v a] -> Array v a
ravelOuter ShapeL
osh ([Array v c] -> Array v c) -> [Array v c] -> Array v c
forall a b. (a -> b) -> a -> b
$
  (T v a -> T v b -> Array v c) -> [T v a] -> [T v b] -> [Array v c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ T v a
a T v b
b -> Array v a -> Array v b -> Array v c
f (ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
isha T v a
a) (ShapeL -> T v b -> Array v b
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
ishb T v b
b))
          (ShapeL -> T v a -> [T v a]
forall (v :: * -> *) a. ShapeL -> T v a -> [T v a]
subArraysT ShapeL
osh T v a
ta)
          (ShapeL -> T v b -> [T v b]
forall (v :: * -> *) a. ShapeL -> T v a -> [T v a]
subArraysT ShapeL
osh T v b
tb)
  where (ShapeL
osh, ShapeL
isha) = Int -> ShapeL -> (ShapeL, ShapeL)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ShapeL
sha
        ishb :: ShapeL
ishb = Int -> ShapeL -> ShapeL
forall a. Int -> [a] -> [a]
drop Int
n ShapeL
shb

-- | Reverse the given dimensions, with the outermost being dimension 0.
-- O(1) time.
{-# INLINE rev #-}
rev :: (HasCallStack) => [Int] -> Array v a -> Array v a
rev :: ShapeL -> Array v a -> Array v a
rev ShapeL
rs (A ShapeL
sh T v a
t) | (Int -> Bool) -> ShapeL -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ Int
r -> Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) ShapeL
rs = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (ShapeL -> ShapeL -> T v a -> T v a
forall (v :: * -> *) a. ShapeL -> ShapeL -> T v a -> T v a
reverseT ShapeL
rs ShapeL
sh T v a
t)
                | Bool
otherwise = String -> Array v a
forall a. HasCallStack => String -> a
error String
"reverse: bad reverse dimension"
  where n :: Int
n = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sh

-- | Reduce all elements of an array into a rank 0 array.
-- To reduce parts use 'rerank' and 'transpose' together with 'reduce'.
-- O(n) time.
{-# INLINE reduce #-}
reduce :: (Vector v, VecElem v a) =>
          (a -> a -> a) -> a -> Array v a -> Array v a
reduce :: (a -> a -> a) -> a -> Array v a -> Array v a
reduce a -> a -> a
f a
z (A ShapeL
sh T v a
t) = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A [] (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> (a -> a -> a) -> a -> T v a -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> (a -> a -> a) -> a -> T v a -> T v a
reduceT ShapeL
sh a -> a -> a
f a
z T v a
t

-- | Right fold across all elements of an array.
{-# INLINE foldrA #-}
foldrA :: (Vector v, VecElem v a) => (a -> b -> b) -> b -> Array v a -> b
foldrA :: (a -> b -> b) -> b -> Array v a -> b
foldrA a -> b -> b
f b
z (A ShapeL
sh T v a
t) = ShapeL -> (a -> b -> b) -> b -> T v a -> b
forall (v :: * -> *) a b.
(Vector v, VecElem v a) =>
ShapeL -> (a -> b -> b) -> b -> T v a -> b
foldrT ShapeL
sh a -> b -> b
f b
z T v a
t

-- | Constrained version of 'traverse' for 'Array's.
{-# INLINE traverseA #-}
traverseA
  :: (Vector v, VecElem v a, VecElem v b, Applicative f)
  => (a -> f b) -> Array v a -> f (Array v b)
traverseA :: (a -> f b) -> Array v a -> f (Array v b)
traverseA a -> f b
f (A ShapeL
sh T v a
t) = ShapeL -> T v b -> Array v b
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v b -> Array v b) -> f (T v b) -> f (Array v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShapeL -> (a -> f b) -> T v a -> f (T v b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v, VecElem v a, VecElem v b, Applicative f) =>
ShapeL -> (a -> f b) -> T v a -> f (T v b)
traverseT ShapeL
sh a -> f b
f T v a
t

-- | Check if all elements of the array are equal.
allSameA :: (Vector v, VecElem v a, Eq a) => Array v a -> Bool
allSameA :: Array v a -> Bool
allSameA (A ShapeL
sh T v a
t) = ShapeL -> T v a -> Bool
forall (v :: * -> *) a.
(Vector v, VecElem v a, Eq a) =>
ShapeL -> T v a -> Bool
allSameT ShapeL
sh T v a
t

instance (Vector v, VecElem v a, Arbitrary a) => Arbitrary (Array v a) where
  arbitrary :: Gen (Array v a)
arbitrary = do
    Int
r <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
5)  -- Don't generate huge ranks
    -- Don't generate huge number of elements
    ShapeL
ss <- Int -> Gen Int -> Gen ShapeL
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
r (Small Int -> Int
forall a. Small a -> a
getSmall (Small Int -> Int)
-> (Positive (Small Int) -> Small Int)
-> Positive (Small Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive (Small Int) -> Small Int
forall a. Positive a -> a
getPositive (Positive (Small Int) -> Int)
-> Gen (Positive (Small Int)) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small Int))
forall a. Arbitrary a => Gen a
arbitrary) Gen ShapeL -> (ShapeL -> Bool) -> Gen ShapeL
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10000) (Int -> Bool) -> (ShapeL -> Int) -> ShapeL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product)
    ShapeL -> [a] -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> [a] -> Array v a
fromList ShapeL
ss ([a] -> Array v a) -> Gen [a] -> Gen (Array v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [a]
forall a. Arbitrary a => Int -> Gen [a]
vector (ShapeL -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ShapeL
ss)

-- | Sum of all elements.
{-# INLINE sumA #-}
sumA :: (Vector v, VecElem v a, Num a) => Array v a -> a
sumA :: Array v a -> a
sumA (A ShapeL
sh T v a
t) = ShapeL -> T v a -> a
forall (v :: * -> *) a.
(Vector v, VecElem v a, Num a) =>
ShapeL -> T v a -> a
sumT ShapeL
sh T v a
t

-- | Product of all elements.
{-# INLINE productA #-}
productA :: (Vector v, VecElem v a, Num a) => Array v a -> a
productA :: Array v a -> a
productA (A ShapeL
sh T v a
t) = ShapeL -> T v a -> a
forall (v :: * -> *) a.
(Vector v, VecElem v a, Num a) =>
ShapeL -> T v a -> a
productT ShapeL
sh T v a
t

-- | Maximum of all elements.
{-# INLINE maximumA #-}
maximumA :: (HasCallStack, Vector v, VecElem v a, Ord a) => Array v a -> a
maximumA :: Array v a -> a
maximumA a :: Array v a
a@(A ShapeL
sh T v a
t) | Array v a -> Int
forall (v :: * -> *) a. Array v a -> Int
size Array v a
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = ShapeL -> T v a -> a
forall (v :: * -> *) a.
(Vector v, VecElem v a, Ord a) =>
ShapeL -> T v a -> a
maximumT ShapeL
sh T v a
t
                    | Bool
otherwise  = String -> a
forall a. HasCallStack => String -> a
error String
"maximumA called with empty array"

-- | Minimum of all elements.
{-# INLINE minimumA #-}
minimumA :: (HasCallStack, Vector v, VecElem v a, Ord a) => Array v a -> a
minimumA :: Array v a -> a
minimumA a :: Array v a
a@(A ShapeL
sh T v a
t) | Array v a -> Int
forall (v :: * -> *) a. Array v a -> Int
size Array v a
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = ShapeL -> T v a -> a
forall (v :: * -> *) a.
(Vector v, VecElem v a, Ord a) =>
ShapeL -> T v a -> a
minimumT ShapeL
sh T v a
t
                    | Bool
otherwise  = String -> a
forall a. HasCallStack => String -> a
error String
"minimumA called with empty array"

-- | Test if the predicate holds for any element.
{-# INLINE anyA #-}
anyA :: (Vector v, VecElem v a) => (a -> Bool) -> Array v a -> Bool
anyA :: (a -> Bool) -> Array v a -> Bool
anyA a -> Bool
p (A ShapeL
sh T v a
t) = ShapeL -> (a -> Bool) -> T v a -> Bool
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> (a -> Bool) -> T v a -> Bool
anyT ShapeL
sh a -> Bool
p T v a
t

-- | Test if the predicate holds for all elements.
{-# INLINE allA #-}
allA :: (Vector v, VecElem v a) => (a -> Bool) -> Array v a -> Bool
allA :: (a -> Bool) -> Array v a -> Bool
allA a -> Bool
p (A ShapeL
sh T v a
t) = ShapeL -> (a -> Bool) -> T v a -> Bool
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> (a -> Bool) -> T v a -> Bool
anyT ShapeL
sh a -> Bool
p T v a
t

-- | Put the dimensions of the argument into the specified dimensions,
-- 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.
broadcast :: (HasCallStack, Vector v, VecElem v a) =>
             [Int] -> ShapeL -> Array v a -> Array v a
broadcast :: ShapeL -> ShapeL -> Array v a -> Array v a
broadcast ShapeL
ds ShapeL
sh Array v a
a | ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
ds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Array v a -> Int
forall (v :: * -> *) a. Array v a -> Int
rank Array v a
a = String -> Array v a
forall a. HasCallStack => String -> a
error String
"broadcast: wrong number of broadcasts"
                  | (Int -> Bool) -> ShapeL -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ Int
d -> Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r) ShapeL
ds = String -> Array v a
forall a. HasCallStack => String -> a
error String
"broadcast: bad dimension index"
                  | Bool -> Bool
not (ShapeL -> Bool
forall a. Ord a => [a] -> Bool
ascending ShapeL
ds) = String -> Array v a
forall a. HasCallStack => String -> a
error String
"broadcast: unordered dimensions"
                  | Bool
otherwise = ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
HasCallStack =>
ShapeL -> Array v a -> Array v a
stretch ShapeL
sh (Array v a -> Array v a) -> Array v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> Array v a -> Array v a
forall (v :: * -> *) a.
(HasCallStack, Vector v, VecElem v a) =>
ShapeL -> Array v a -> Array v a
reshape ShapeL
rsh Array v a
a
  where r :: Int
r = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sh
        rsh :: ShapeL
rsh = [ if Int
i Int -> ShapeL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ShapeL
ds then Int
s else Int
1 | (Int
i, Int
s) <- ShapeL -> ShapeL -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ShapeL
sh ]
        ascending :: [a] -> Bool
ascending (a
x:a
y:[a]
ys) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y Bool -> Bool -> Bool
&& [a] -> Bool
ascending (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
        ascending [a]
_ = Bool
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 :: Array v a -> [(ShapeL, a)] -> Array v a
update (A ShapeL
sh T v a
t) [(ShapeL, a)]
us | ((ShapeL, a) -> Bool) -> [(ShapeL, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ShapeL -> Bool
ok (ShapeL -> Bool) -> ((ShapeL, a) -> ShapeL) -> (ShapeL, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShapeL, a) -> ShapeL
forall a b. (a, b) -> a
fst) [(ShapeL, a)]
us = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ ShapeL -> T v a -> [(ShapeL, a)] -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> T v a -> [(ShapeL, a)] -> T v a
updateT ShapeL
sh T v a
t [(ShapeL, a)]
us
                   | Bool
otherwise = String -> Array v a
forall a. HasCallStack => String -> a
error (String -> Array v a) -> String -> Array v a
forall a b. (a -> b) -> a -> b
$ String
"update: index out of bounds " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShapeL] -> String
forall a. Show a => a -> String
show ((ShapeL -> Bool) -> [ShapeL] -> [ShapeL]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ShapeL -> Bool) -> ShapeL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> Bool
ok) ([ShapeL] -> [ShapeL]) -> [ShapeL] -> [ShapeL]
forall a b. (a -> b) -> a -> b
$ ((ShapeL, a) -> ShapeL) -> [(ShapeL, a)] -> [ShapeL]
forall a b. (a -> b) -> [a] -> [b]
map (ShapeL, a) -> ShapeL
forall a b. (a, b) -> a
fst [(ShapeL, a)]
us)
  where ok :: ShapeL -> Bool
ok ShapeL
is = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
is Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> ShapeL -> ShapeL -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
i Int
s -> Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s) ShapeL
is ShapeL
sh)
        r :: Int
r = ShapeL -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShapeL
sh

-- | Generate an array with a function that computes the value for each index.
{-# INLINE generate #-}
generate :: (Vector v, VecElem v a) =>
            ShapeL -> ([Int] -> a) -> Array v a
generate :: ShapeL -> (ShapeL -> a) -> Array v a
generate ShapeL
sh = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A ShapeL
sh (T v a -> Array v a)
-> ((ShapeL -> a) -> T v a) -> (ShapeL -> a) -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeL -> (ShapeL -> a) -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
ShapeL -> (ShapeL -> a) -> T v a
generateT ShapeL
sh

-- | Iterate a function n times.
{-# INLINE iterateN #-}
iterateN :: forall v a .
            (Vector v, VecElem v a) =>
            Int -> (a -> a) -> a -> Array v a
iterateN :: Int -> (a -> a) -> a -> Array v a
iterateN Int
n a -> a
f = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A [Int
n] (T v a -> Array v a) -> (a -> T v a) -> a -> Array v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (a -> a) -> a -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a) =>
Int -> (a -> a) -> a -> T v a
iterateNT Int
n a -> a
f

-- | Generate a vector from 0 to n-1.
{-# INLINE iota #-}
iota :: forall v a .
        (Vector v, VecElem v a, Enum a, Num a) =>
        Int -> Array v a
iota :: Int -> Array v a
iota Int
n = ShapeL -> T v a -> Array v a
forall (v :: * -> *) a. ShapeL -> T v a -> Array v a
A [Int
n] (T v a -> Array v a) -> T v a -> Array v a
forall a b. (a -> b) -> a -> b
$ Int -> T v a
forall (v :: * -> *) a.
(Vector v, VecElem v a, Enum a, Num a) =>
Int -> T v a
iotaT Int
n