module Data.Array.Comfort.Storable (
   Array,
   shape,
   reshape,
   mapShape,

   accessMaybe, (!),
   Array.toList,
   Array.vectorFromList,
   toAssociations,
   fromList,
   fromMap, toMap,
   fromIntMap, toIntMap,
   fromTuple, toTuple,
   fromRecord, toRecord,
   fromContainer,
   toContainer,
   sample,
   replicate,
   fromBoxed,
   toBoxed,
   fromStorableVector,
   toStorableVector,
   fromBlockArray1,
   fromBlockArray2,
   fromNonEmptyBlockArray2,

   Array.map,
   Array.mapWithIndex,
   zipWith,
   (//),
   accumulate,
   fromAssociations,

   pick,
   toRowArray,
   fromRowArray,
   Array.singleton,
   Array.append,
   Array.take, Array.drop,
   Array.takeLeft, Array.takeRight, Array.split,
   Array.takeCenter,

   Array.sum, Array.product,
   minimum, argMinimum,
   maximum, argMaximum,
   limits,
   Array.foldl,
   foldl1,
   foldMap,
   ) where

import qualified Data.Array.Comfort.Storable.Mutable.Unchecked as MutArrayNC
import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArrayPriv
import qualified Data.Array.Comfort.Storable.Mutable as MutArray
import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Storable.Memory as Memory
import qualified Data.Array.Comfort.Container as Container
import qualified Data.Array.Comfort.Boxed as BoxedArray
import qualified Data.Array.Comfort.Check as Check
import qualified Data.Array.Comfort.Shape.Tuple as TupleShape
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable.Unchecked (Array(Array))
import Data.Array.Comfort.Shape ((::+)((::+)))

import System.IO.Unsafe (unsafePerformIO)
import Foreign.Marshal.Array (copyArray, advancePtr)
import Foreign.Storable (Storable)
import Foreign.ForeignPtr (withForeignPtr)

import qualified Control.Monad.Trans.State as MS
import Control.Monad.ST (runST)

import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import qualified Data.Tuple.Strict as StrictTuple
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.Set (Set)
import Data.Foldable (forM_)
import Data.Either.HT (maybeRight)
import Data.Tuple.HT (mapPair)
import Data.Semigroup
         (Semigroup, (<>), Min(Min,getMin), Max(Max,getMax), Arg(Arg))

import Prelude2010 hiding (map, zipWith, foldl1, minimum, maximum, replicate)
import Prelude ()


{- $setup
>>> import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked
>>>                                              as TestBoxedArray
>>> import qualified Data.Array.Comfort.Boxed as BoxedArray
>>> import qualified Data.Array.Comfort.Storable as Array
>>> import qualified Data.Array.Comfort.Shape as Shape
>>> import Data.Array.Comfort.Storable (Array, (!))
>>>
>>> import qualified Test.QuickCheck as QC
>>> import Test.ChasingBottoms.IsBottom (isBottom)
>>>
>>> import Control.Monad (replicateM)
>>> import Control.Applicative ((<$>), (<*>))
>>>
>>> import qualified Data.Map as Map
>>> import qualified Data.Set as Set
>>> import Data.Map (Map)
>>> import Data.Function.HT (Id)
>>> import Data.Complex (Complex((:+)))
>>> import Data.Tuple.HT (swap)
>>> import Data.Word (Word16)
>>>
>>> import Foreign.Storable (Storable)
>>>
>>> type ShapeInt = Shape.ZeroBased Int
>>> type X = Shape.Element
>>>
>>> shapeInt :: Int -> ShapeInt
>>> shapeInt = Shape.ZeroBased
>>>
>>> genArray :: QC.Gen (Array ShapeInt Word16)
>>> genArray = Array.vectorFromList <$> QC.arbitrary
>>>
>>> genArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)
>>> genArray2 = do
>>>    xs <- QC.arbitrary
>>>    let n = length xs
>>>    (k,m) <-
>>>       if n == 0
>>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)
>>>          else fmap (\m -> (div n m, m)) $ QC.choose (1,n)
>>>    return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs
>>>
>>> genArrayForShape :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)
>>> genArrayForShape sh =
>>>    Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary
>>>
>>> genNonEmptyArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)
>>> genNonEmptyArray2 = do
>>>    xs <- QC.getNonEmpty <$> QC.arbitrary
>>>    let n = length xs
>>>    m <- QC.choose (1,n)
>>>    return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs
>>>
>>> infix 4 ==?
>>> (==?) :: a -> a -> (a,a)
>>> (==?) = (,)
>>>
>>> forAllNonEmpty :: (Eq b) => (Array ShapeInt Word16 -> (b,b)) -> QC.Property
>>> forAllNonEmpty f =
>>>    QC.forAll genArray $ \xs ->
>>>    case f xs of
>>>       (resultArray,resultList) ->
>>>          if Array.shape xs == Shape.ZeroBased 0
>>>             then isBottom resultArray
>>>             else resultArray == resultList
>>>
>>>
>>> transpose ::
>>>    (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>
>>>    Array (sh0,sh1) a -> Array (sh1,sh0) a
>>> transpose a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))
-}


shape :: Array sh a -> sh
shape :: forall sh a. Array sh a -> sh
shape = Array sh a -> sh
forall sh a. Array sh a -> sh
Array.shape

reshape :: (Shape.C sh0, Shape.C sh1) => sh1 -> Array sh0 a -> Array sh1 a
reshape :: forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
reshape = String
-> (Array sh0 a -> sh0)
-> (sh1 -> Array sh0 a -> Array sh1 a)
-> sh1
-> Array sh0 a
-> Array sh1 a
forall sh0 sh1 array0 array1.
(C sh0, C sh1) =>
String
-> (array0 -> sh0)
-> (sh1 -> array0 -> array1)
-> sh1
-> array0
-> array1
Check.reshape String
"Storable" Array sh0 a -> sh0
forall sh a. Array sh a -> sh
shape sh1 -> Array sh0 a -> Array sh1 a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape

mapShape ::
   (Shape.C sh0, Shape.C sh1) => (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
mapShape :: forall sh0 sh1 a.
(C sh0, C sh1) =>
(sh0 -> sh1) -> Array sh0 a -> Array sh1 a
mapShape sh0 -> sh1
f Array sh0 a
arr = sh1 -> Array sh0 a -> Array sh1 a
forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
reshape (sh0 -> sh1
f (sh0 -> sh1) -> sh0 -> sh1
forall a b. (a -> b) -> a -> b
$ Array sh0 a -> sh0
forall sh a. Array sh a -> sh
shape Array sh0 a
arr) Array sh0 a
arr


{- |
>>> Array.fromList (shapeInt 5) ['a'..]
StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) "abcde"
-}
fromList :: (Shape.C sh, Storable a) => sh -> [a] -> Array sh a
fromList :: forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList sh
sh [a]
arr = (forall s. ST s (Array sh a)) -> Array sh a
forall a. (forall s. ST s a) -> a
runST (Array (ST s) sh a -> ST s (Array sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array m sh a -> m (Array sh a)
MutArrayNC.unsafeFreeze (Array (ST s) sh a -> ST s (Array sh a))
-> ST s (Array (ST s) sh a) -> ST s (Array sh a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sh -> [a] -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> [a] -> m (Array m sh a)
MutArray.fromList sh
sh [a]
arr)

fromMap :: (Ord k, Storable a) => Map k a -> Array (Set k) a
fromMap :: forall k a. (Ord k, Storable a) => Map k a -> Array (Set k) a
fromMap Map k a
m = Set k -> [a] -> Array (Set k) a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList (Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k a
m) (Map k a -> [a]
forall k a. Map k a -> [a]
Map.elems Map k a
m)

toMap :: (Ord k, Storable a) => Array (Set k) a -> Map k a
toMap :: forall k a. (Ord k, Storable a) => Array (Set k) a -> Map k a
toMap = [(k, a)] -> Map k a
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(k, a)] -> Map k a)
-> (Array (Set k) a -> [(k, a)]) -> Array (Set k) a -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Set k) a -> [(k, a)]
Array (Set k) a -> [(Index (Set k), a)]
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)]
toAssociations

fromIntMap :: (Storable a) => IntMap a -> Array IntSet a
fromIntMap :: forall a. Storable a => IntMap a -> Array IntSet a
fromIntMap IntMap a
m = IntSet -> [a] -> Array IntSet a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList (IntMap a -> IntSet
forall a. IntMap a -> IntSet
IntMap.keysSet IntMap a
m) (IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
m)

toIntMap :: (Storable a) => Array IntSet a -> IntMap a
toIntMap :: forall a. Storable a => Array IntSet a -> IntMap a
toIntMap = [(Key, a)] -> IntMap a
forall a. [(Key, a)] -> IntMap a
IntMap.fromAscList ([(Key, a)] -> IntMap a)
-> (Array IntSet a -> [(Key, a)]) -> Array IntSet a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array IntSet a -> [(Key, a)]
Array IntSet a -> [(Index IntSet, a)]
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)]
toAssociations

{- |
>>> Array.fromTuple ('a',('b','c')) :: Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char
StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) "abc"

>>> :{
   let arr :: Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char
       arr = Array.fromTuple ('a',('b','c'))
   in (arr ! fst, arr ! (fst.snd))
:}
('a','b')
-}
fromTuple ::
   (TupleShape.NestedTuple tuple, Storable a) =>
   Shape.DataTuple tuple a -> Array (Shape.NestedTuple ixtype tuple) a
fromTuple :: forall tuple a ixtype.
(NestedTuple tuple, Storable a) =>
DataTuple tuple a -> Array (NestedTuple ixtype tuple) a
fromTuple DataTuple tuple a
tuple =
   case State Element (tuple, [a]) -> Element -> (tuple, [a])
forall s a. State s a -> s -> a
MS.evalState (DataTuple tuple a -> State Element (tuple, [a])
forall a. DataTuple tuple a -> State Element (tuple, [a])
forall shape a.
NestedTuple shape =>
DataTuple shape a -> State Element (shape, [a])
TupleShape.decons DataTuple tuple a
tuple) (Key -> Element
Shape.Element Key
0) of
      (tuple
sh, [a]
xs) -> NestedTuple ixtype tuple
-> [a] -> Array (NestedTuple ixtype tuple) a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList (tuple -> NestedTuple ixtype tuple
forall ixtype tuple. tuple -> NestedTuple ixtype tuple
Shape.NestedTuple tuple
sh) [a]
xs

toTuple ::
   (TupleShape.NestedTuple tuple, Storable a) =>
   Array (Shape.NestedTuple ixtype tuple) a -> Shape.DataTuple tuple a
toTuple :: forall tuple a ixtype.
(NestedTuple tuple, Storable a) =>
Array (NestedTuple ixtype tuple) a -> DataTuple tuple a
toTuple Array (NestedTuple ixtype tuple) a
arr =
   State [a] (DataTuple tuple a) -> [a] -> DataTuple tuple a
forall s a. State s a -> s -> a
MS.evalState
      (tuple -> State [a] (DataTuple tuple a)
forall shape a.
ElementTuple shape =>
shape -> State [a] (DataTuple shape a)
TupleShape.cons (tuple -> State [a] (DataTuple tuple a))
-> tuple -> State [a] (DataTuple tuple a)
forall a b. (a -> b) -> a -> b
$ NestedTuple ixtype tuple -> tuple
forall ixtype tuple. NestedTuple ixtype tuple -> tuple
Shape.getNestedTuple (NestedTuple ixtype tuple -> tuple)
-> NestedTuple ixtype tuple -> tuple
forall a b. (a -> b) -> a -> b
$ Array (NestedTuple ixtype tuple) a -> NestedTuple ixtype tuple
forall sh a. Array sh a -> sh
shape Array (NestedTuple ixtype tuple) a
arr)
      (Array (NestedTuple ixtype tuple) a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array (NestedTuple ixtype tuple) a
arr)

{- |
>>> :{
   let arr = Array.fromRecord ('a' :+ 'b') in
   let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in
   (arr ! real, arr ! imag)
:}
('a','b')
-}
fromRecord ::
   (Trav.Traversable f, Storable a) =>
   f a -> Array (Shape.Record f) a
fromRecord :: forall (f :: * -> *) a.
(Traversable f, Storable a) =>
f a -> Array (Record f) a
fromRecord f a
xs =
   Record f -> [a] -> Array (Record f) a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList
      (f Element -> Record f
forall (f :: * -> *). f Element -> Record f
Shape.Record (f Element -> Record f) -> f Element -> Record f
forall a b. (a -> b) -> a -> b
$ (State Element (f Element) -> Element -> f Element)
-> Element -> State Element (f Element) -> f Element
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Element (f Element) -> Element -> f Element
forall s a. State s a -> s -> a
MS.evalState (Key -> Element
Shape.Element Key
0) (State Element (f Element) -> f Element)
-> State Element (f Element) -> f Element
forall a b. (a -> b) -> a -> b
$
       (a -> StateT Element Identity Element)
-> f a -> State Element (f Element)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
Trav.traverse (StateT Element Identity Element
-> a -> StateT Element Identity Element
forall a b. a -> b -> a
const StateT Element Identity Element
TupleShape.next) f a
xs)
      (f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f a
xs)

toRecord ::
   (Trav.Traversable f, Storable a) =>
   Array (Shape.Record f) a -> f a
toRecord :: forall (f :: * -> *) a.
(Traversable f, Storable a) =>
Array (Record f) a -> f a
toRecord Array (Record f) a
arr =
   State [a] (f a) -> [a] -> f a
forall s a. State s a -> s -> a
MS.evalState
      ((Element -> StateT [a] Identity a) -> f Element -> State [a] (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
Trav.traverse (StateT [a] Identity a -> Element -> StateT [a] Identity a
forall a b. a -> b -> a
const StateT [a] Identity a
forall a. State [a] a
TupleShape.get) (f Element -> State [a] (f a)) -> f Element -> State [a] (f a)
forall a b. (a -> b) -> a -> b
$
       (\(Shape.Record f Element
record) -> f Element
record) (Record f -> f Element) -> Record f -> f Element
forall a b. (a -> b) -> a -> b
$ Array (Record f) a -> Record f
forall sh a. Array sh a -> sh
shape Array (Record f) a
arr)
      (Array (Record f) a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array (Record f) a
arr)

fromContainer ::
   (Container.C f, Storable a) => f a -> Array (Container.Shape f) a
fromContainer :: forall (f :: * -> *) a.
(C f, Storable a) =>
f a -> Array (Shape f) a
fromContainer f a
xs = Shape f -> [a] -> Array (Shape f) a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
fromList (f a -> Shape f
forall a. f a -> Shape f
forall (f :: * -> *) a. C f => f a -> Shape f
Container.toShape f a
xs) (f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList f a
xs)

toContainer ::
   (Container.C f, Storable a) => Array (Container.Shape f) a -> f a
toContainer :: forall (f :: * -> *) a.
(C f, Storable a) =>
Array (Shape f) a -> f a
toContainer Array (Shape f) a
arr = Shape f -> [a] -> f a
forall a. Shape f -> [a] -> f a
forall (f :: * -> *) a. C f => Shape f -> [a] -> f a
Container.fromList (Array (Shape f) a -> Shape f
forall sh a. Array sh a -> sh
Array.shape Array (Shape f) a
arr) (Array (Shape f) a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array (Shape f) a
arr)

sample ::
   (Shape.Indexed sh, Storable a) => sh -> (Shape.Index sh -> a) -> Array sh a
sample :: forall sh a.
(Indexed sh, Storable a) =>
sh -> (Index sh -> a) -> Array sh a
sample sh
sh Index sh -> a
f = sh -> [a] -> Array sh a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
Array.fromList sh
sh ([a] -> Array sh a) -> [a] -> Array sh a
forall a b. (a -> b) -> a -> b
$ (Index sh -> a) -> [Index sh] -> [a]
forall a b. (a -> b) -> [a] -> [b]
List.map Index sh -> a
f ([Index sh] -> [a]) -> [Index sh] -> [a]
forall a b. (a -> b) -> a -> b
$ sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh

replicate ::
   (Shape.Indexed sh, Storable a) =>
   sh -> a -> Array sh a
replicate :: forall sh a. (Indexed sh, Storable a) => sh -> a -> Array sh a
replicate sh
sh a
a = (forall s. ST s (Array sh a)) -> Array sh a
forall a. (forall s. ST s a) -> a
runST (Array (ST s) sh a -> ST s (Array sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array m sh a -> m (Array sh a)
MutArrayNC.unsafeFreeze (Array (ST s) sh a -> ST s (Array sh a))
-> ST s (Array (ST s) sh a) -> ST s (Array sh a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sh -> a -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> a -> m (Array m sh a)
MutArray.new sh
sh a
a)


fromBoxed :: (Shape.C sh, Storable a) => BoxedArray.Array sh a -> Array sh a
fromBoxed :: forall sh a. (C sh, Storable a) => Array sh a -> Array sh a
fromBoxed Array sh a
arr = sh -> [a] -> Array sh a
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
Array.fromList (Array sh a -> sh
forall sh a. Array sh a -> sh
BoxedArray.shape Array sh a
arr) ([a] -> Array sh a) -> [a] -> Array sh a
forall a b. (a -> b) -> a -> b
$ Array sh a -> [a]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList Array sh a
arr

toBoxed :: (Shape.C sh, Storable a) => Array sh a -> BoxedArray.Array sh a
toBoxed :: forall sh a. (C sh, Storable a) => Array sh a -> Array sh a
toBoxed Array sh a
arr = sh -> [a] -> Array sh a
forall sh a. C sh => sh -> [a] -> Array sh a
BoxedArray.fromList (Array sh a -> sh
forall sh a. Array sh a -> sh
Array.shape Array sh a
arr) ([a] -> Array sh a) -> [a] -> Array sh a
forall a b. (a -> b) -> a -> b
$ Array sh a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array sh a
arr


fromStorableVector ::
   (Storable a) => SVB.Vector a -> Array (Shape.ZeroBased Int) a
fromStorableVector :: forall a. Storable a => Vector a -> Array (ZeroBased Key) a
fromStorableVector Vector a
xs =
   case Vector a -> (ForeignPtr a, Key, Key)
forall a. Vector a -> (ForeignPtr a, Key, Key)
SVB.toForeignPtr Vector a
xs of
      (ForeignPtr a
fptr,Key
0,Key
n) -> ZeroBased Key -> ForeignPtr a -> Array (ZeroBased Key) a
forall sh a. sh -> ForeignPtr a -> Array sh a
Array (Key -> ZeroBased Key
forall n. n -> ZeroBased n
Shape.ZeroBased Key
n) ForeignPtr a
fptr
      (ForeignPtr a
fptr,Key
s,Key
n) ->
         Array (ZeroBased Key ::+ ZeroBased Key) a
-> Array (ZeroBased Key) a
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array (sh0 ::+ sh1) a -> Array sh1 a
Array.takeRight (Array (ZeroBased Key ::+ ZeroBased Key) a
 -> Array (ZeroBased Key) a)
-> Array (ZeroBased Key ::+ ZeroBased Key) a
-> Array (ZeroBased Key) a
forall a b. (a -> b) -> a -> b
$
         (ZeroBased Key ::+ ZeroBased Key)
-> ForeignPtr a -> Array (ZeroBased Key ::+ ZeroBased Key) a
forall sh a. sh -> ForeignPtr a -> Array sh a
Array (Key -> ZeroBased Key
forall n. n -> ZeroBased n
Shape.ZeroBased Key
s ZeroBased Key -> ZeroBased Key -> ZeroBased Key ::+ ZeroBased Key
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+ Key -> ZeroBased Key
forall n. n -> ZeroBased n
Shape.ZeroBased Key
n) ForeignPtr a
fptr

toStorableVector :: (Shape.C sh, Storable a) => Array sh a -> SVB.Vector a
toStorableVector :: forall sh a. (C sh, Storable a) => Array sh a -> Vector a
toStorableVector (Array sh
sh ForeignPtr a
fptr) =
   ForeignPtr a -> Key -> Vector a
forall a. ForeignPtr a -> Key -> Vector a
SVB.fromForeignPtr ForeignPtr a
fptr (Key -> Vector a) -> Key -> Vector a
forall a b. (a -> b) -> a -> b
$ sh -> Key
forall sh. C sh => sh -> Key
Shape.size sh
sh


{- |
>>> :{
   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16
:}
StorableArray.fromList (fromList []) []

>>> :{
   let block n a = Array.replicate (shapeInt n) (a::Word16) in
   Array.fromBlockArray1 $
   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]
:}
StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3}),('C',ZeroBased {... 5})]) [0,0,1,1,1,2,2,2,2,2]
-}
fromBlockArray1 ::
   (Ord k, Shape.C shape, Storable a) =>
   BoxedArray.Array (Set k) (Array shape a) -> Array (Map k shape) a
fromBlockArray1 :: forall k shape a.
(Ord k, C shape, Storable a) =>
Array (Set k) (Array shape a) -> Array (Map k shape) a
fromBlockArray1 Array (Set k) (Array shape a)
a =
   Map k shape -> Array (ZeroBased Key) a -> Array (Map k shape) a
forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
reshape (Array (Set k) shape -> Map k shape
forall k a. Ord k => Array (Set k) a -> Map k a
BoxedArray.toMap (Array (Set k) shape -> Map k shape)
-> Array (Set k) shape -> Map k shape
forall a b. (a -> b) -> a -> b
$ (Array shape a -> shape)
-> Array (Set k) (Array shape a) -> Array (Set k) shape
forall a b. (a -> b) -> Array (Set k) a -> Array (Set k) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array shape a -> shape
forall sh a. Array sh a -> sh
Array.shape Array (Set k) (Array shape a)
a) (Array (ZeroBased Key) a -> Array (Map k shape) a)
-> Array (ZeroBased Key) a -> Array (Map k shape) a
forall a b. (a -> b) -> a -> b
$
   Vector a -> Array (ZeroBased Key) a
forall a. Storable a => Vector a -> Array (ZeroBased Key) a
fromStorableVector (Vector a -> Array (ZeroBased Key) a)
-> Vector a -> Array (ZeroBased Key) a
forall a b. (a -> b) -> a -> b
$ [Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SV.concat ([Vector a] -> Vector a) -> [Vector a] -> Vector a
forall a b. (a -> b) -> a -> b
$
   (Array shape a -> Vector a) -> [Array shape a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
List.map Array shape a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
toStorableVector ([Array shape a] -> [Vector a]) -> [Array shape a] -> [Vector a]
forall a b. (a -> b) -> a -> b
$ Array (Set k) (Array shape a) -> [Array shape a]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList Array (Set k) (Array shape a)
a

{- |
Only the outer @BoxedArray@ need to be non-empty.

>>> :{
   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in
   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in
   let block sh a = Array.replicate sh (a::Word16) in
   Array.fromBlockArray2
      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)
      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $
   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")
      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,
       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]
:}
StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList [('1',ZeroBased {... 3}),('2',ZeroBased {... 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]

prop> :{
   QC.forAll genArray2 $ \blockA1 ->
   QC.forAll genArray2 $ \blockB2 ->
   let shapeR0 = fst $ Array.shape blockA1 in
   let shapeC0 = snd $ Array.shape blockA1 in
   let shapeR1 = fst $ Array.shape blockB2 in
   let shapeC1 = snd $ Array.shape blockB2 in
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   let blocked =
         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")
            [blockA1, blockA2, blockB1, blockB2] in

   transpose (Array.fromNonEmptyBlockArray2 blocked)
   QC.===
   Array.fromNonEmptyBlockArray2
      (TestBoxedArray.transpose (fmap transpose blocked))
:}

prop> :{
   QC.forAll genArray2 $ \blockA1 ->
   QC.forAll genArray2 $ \blockB2 ->
   QC.forAll genArray2 $ \blockC3 ->
   let shapeR0 = fst $ Array.shape blockA1 in
   let shapeC0 = snd $ Array.shape blockA1 in
   let shapeR1 = fst $ Array.shape blockB2 in
   let shapeC1 = snd $ Array.shape blockB2 in
   let shapeR2 = fst $ Array.shape blockC3 in
   let shapeC2 = snd $ Array.shape blockC3 in
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->
   let blocked =
         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")
            [blockA1, blockA2, blockA3,
             blockB1, blockB2, blockB3,
             blockC1, blockC2, blockC3] in

   transpose (Array.fromNonEmptyBlockArray2 blocked)
   QC.===
   Array.fromNonEmptyBlockArray2
      (TestBoxedArray.transpose (fmap transpose blocked))
:}
-}
fromNonEmptyBlockArray2 ::
   (Ord row,    Shape.C height, Eq height) =>
   (Ord column, Shape.C width,  Eq width) =>
   (Storable a) =>
   BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->
   Array (Map row height, Map column width) a
fromNonEmptyBlockArray2 :: forall row height column width a.
(Ord row, C height, Eq height, Ord column, C width, Eq width,
 Storable a) =>
Array (Set row, Set column) (Array (height, width) a)
-> Array (Map row height, Map column width) a
fromNonEmptyBlockArray2 Array (Set row, Set column) (Array (height, width) a)
arr =
   let shapes :: [(height, width)]
shapes = (Array (height, width) a -> (height, width))
-> [Array (height, width) a] -> [(height, width)]
forall a b. (a -> b) -> [a] -> [b]
List.map Array (height, width) a -> (height, width)
forall sh a. Array sh a -> sh
Array.shape ([Array (height, width) a] -> [(height, width)])
-> [Array (height, width) a] -> [(height, width)]
forall a b. (a -> b) -> a -> b
$ Array (Set row, Set column) (Array (height, width) a)
-> [Array (height, width) a]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList Array (Set row, Set column) (Array (height, width) a)
arr in
   let width :: Key
width = Set column -> Key
forall a. Set a -> Key
Set.size (Set column -> Key) -> Set column -> Key
forall a b. (a -> b) -> a -> b
$ (Set row, Set column) -> Set column
forall a b. (a, b) -> b
snd ((Set row, Set column) -> Set column)
-> (Set row, Set column) -> Set column
forall a b. (a -> b) -> a -> b
$ Array (Set row, Set column) (Array (height, width) a)
-> (Set row, Set column)
forall sh a. Array sh a -> sh
BoxedArray.shape Array (Set row, Set column) (Array (height, width) a)
arr in
   let ([row]
rowIxs, [column]
columnIxs) =
         (Set row -> [row], Set column -> [column])
-> (Set row, Set column) -> ([row], [column])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Set row -> [row]
forall a. Set a -> [a]
Set.toAscList, Set column -> [column]
forall a. Set a -> [a]
Set.toAscList) ((Set row, Set column) -> ([row], [column]))
-> (Set row, Set column) -> ([row], [column])
forall a b. (a -> b) -> a -> b
$ Array (Set row, Set column) (Array (height, width) a)
-> (Set row, Set column)
forall sh a. Array sh a -> sh
BoxedArray.shape Array (Set row, Set column) (Array (height, width) a)
arr in
   case (Key -> [(height, width)] -> [(height, width)]
forall a. Key -> [a] -> [a]
ListHT.sieve Key
width [(height, width)]
shapes, Key -> [(height, width)] -> [(height, width)]
forall a. Key -> [a] -> [a]
take Key
width [(height, width)]
shapes) of
      (leftColumn :: [(height, width)]
leftColumn@((height, width)
_:[(height, width)]
_), topRow :: [(height, width)]
topRow@((height, width)
_:[(height, width)]
_)) ->
         Map row height
-> Map column width
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (Map row height, Map column width) a
forall row height column width a.
(Ord row, C height, Eq height, Ord column, C width, Eq width,
 Storable a) =>
Map row height
-> Map column width
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (Map row height, Map column width) a
fromBlockArray2
            ([(row, height)] -> Map row height
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(row, height)] -> Map row height)
-> [(row, height)] -> Map row height
forall a b. (a -> b) -> a -> b
$ [row] -> [height] -> [(row, height)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip [row]
rowIxs ([height] -> [(row, height)]) -> [height] -> [(row, height)]
forall a b. (a -> b) -> a -> b
$ ((height, width) -> height) -> [(height, width)] -> [height]
forall a b. (a -> b) -> [a] -> [b]
List.map (height, width) -> height
forall a b. (a, b) -> a
fst [(height, width)]
leftColumn)
            ([(column, width)] -> Map column width
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(column, width)] -> Map column width)
-> [(column, width)] -> Map column width
forall a b. (a -> b) -> a -> b
$ [column] -> [width] -> [(column, width)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip [column]
columnIxs ([width] -> [(column, width)]) -> [width] -> [(column, width)]
forall a b. (a -> b) -> a -> b
$ ((height, width) -> width) -> [(height, width)] -> [width]
forall a b. (a -> b) -> [a] -> [b]
List.map (height, width) -> width
forall a b. (a, b) -> b
snd [(height, width)]
topRow)
            Array (Set row, Set column) (Array (height, width) a)
arr
      ([(height, width)], [(height, width)])
_ -> String -> String -> Array (Map row height, Map column width) a
forall a. String -> String -> a
errorArray String
"fromNonEmptyBlockArray2" String
"empty array"

{- |
Explicit parameters for the shape of the result matrix
allow for working with arrays of zero rows or columns.

>>> :{
   (id :: Id (array (height, Map Char ShapeInt) Word16)) $
   Array.fromBlockArray2
      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))
      Map.empty $
   BoxedArray.fromList (Set.fromList "AB", Set.empty) []
:}
StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList []) []

prop> :{
   QC.forAll genArray2 $ \block ->
   let height = Map.singleton 'A' $ fst $ Array.shape block in
   let width  = Map.singleton '1' $ snd $ Array.shape block in

   Array.reshape (height,width) block
   QC.===
   Array.fromBlockArray2 height width
      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)
:}
-}
fromBlockArray2 ::
   (Ord row,    Shape.C height, Eq height) =>
   (Ord column, Shape.C width,  Eq width) =>
   (Storable a) =>
   Map row height -> Map column width ->
   BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->
   Array (Map row height, Map column width) a
fromBlockArray2 :: forall row height column width a.
(Ord row, C height, Eq height, Ord column, C width, Eq width,
 Storable a) =>
Map row height
-> Map column width
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (Map row height, Map column width) a
fromBlockArray2 Map row height
height Map column width
width =
   (Map row height, Map column width)
-> Array (ZeroBased Key) a
-> Array (Map row height, Map column width) a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (Map row height
height, Map column width
width) (Array (ZeroBased Key) a
 -> Array (Map row height, Map column width) a)
-> (Array (Set row, Set column) (Array (height, width) a)
    -> Array (ZeroBased Key) a)
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (Map row height, Map column width) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Array (ZeroBased Key) a
forall a. Storable a => Vector a -> Array (ZeroBased Key) a
fromStorableVector (Vector a -> Array (ZeroBased Key) a)
-> (Array (Set row, Set column) (Array (height, width) a)
    -> Vector a)
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (ZeroBased Key) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SV.concat ([Vector a] -> Vector a)
-> (Array (Set row, Set column) (Array (height, width) a)
    -> [Vector a])
-> Array (Set row, Set column) (Array (height, width) a)
-> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Vector a]] -> [Vector a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[Vector a]] -> [Vector a])
-> (Array (Set row, Set column) (Array (height, width) a)
    -> [[Vector a]])
-> Array (Set row, Set column) (Array (height, width) a)
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Vector a]] -> [[Vector a]]) -> [[[Vector a]]] -> [[Vector a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap [[Vector a]] -> [[Vector a]]
forall a. [[a]] -> [[a]]
List.transpose ([[[Vector a]]] -> [[Vector a]])
-> (Array (Set row, Set column) (Array (height, width) a)
    -> [[[Vector a]]])
-> Array (Set row, Set column) (Array (height, width) a)
-> [[Vector a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Key -> [[Vector a]] -> [[[Vector a]]]
forall a. Key -> [a] -> [[a]]
ListHT.sliceVertical (Map column width -> Key
forall k a. Map k a -> Key
Map.size Map column width
width) ([[Vector a]] -> [[[Vector a]]])
-> (Array (Set row, Set column) (Array (height, width) a)
    -> [[Vector a]])
-> Array (Set row, Set column) (Array (height, width) a)
-> [[[Vector a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Set row, Set column) [Vector a] -> [[Vector a]]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList (Array (Set row, Set column) [Vector a] -> [[Vector a]])
-> (Array (Set row, Set column) (Array (height, width) a)
    -> Array (Set row, Set column) [Vector a])
-> Array (Set row, Set column) (Array (height, width) a)
-> [[Vector a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((height, width) -> Array (height, width) a -> [Vector a])
-> Array (Set row, Set column) (height, width)
-> Array (Set row, Set column) (Array (height, width) a)
-> Array (Set row, Set column) [Vector a]
forall sh a b c.
(C sh, Eq sh) =>
(a -> b -> c) -> Array sh a -> Array sh b -> Array sh c
BoxedArray.zipWith
      (\(height
h,width
w) Array (height, width) a
block ->
         if (height
h,width
w) (height, width) -> (height, width) -> Bool
forall a. Eq a => a -> a -> Bool
== Array (height, width) a -> (height, width)
forall sh a. Array sh a -> sh
Array.shape Array (height, width) a
block
            then Array (height, width) a -> [Vector a]
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array (sh0, sh1) a -> [Vector a]
toRowSlices Array (height, width) a
block
            else String -> String -> [Vector a]
forall a. String -> String -> a
errorArray String
"fromBlockArray2" String
"block shapes mismatch")
      (Array (Set row) height
-> Array (Set column) width
-> Array (Set row, Set column) (height, width)
forall sh0 sh1 a b.
(C sh0, C sh1) =>
Array sh0 a -> Array sh1 b -> Array (sh0, sh1) (a, b)
BoxedArray.cartesian
         (Map row height -> Array (Set row) height
forall k a. Ord k => Map k a -> Array (Set k) a
BoxedArray.fromMap Map row height
height) (Map column width -> Array (Set column) width
forall k a. Ord k => Map k a -> Array (Set k) a
BoxedArray.fromMap Map column width
width))
{-
[[[111,111],[222,222]],[[333,333],[444,444]]]
  |
  v
[111,222,111,222,333,444,333,444]
-}

toRowSlices ::
   (Shape.C sh0, Shape.C sh1, Storable a) =>
   Array (sh0, sh1) a -> [SV.Vector a]
toRowSlices :: forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array (sh0, sh1) a -> [Vector a]
toRowSlices Array (sh0, sh1) a
arr =
   Key -> Vector a -> [Vector a]
forall a. Storable a => Key -> Vector a -> [Vector a]
SV.sliceVertical (sh1 -> Key
forall sh. C sh => sh -> Key
Shape.size (sh1 -> Key) -> sh1 -> Key
forall a b. (a -> b) -> a -> b
$ (sh0, sh1) -> sh1
forall a b. (a, b) -> b
snd ((sh0, sh1) -> sh1) -> (sh0, sh1) -> sh1
forall a b. (a -> b) -> a -> b
$ Array (sh0, sh1) a -> (sh0, sh1)
forall sh a. Array sh a -> sh
shape Array (sh0, sh1) a
arr) (Vector a -> [Vector a]) -> Vector a -> [Vector a]
forall a b. (a -> b) -> a -> b
$ Array (sh0, sh1) a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
toStorableVector Array (sh0, sh1) a
arr


toAssociations ::
   (Shape.Indexed sh, Storable a) => Array sh a -> [(Shape.Index sh, a)]
toAssociations :: forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)]
toAssociations Array sh a
arr = [Index sh] -> [a] -> [(Index sh, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices (sh -> [Index sh]) -> sh -> [Index sh]
forall a b. (a -> b) -> a -> b
$ Array sh a -> sh
forall sh a. Array sh a -> sh
shape Array sh a
arr) (Array sh a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array sh a
arr)


errorArray :: String -> String -> a
errorArray :: forall a. String -> String -> a
errorArray String
name String
msg =
   String -> a
forall a. HasCallStack => String -> a
error (String
"Array.Comfort.Storable." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)

infixl 9 !

(!) :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> a
! :: forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> a
(!) Array sh a
arr = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> a
forall a. String -> String -> a
errorArray String
"!") a -> a
forall a. a -> a
id (Either String a -> a)
-> (Index sh -> Either String a) -> Index sh -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array sh a -> Index sh -> Either String a
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> Either String a
accessEither Array sh a
arr

accessMaybe ::
   (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> Maybe a
accessMaybe :: forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> Maybe a
accessMaybe Array sh a
arr = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
maybeRight (Either String a -> Maybe a)
-> (Index sh -> Either String a) -> Index sh -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array sh a -> Index sh -> Either String a
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> Either String a
accessEither Array sh a
arr

accessEither ::
   (Shape.Indexed sh, Storable a) =>
   Array sh a -> Shape.Index sh -> Either String a
accessEither :: forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> Either String a
accessEither Array sh a
arr Index sh
ix = (forall s. ST s (Either String a)) -> Either String a
forall a. (forall s. ST s a) -> a
runST (do
   Array (ST s) sh a
marr <- Array sh a -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array sh a -> m (Array m sh a)
MutArrayNC.unsafeThaw Array sh a
arr
   case Array (ST s) sh a -> Index sh -> Either String (ST s a)
forall (m :: * -> *) sh a.
(PrimMonad m, Indexed sh, Storable a) =>
Array m sh a -> Index sh -> Either String (m a)
MutArrayPriv.readEither Array (ST s) sh a
marr Index sh
ix of
      Right ST s a
access -> (a -> Either String a) -> ST s a -> ST s (Either String a)
forall a b. (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either String a
forall a b. b -> Either a b
Right ST s a
access
      Left String
msg -> Either String a -> ST s (Either String a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> ST s (Either String a))
-> Either String a -> ST s (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left String
msg)
--   for GHC>=7.8: Trav.sequenceA $ MutArrayPriv.readEither marr ix)


zipWith ::
   (Shape.C sh, Eq sh, Storable a, Storable b, Storable c) =>
   (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c
zipWith :: forall sh a b c.
(C sh, Eq sh, Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Array sh a -> Array sh b -> Array sh c
zipWith a -> b -> c
f Array sh a
a Array sh b
b =
   if Array sh a -> sh
forall sh a. Array sh a -> sh
shape Array sh a
a sh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
== Array sh b -> sh
forall sh a. Array sh a -> sh
shape Array sh b
b
      then (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c
forall sh a b c.
(C sh, Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Array sh a -> Array sh b -> Array sh c
Array.zipWith a -> b -> c
f Array sh a
a Array sh b
b
      else String -> String -> Array sh c
forall a. String -> String -> a
errorArray String
"zipWith" String
"shapes mismatch"

(//) ::
   (Shape.Indexed sh, Storable a) =>
   Array sh a -> [(Shape.Index sh, a)] -> Array sh a
// :: forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)] -> Array sh a
(//) Array sh a
arr [(Index sh, a)]
xs = (forall s. ST s (Array sh a)) -> Array sh a
forall a. (forall s. ST s a) -> a
runST (do
   Array (ST s) sh a
marr <- Array sh a -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array sh a -> m (Array m sh a)
MutArray.thaw Array sh a
arr
   [(Index sh, a)] -> ((Index sh, a) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Index sh, a)]
xs (((Index sh, a) -> ST s ()) -> ST s ())
-> ((Index sh, a) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ())
-> (Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Array (ST s) sh a -> Index sh -> a -> ST s ()
forall (m :: * -> *) sh a.
(PrimMonad m, Indexed sh, Storable a) =>
Array m sh a -> Index sh -> a -> m ()
MutArray.write Array (ST s) sh a
marr
   Array (ST s) sh a -> ST s (Array sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array m sh a -> m (Array sh a)
MutArrayNC.unsafeFreeze Array (ST s) sh a
marr)

accumulate ::
   (Shape.Indexed sh, Storable a) =>
   (a -> b -> a) -> Array sh a -> [(Shape.Index sh, b)] -> Array sh a
accumulate :: forall sh a b.
(Indexed sh, Storable a) =>
(a -> b -> a) -> Array sh a -> [(Index sh, b)] -> Array sh a
accumulate a -> b -> a
f Array sh a
arr [(Index sh, b)]
xs = (forall s. ST s (Array sh a)) -> Array sh a
forall a. (forall s. ST s a) -> a
runST (do
   Array (ST s) sh a
marr <- Array sh a -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array sh a -> m (Array m sh a)
MutArray.thaw Array sh a
arr
   [(Index sh, b)] -> ((Index sh, b) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Index sh, b)]
xs (((Index sh, b) -> ST s ()) -> ST s ())
-> ((Index sh, b) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Index sh
ix,b
b) -> Array (ST s) sh a -> Index sh -> (a -> a) -> ST s ()
forall (m :: * -> *) sh a.
(PrimMonad m, Indexed sh, Storable a) =>
Array m sh a -> Index sh -> (a -> a) -> m ()
MutArray.update Array (ST s) sh a
marr Index sh
ix ((a -> a) -> ST s ()) -> (a -> a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ (a -> b -> a) -> b -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> a
f b
b
   Array (ST s) sh a -> ST s (Array sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array m sh a -> m (Array sh a)
MutArrayNC.unsafeFreeze Array (ST s) sh a
marr)

fromAssociations ::
   (Shape.Indexed sh, Storable a) =>
   a -> sh -> [(Shape.Index sh, a)] -> Array sh a
fromAssociations :: forall sh a.
(Indexed sh, Storable a) =>
a -> sh -> [(Index sh, a)] -> Array sh a
fromAssociations a
a sh
sh [(Index sh, a)]
xs = (forall s. ST s (Array sh a)) -> Array sh a
forall a. (forall s. ST s a) -> a
runST (do
   Array (ST s) sh a
marr <- sh -> a -> ST s (Array (ST s) sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> a -> m (Array m sh a)
MutArray.new sh
sh a
a
   [(Index sh, a)] -> ((Index sh, a) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Index sh, a)]
xs (((Index sh, a) -> ST s ()) -> ST s ())
-> ((Index sh, a) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ())
-> (Index sh -> a -> ST s ()) -> (Index sh, a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Array (ST s) sh a -> Index sh -> a -> ST s ()
forall (m :: * -> *) sh a.
(PrimMonad m, Indexed sh, Storable a) =>
Array m sh a -> Index sh -> a -> m ()
MutArray.write Array (ST s) sh a
marr
   Array (ST s) sh a -> ST s (Array sh a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
Array m sh a -> m (Array sh a)
MutArrayNC.unsafeFreeze Array (ST s) sh a
marr)


{- |
prop> QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)
-}
pick ::
   (Shape.Indexed sh0, Shape.C sh1, Storable a) =>
   Array (sh0,sh1) a -> Shape.Index sh0 -> Array sh1 a
pick :: forall sh0 sh1 a.
(Indexed sh0, C sh1, Storable a) =>
Array (sh0, sh1) a -> Index sh0 -> Array sh1 a
pick (Array (sh0
sh0,sh1
sh1) ForeignPtr a
x) Index sh0
ix0 =
   sh1 -> (Key -> Ptr a -> IO ()) -> Array sh1 a
forall sh a.
(C sh, Storable a) =>
sh -> (Key -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize sh1
sh1 ((Key -> Ptr a -> IO ()) -> Array sh1 a)
-> (Key -> Ptr a -> IO ()) -> Array sh1 a
forall a b. (a -> b) -> a -> b
$ \Key
k Ptr a
yPtr ->
   ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr ->
      Ptr a -> Ptr a -> Key -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Key -> IO ()
copyArray Ptr a
yPtr (Ptr a -> Key -> Ptr a
forall a. Storable a => Ptr a -> Key -> Ptr a
advancePtr Ptr a
xPtr (sh0 -> Index sh0 -> Key
forall sh. Indexed sh => sh -> Index sh -> Key
Shape.offset sh0
sh0 Index sh0
ix0 Key -> Key -> Key
forall a. Num a => a -> a -> a
* Key
k)) Key
k

toRowArray ::
   (Shape.Indexed sh0, Shape.C sh1, Storable a) =>
   Array (sh0,sh1) a -> BoxedArray.Array sh0 (Array sh1 a)
toRowArray :: forall sh0 sh1 a.
(Indexed sh0, C sh1, Storable a) =>
Array (sh0, sh1) a -> Array sh0 (Array sh1 a)
toRowArray Array (sh0, sh1) a
x = (Index sh0 -> Array sh1 a)
-> Array sh0 (Index sh0) -> Array sh0 (Array sh1 a)
forall a b. (a -> b) -> Array sh0 a -> Array sh0 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array (sh0, sh1) a -> Index sh0 -> Array sh1 a
forall sh0 sh1 a.
(Indexed sh0, C sh1, Storable a) =>
Array (sh0, sh1) a -> Index sh0 -> Array sh1 a
pick Array (sh0, sh1) a
x) (Array sh0 (Index sh0) -> Array sh0 (Array sh1 a))
-> Array sh0 (Index sh0) -> Array sh0 (Array sh1 a)
forall a b. (a -> b) -> a -> b
$ sh0 -> Array sh0 (Index sh0)
forall sh. Indexed sh => sh -> Array sh (Index sh)
BoxedArray.indices (sh0 -> Array sh0 (Index sh0)) -> sh0 -> Array sh0 (Index sh0)
forall a b. (a -> b) -> a -> b
$ (sh0, sh1) -> sh0
forall a b. (a, b) -> a
fst ((sh0, sh1) -> sh0) -> (sh0, sh1) -> sh0
forall a b. (a -> b) -> a -> b
$ Array (sh0, sh1) a -> (sh0, sh1)
forall sh a. Array sh a -> sh
Array.shape Array (sh0, sh1) a
x

{- |
It is a checked error if a row width differs from the result array width.

prop> QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs)
-}
fromRowArray ::
   (Shape.C sh0, Shape.C sh1, Eq sh1, Storable a) =>
   sh1 -> BoxedArray.Array sh0 (Array sh1 a) -> Array (sh0,sh1) a
fromRowArray :: forall sh0 sh1 a.
(C sh0, C sh1, Eq sh1, Storable a) =>
sh1 -> Array sh0 (Array sh1 a) -> Array (sh0, sh1) a
fromRowArray sh1
sh1 Array sh0 (Array sh1 a)
x =
   (sh0, sh1) -> (Ptr a -> IO ()) -> Array (sh0, sh1) a
forall sh a.
(C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> Array sh a
Array.unsafeCreate (Array sh0 (Array sh1 a) -> sh0
forall sh a. Array sh a -> sh
BoxedArray.shape Array sh0 (Array sh1 a)
x, sh1
sh1) ((Ptr a -> IO ()) -> Array (sh0, sh1) a)
-> (Ptr a -> IO ()) -> Array (sh0, sh1) a
forall a b. (a -> b) -> a -> b
$ \Ptr a
yPtr ->
   let k :: Key
k = sh1 -> Key
forall sh. C sh => sh -> Key
Shape.size sh1
sh1 in
   [(Key, Array sh1 a)] -> ((Key, Array sh1 a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Key] -> [Array sh1 a] -> [(Key, Array sh1 a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0,Key
k..] (Array sh0 (Array sh1 a) -> [Array sh1 a]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList Array sh0 (Array sh1 a)
x)) (((Key, Array sh1 a) -> IO ()) -> IO ())
-> ((Key, Array sh1 a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Key
j, Array sh1
sh1i ForeignPtr a
row) ->
   if sh1
sh1 sh1 -> sh1 -> Bool
forall a. Eq a => a -> a -> Bool
== sh1
sh1i
      then ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
row ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr -> Ptr a -> Ptr a -> Key -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Key -> IO ()
copyArray (Ptr a -> Key -> Ptr a
forall a. Storable a => Ptr a -> Key -> Ptr a
advancePtr Ptr a
yPtr Key
j) Ptr a
xPtr Key
k
      else String -> String -> IO ()
forall a. String -> String -> a
errorArray String
"fromRowArray" String
"mismatching row width"


{- |
It is a checked error if the vector is empty.

prop> forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs)
-}
minimum :: (Shape.C sh, Storable a, Ord a) => Array sh a -> a
minimum :: forall sh a. (C sh, Storable a, Ord a) => Array sh a -> a
minimum = (a -> a -> a) -> Array sh a -> a
forall sh a. (C sh, Storable a) => (a -> a -> a) -> Array sh a -> a
foldl1 a -> a -> a
forall a. Ord a => a -> a -> a
min

{- |
It is a checked error if the vector is empty.

prop> forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs)
-}
maximum :: (Shape.C sh, Storable a, Ord a) => Array sh a -> a
maximum :: forall sh a. (C sh, Storable a, Ord a) => Array sh a -> a
maximum = (a -> a -> a) -> Array sh a -> a
forall sh a. (C sh, Storable a) => (a -> a -> a) -> Array sh a -> a
foldl1 a -> a -> a
forall a. Ord a => a -> a -> a
max

{-# INLINE foldl1 #-}
foldl1 :: (Shape.C sh, Storable a) => (a -> a -> a) -> Array sh a -> a
foldl1 :: forall sh a. (C sh, Storable a) => (a -> a -> a) -> Array sh a -> a
foldl1 a -> a -> a
op (Array sh
sh ForeignPtr a
x) = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$
   ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr ->
      (Key -> a -> a) -> (a -> a -> a) -> Key -> Ptr a -> Key -> IO a
forall a b.
Storable a =>
(Key -> a -> b) -> (b -> b -> b) -> Key -> Ptr a -> Key -> IO b
Memory.foldl1 ((a -> a) -> Key -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id) a -> a -> a
op (sh -> Key
forall sh. C sh => sh -> Key
Shape.size sh
sh) Ptr a
xPtr Key
1

{- |
prop> forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs)
-}
limits :: (Shape.C sh, Storable a, Ord a) => Array sh a -> (a,a)
limits :: forall sh a. (C sh, Storable a, Ord a) => Array sh a -> (a, a)
limits = (Min a -> a, Max a -> a) -> (Min a, Max a) -> (a, a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
StrictTuple.mapPair (Min a -> a
forall a. Min a -> a
getMin, Max a -> a
forall a. Max a -> a
getMax) ((Min a, Max a) -> (a, a))
-> (Array sh a -> (Min a, Max a)) -> Array sh a -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Min a, Max a)) -> Array sh a -> (Min a, Max a)
forall sh a m.
(C sh, Storable a, Ord a, Semigroup m) =>
(a -> m) -> Array sh a -> m
foldMap (\a
x -> (a -> Min a
forall a. a -> Min a
Min a
x, a -> Max a
forall a. a -> Max a
Max a
x))

{-# INLINE foldMap #-}
foldMap ::
   (Shape.C sh, Storable a, Ord a, Semigroup m) => (a -> m) -> Array sh a -> m
foldMap :: forall sh a m.
(C sh, Storable a, Ord a, Semigroup m) =>
(a -> m) -> Array sh a -> m
foldMap a -> m
f (Array sh
sh ForeignPtr a
x) = IO m -> m
forall a. IO a -> a
unsafePerformIO (IO m -> m) -> IO m -> m
forall a b. (a -> b) -> a -> b
$
   ForeignPtr a -> (Ptr a -> IO m) -> IO m
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO m) -> IO m) -> (Ptr a -> IO m) -> IO m
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr ->
      (Key -> a -> m) -> (m -> m -> m) -> Key -> Ptr a -> Key -> IO m
forall a b.
Storable a =>
(Key -> a -> b) -> (b -> b -> b) -> Key -> Ptr a -> Key -> IO b
Memory.foldl1 ((a -> m) -> Key -> a -> m
forall a b. a -> b -> a
const a -> m
f) m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (sh -> Key
forall sh. C sh => sh -> Key
Shape.size sh
sh) Ptr a
xPtr Key
1


argMinimum, argMaximum ::
   (Shape.InvIndexed sh, Storable a, Ord a) =>
   Array sh a -> (Shape.Index sh, a)
argMinimum :: forall sh a.
(InvIndexed sh, Storable a, Ord a) =>
Array sh a -> (Index sh, a)
argMinimum Array sh a
xs = Array sh a -> Arg a Key -> (Index sh, a)
forall sh a.
InvIndexed sh =>
Array sh a -> Arg a Key -> (Index sh, a)
unArg Array sh a
xs (Arg a Key -> (Index sh, a)) -> Arg a Key -> (Index sh, a)
forall a b. (a -> b) -> a -> b
$ Min (Arg a Key) -> Arg a Key
forall a. Min a -> a
getMin (Min (Arg a Key) -> Arg a Key) -> Min (Arg a Key) -> Arg a Key
forall a b. (a -> b) -> a -> b
$ (Key -> a -> Min (Arg a Key)) -> Array sh a -> Min (Arg a Key)
forall sh a m.
(C sh, Storable a, Semigroup m) =>
(Key -> a -> m) -> Array sh a -> m
foldMapWithIndex (\Key
k a
x -> Arg a Key -> Min (Arg a Key)
forall a. a -> Min a
Min (a -> Key -> Arg a Key
forall a b. a -> b -> Arg a b
Arg a
x Key
k)) Array sh a
xs
argMaximum :: forall sh a.
(InvIndexed sh, Storable a, Ord a) =>
Array sh a -> (Index sh, a)
argMaximum Array sh a
xs = Array sh a -> Arg a Key -> (Index sh, a)
forall sh a.
InvIndexed sh =>
Array sh a -> Arg a Key -> (Index sh, a)
unArg Array sh a
xs (Arg a Key -> (Index sh, a)) -> Arg a Key -> (Index sh, a)
forall a b. (a -> b) -> a -> b
$ Max (Arg a Key) -> Arg a Key
forall a. Max a -> a
getMax (Max (Arg a Key) -> Arg a Key) -> Max (Arg a Key) -> Arg a Key
forall a b. (a -> b) -> a -> b
$ (Key -> a -> Max (Arg a Key)) -> Array sh a -> Max (Arg a Key)
forall sh a m.
(C sh, Storable a, Semigroup m) =>
(Key -> a -> m) -> Array sh a -> m
foldMapWithIndex (\Key
k a
x -> Arg a Key -> Max (Arg a Key)
forall a. a -> Max a
Max (a -> Key -> Arg a Key
forall a b. a -> b -> Arg a b
Arg a
x Key
k)) Array sh a
xs

unArg ::
   (Shape.InvIndexed sh) => Array sh a -> Arg a Int -> (Shape.Index sh, a)
unArg :: forall sh a.
InvIndexed sh =>
Array sh a -> Arg a Key -> (Index sh, a)
unArg Array sh a
xs (Arg a
x Key
k) = (sh -> Key -> Index sh
forall sh. InvIndexed sh => sh -> Key -> Index sh
Shape.indexFromOffset (Array sh a -> sh
forall sh a. Array sh a -> sh
Array.shape Array sh a
xs) Key
k, a
x)

{-# INLINE foldMapWithIndex #-}
foldMapWithIndex ::
   (Shape.C sh, Storable a, Semigroup m) => (Int -> a -> m) -> Array sh a -> m
foldMapWithIndex :: forall sh a m.
(C sh, Storable a, Semigroup m) =>
(Key -> a -> m) -> Array sh a -> m
foldMapWithIndex Key -> a -> m
f (Array sh
sh ForeignPtr a
x) = IO m -> m
forall a. IO a -> a
unsafePerformIO (IO m -> m) -> IO m -> m
forall a b. (a -> b) -> a -> b
$
   ForeignPtr a -> (Ptr a -> IO m) -> IO m
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
x ((Ptr a -> IO m) -> IO m) -> (Ptr a -> IO m) -> IO m
forall a b. (a -> b) -> a -> b
$ \Ptr a
xPtr -> (Key -> a -> m) -> (m -> m -> m) -> Key -> Ptr a -> Key -> IO m
forall a b.
Storable a =>
(Key -> a -> b) -> (b -> b -> b) -> Key -> Ptr a -> Key -> IO b
Memory.foldl1 Key -> a -> m
f m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (sh -> Key
forall sh. C sh => sh -> Key
Shape.size sh
sh) Ptr a
xPtr Key
1