{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Array.Comfort.Storable.Dim2 (
   Array2,
   singleRow, flattenRow,
   singleColumn, flattenColumn,
   takeRow,
   toRowArray,
   fromRowArray,
   above, beside,
   takeTop, takeBottom,
   takeLeft, takeRight,

   fromNonEmptyBlockArray,
   fromBlockArray,
   fromBlocks, BlockFunction, RowFunction,
   ShapeSequence(switchSequence),

   BlockArray, BlockMatrix, Block,
   fromBlockMatrix, block, blockAbove, blockBeside, (&===), (&|||),
   ) where

import qualified Data.Array.Comfort.Boxed as BoxedArray
import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Shape.SubSize as SubSize
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable.Unchecked (Array(Array))
import Data.Array.Comfort.Shape ((::+)((::+)))

import Foreign.Marshal.Array (copyArray, advancePtr)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable (Storable)

import qualified Data.StorableVector as SV

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Map (Map)
import Data.Set (Set)
import Data.Foldable (forM_)
import Data.Tuple.HT (mapPair, mapFst)
import Data.Proxy (Proxy(Proxy))


{- $setup
>>> import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked
>>>                                              as TestBoxedArray
>>> import DocTest.Data.Array.Comfort.Storable (ShapeInt, shapeInt)
>>>
>>> import qualified Data.Array.Comfort.Boxed as BoxedArray
>>> import qualified Data.Array.Comfort.Storable.Dim2 as Array2
>>> import qualified Data.Array.Comfort.Storable as Array
>>> import qualified Data.Array.Comfort.Shape as Shape
>>> import Data.Array.Comfort.Storable.Dim2 (Array2, (&===), (&|||))
>>> import Data.Array.Comfort.Storable (Array, (!))
>>> import Data.Array.Comfort.Shape ((::+)((::+)))
>>>
>>> import qualified Test.QuickCheck as QC
>>>
>>> import Control.Monad (replicateM)
>>> import Control.Applicative (liftA2, (<$>), (<*>))
>>>
>>> import qualified Data.Map as Map
>>> import qualified Data.Set as Set
>>> import Data.Map (Map)
>>> import Data.Function.HT (Id)
>>> import Data.Tuple.HT (swap)
>>> import Data.Word (Word16)
>>> import Data.Proxy (Proxy(Proxy))
>>>
>>> import Foreign.Storable (Storable)
>>>
>>> genArray2 :: QC.Gen (Array2 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 (Array2 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
>>>
>>>
>>> transpose ::
>>>    (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>
>>>    Array2 sh0 sh1 a -> Array2 sh1 sh0 a
>>> transpose a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))
-}


type Array2 sh0 sh1 = Array (sh0,sh1)

singleRow :: Array width a -> Array2 () width a
singleRow :: forall width a. Array width a -> Array2 () width a
singleRow = (width -> ((), width)) -> Array width a -> Array ((), width) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((,) ())

singleColumn :: Array height a -> Array2 height () a
singleColumn :: forall height a. Array height a -> Array2 height () a
singleColumn = (height -> (height, ())) -> Array height a -> Array (height, ()) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((height -> () -> (height, ())) -> () -> height -> (height, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ())

flattenRow :: Array2 () width a -> Array width a
flattenRow :: forall width a. Array2 () width a -> Array width a
flattenRow = (((), width) -> width) -> Array ((), width) a -> Array width a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((), width) -> width
forall a b. (a, b) -> b
snd

flattenColumn :: Array2 height () a -> Array height a
flattenColumn :: forall height a. Array2 height () a -> Array height a
flattenColumn = ((height, ()) -> height) -> Array (height, ()) a -> Array height a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape (height, ()) -> height
forall a b. (a, b) -> a
fst


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

toRowArray ::
   (Shape.C sh0, Shape.C sh1, Storable a) =>
   Array2 sh0 sh1 a -> BoxedArray.Array sh0 (Array sh1 a)
toRowArray :: forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> Array sh0 (Array sh1 a)
toRowArray Array2 sh0 sh1 a
x =
   let y :: Array (Deferred sh0, sh1) a
y = ((sh0, sh1) -> (Deferred sh0, sh1))
-> Array2 sh0 sh1 a -> Array (Deferred sh0, sh1) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape ((sh0 -> Deferred sh0) -> (sh0, sh1) -> (Deferred sh0, sh1)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst sh0 -> Deferred sh0
forall sh. sh -> Deferred sh
Shape.Deferred) Array2 sh0 sh1 a
x in
   (Deferred sh0 -> sh0)
-> Array (Deferred sh0) (Array sh1 a) -> Array sh0 (Array sh1 a)
forall sh0 sh1 a.
(C sh0, C sh1) =>
(sh0 -> sh1) -> Array sh0 a -> Array sh1 a
BoxedArray.mapShape (\(Shape.Deferred sh0
sh0) -> sh0
sh0) (Array (Deferred sh0) (Array sh1 a) -> Array sh0 (Array sh1 a))
-> Array (Deferred sh0) (Array sh1 a) -> Array sh0 (Array sh1 a)
forall a b. (a -> b) -> a -> b
$
   (DeferredIndex sh0 -> Array sh1 a)
-> Array (Deferred sh0) (DeferredIndex sh0)
-> Array (Deferred sh0) (Array sh1 a)
forall a b.
(a -> b) -> Array (Deferred sh0) a -> Array (Deferred sh0) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array (Deferred sh0, sh1) a -> Index (Deferred sh0) -> Array sh1 a
forall sh0 sh1 a.
(Indexed sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> Index sh0 -> Array sh1 a
takeRow Array (Deferred sh0, sh1) a
y) (Array (Deferred sh0) (DeferredIndex sh0)
 -> Array (Deferred sh0) (Array sh1 a))
-> Array (Deferred sh0) (DeferredIndex sh0)
-> Array (Deferred sh0) (Array sh1 a)
forall a b. (a -> b) -> a -> b
$ Deferred sh0 -> Array (Deferred sh0) (Index (Deferred sh0))
forall sh. Indexed sh => sh -> Array sh (Index sh)
BoxedArray.indices (Deferred sh0 -> Array (Deferred sh0) (Index (Deferred sh0)))
-> Deferred sh0 -> Array (Deferred sh0) (Index (Deferred sh0))
forall a b. (a -> b) -> a -> b
$ (Deferred sh0, sh1) -> Deferred sh0
forall a b. (a, b) -> a
fst ((Deferred sh0, sh1) -> Deferred sh0)
-> (Deferred sh0, sh1) -> Deferred sh0
forall a b. (a -> b) -> a -> b
$ Array (Deferred sh0, sh1) a -> (Deferred sh0, sh1)
forall sh a. Array sh a -> sh
Array.shape Array (Deferred sh0, sh1) a
y

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

prop> :{
   QC.forAll genArray2 $ \xs ->
      xs == Array2.fromRowArray (snd $ Array.shape xs) (Array2.toRowArray xs)
:}
-}
fromRowArray ::
   (Shape.C sh0, Shape.C sh1, Eq sh1, Storable a) =>
   sh1 -> BoxedArray.Array sh0 (Array sh1 a) -> Array2 sh0 sh1 a
fromRowArray :: forall sh0 sh1 a.
(C sh0, C sh1, Eq sh1, Storable a) =>
sh1 -> Array sh0 (Array sh1 a) -> Array2 sh0 sh1 a
fromRowArray sh1
sh1 Array sh0 (Array sh1 a)
x =
   (sh0, sh1)
-> ((Atom sh0, Atom sh1) -> Ptr a -> IO ()) -> Array (sh0, sh1) a
forall sh nsize a.
(C sh, sh ~ ToShape nsize, C nsize, Storable a) =>
sh -> (nsize -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithAutoSizes (Array sh0 (Array sh1 a) -> sh0
forall sh a. Array sh a -> sh
BoxedArray.shape Array sh0 (Array sh1 a)
x, sh1
sh1) (((Atom sh0, Atom sh1) -> Ptr a -> IO ()) -> Array (sh0, sh1) a)
-> ((Atom sh0, Atom sh1) -> Ptr a -> IO ()) -> Array (sh0, sh1) a
forall a b. (a -> b) -> a -> b
$
      \(SubSize.Atom Int
_, SubSize.Atom Int
k) Ptr a
yPtr ->
   [(Int, Array sh1 a)] -> ((Int, Array sh1 a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Array sh1 a] -> [(Int, Array sh1 a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
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)) (((Int, Array sh1 a) -> IO ()) -> IO ())
-> ((Int, Array sh1 a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
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 -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
yPtr Int
j) Ptr a
xPtr Int
k
      else String -> String -> IO ()
forall a. String -> String -> a
errorArray String
"fromRowArray" String
"mismatching row width"


infixr 2 `above`
infixr 3 `beside`

{- |
prop> :{
   QC.forAll genArray2 $ \xs ->
   let (Shape.ZeroBased m, width) = Array.shape xs in
   QC.forAll (QC.choose (0, m)) $ \k ->
      let ys = Array.reshape
                  (Shape.ZeroBased k ::+ Shape.ZeroBased (m-k), width) xs in
      ys == Array2.above (Array2.takeTop ys) (Array2.takeBottom ys)
:}
-}
above ::
   (Shape.C heightA, Shape.C heightB) =>
   (Shape.C width, Eq width) =>
   (Storable a) =>
   Array2 heightA width a ->
   Array2 heightB width a ->
   Array2 (heightA::+heightB) width a
above :: forall heightA heightB width a.
(C heightA, C heightB, C width, Eq width, Storable a) =>
Array2 heightA width a
-> Array2 heightB width a -> Array2 (heightA ::+ heightB) width a
above Array2 heightA width a
a Array2 heightB width a
b =
   (((heightA, width) ::+ (heightB, width))
 -> (heightA ::+ heightB, width))
-> Array ((heightA, width) ::+ (heightB, width)) a
-> Array (heightA ::+ heightB, width) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape
      (\((heightA
heightA,width
widthA)::+(heightB
heightB,width
widthB)) ->
         if width
widthA width -> width -> Bool
forall a. Eq a => a -> a -> Bool
== width
widthB
            then (heightA
heightAheightA -> heightB -> heightA ::+ heightB
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+heightB
heightB, width
widthA)
            else String -> (heightA ::+ heightB, width)
forall a. HasCallStack => String -> a
error String
"Array.Dim2.above: widths mismatch") (Array ((heightA, width) ::+ (heightB, width)) a
 -> Array (heightA ::+ heightB, width) a)
-> Array ((heightA, width) ::+ (heightB, width)) a
-> Array (heightA ::+ heightB, width) a
forall a b. (a -> b) -> a -> b
$
   Array2 heightA width a
-> Array2 heightB width a
-> Array ((heightA, width) ::+ (heightB, width)) a
forall shx shy a.
(C shx, C shy, Storable a) =>
Array shx a -> Array shy a -> Array (shx ::+ shy) a
Array.append Array2 heightA width a
a Array2 heightB width a
b

{- |
prop> :{
   QC.forAll genArray2 $ \xs ->
   let (height, Shape.ZeroBased n) = Array.shape xs in
   QC.forAll (QC.choose (0, n)) $ \k ->
      let ys = Array.reshape
                  (height, Shape.ZeroBased k ::+ Shape.ZeroBased (n-k)) xs in
      ys == Array2.beside (Array2.takeLeft ys) (Array2.takeRight ys)
:}
-}
beside ::
   (Shape.C height, Eq height) =>
   (Shape.C widthA, Shape.C widthB) =>
   (Storable a) =>
   Array2 height widthA a ->
   Array2 height widthB a ->
   Array2 height (widthA::+widthB) a
beside :: forall height widthA widthB a.
(C height, Eq height, C widthA, C widthB, Storable a) =>
Array2 height widthA a
-> Array2 height widthB a -> Array2 height (widthA ::+ widthB) a
beside Array2 height widthA a
a Array2 height widthB a
b =
   case (Array2 height widthA a -> (height, widthA)
forall sh a. Array sh a -> sh
Array.shape Array2 height widthA a
a, Array2 height widthB a -> (height, widthB)
forall sh a. Array sh a -> sh
Array.shape Array2 height widthB a
b) of
      ((height
heightA, widthA
widthA), (height
heightB, widthB
widthB)) ->
         if height
heightA height -> height -> Bool
forall a. Eq a => a -> a -> Bool
== height
heightB
            then
               (height, widthA ::+ widthB)
-> Array (ZeroBased Int) a -> Array2 height (widthA ::+ widthB) a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (height
heightA, widthA
widthAwidthA -> widthB -> widthA ::+ widthB
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+widthB
widthB) (Array (ZeroBased Int) a -> Array2 height (widthA ::+ widthB) a)
-> ([[Vector a]] -> Array (ZeroBased Int) a)
-> [[Vector a]]
-> Array2 height (widthA ::+ widthB) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Vector a -> Array (ZeroBased Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> ([[Vector a]] -> Vector a)
-> [[Vector a]]
-> Array (ZeroBased Int) 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)
-> ([[Vector a]] -> [Vector a]) -> [[Vector 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]
concat ([[Vector a]] -> [Vector a])
-> ([[Vector a]] -> [[Vector a]]) -> [[Vector a]] -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Vector a]] -> [[Vector a]]
forall a. Int -> [a] -> [a]
take (height -> Int
forall sh. C sh => sh -> Int
Shape.size height
heightA) ([[Vector a]] -> Array2 height (widthA ::+ widthB) a)
-> [[Vector a]] -> Array2 height (widthA ::+ widthB) a
forall a b. (a -> b) -> a -> b
$
               (Vector a -> Vector a -> [Vector a])
-> [Vector a] -> [Vector a] -> [[Vector a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                  (\Vector a
arow Vector a
brow -> [Vector a
arow, Vector a
brow])
                  (Array2 height widthA a -> [Vector a]
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlicesInf Array2 height widthA a
a)
                  (Array2 height widthB a -> [Vector a]
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlicesInf Array2 height widthB a
b)
            else String -> Array2 height (widthA ::+ widthB) a
forall a. HasCallStack => String -> a
error String
"Array.Dim2.beside: heights mismatch"


takeTop ::
   (Shape.C heightA, Shape.C heightB, Shape.C width, Storable a) =>
   Array2 (heightA::+heightB) width a ->
   Array2 heightA width a
takeTop :: forall heightA heightB width a.
(C heightA, C heightB, C width, Storable a) =>
Array2 (heightA ::+ heightB) width a -> Array2 heightA width a
takeTop = Array ((heightA, width) ::+ (heightB, width)) a
-> Array (heightA, width) a
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array (sh0 ::+ sh1) a -> Array sh0 a
Array.takeLeft (Array ((heightA, width) ::+ (heightB, width)) a
 -> Array (heightA, width) a)
-> (Array2 (heightA ::+ heightB) width a
    -> Array ((heightA, width) ::+ (heightB, width)) a)
-> Array2 (heightA ::+ heightB) width a
-> Array (heightA, width) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array2 (heightA ::+ heightB) width a
-> Array ((heightA, width) ::+ (heightB, width)) a
forall heightA heightB width a.
(C heightA, C heightB, C width) =>
Array2 (heightA ::+ heightB) width a
-> Array ((heightA, width) ::+ (heightB, width)) a
splitVertically

takeBottom ::
   (Shape.C heightA, Shape.C heightB, Shape.C width, Storable a) =>
   Array2 (heightA::+heightB) width a ->
   Array2 heightB width a
takeBottom :: forall heightA heightB width a.
(C heightA, C heightB, C width, Storable a) =>
Array2 (heightA ::+ heightB) width a -> Array2 heightB width a
takeBottom = Array ((heightA, width) ::+ (heightB, width)) a
-> Array (heightB, width) a
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array (sh0 ::+ sh1) a -> Array sh1 a
Array.takeRight (Array ((heightA, width) ::+ (heightB, width)) a
 -> Array (heightB, width) a)
-> (Array2 (heightA ::+ heightB) width a
    -> Array ((heightA, width) ::+ (heightB, width)) a)
-> Array2 (heightA ::+ heightB) width a
-> Array (heightB, width) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array2 (heightA ::+ heightB) width a
-> Array ((heightA, width) ::+ (heightB, width)) a
forall heightA heightB width a.
(C heightA, C heightB, C width) =>
Array2 (heightA ::+ heightB) width a
-> Array ((heightA, width) ::+ (heightB, width)) a
splitVertically

splitVertically ::
   (Shape.C heightA, Shape.C heightB, Shape.C width) =>
   Array2 (heightA::+heightB) width a ->
   Array ((heightA,width)::+(heightB,width)) a
splitVertically :: forall heightA heightB width a.
(C heightA, C heightB, C width) =>
Array2 (heightA ::+ heightB) width a
-> Array ((heightA, width) ::+ (heightB, width)) a
splitVertically =
   ((heightA ::+ heightB, width)
 -> (heightA, width) ::+ (heightB, width))
-> Array (heightA ::+ heightB, width) a
-> Array ((heightA, width) ::+ (heightB, width)) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape
      (\(heightA
heightA::+heightB
heightB, width
width) -> (heightA
heightA,width
width)(heightA, width)
-> (heightB, width) -> (heightA, width) ::+ (heightB, width)
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+(heightB
heightB,width
width))


takeLeft ::
   (Shape.C height, Shape.C widthA, Shape.C widthB, Storable a) =>
   Array2 height (widthA::+widthB) a ->
   Array2 height widthA a
takeLeft :: forall height widthA widthB a.
(C height, C widthA, C widthB, Storable a) =>
Array2 height (widthA ::+ widthB) a -> Array2 height widthA a
takeLeft Array2 height (widthA ::+ widthB) a
a =
   case Array2 height (widthA ::+ widthB) a -> (height, widthA ::+ widthB)
forall sh a. Array sh a -> sh
Array.shape Array2 height (widthA ::+ widthB) a
a of
      (height
height, widthA
widthA::+widthB
widthB) ->
         let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
             na :: Int
na = widthA -> Int
forall sh. C sh => sh -> Int
Shape.size widthA
widthA
             nb :: Int
nb = widthB -> Int
forall sh. C sh => sh -> Int
Shape.size widthB
widthB
         in (height, widthA)
-> Array (ZeroBased Int) a -> Array2 height widthA a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (height
height, widthA
widthA) (Array (ZeroBased Int) a -> Array2 height widthA a)
-> (Array2 height (widthA ::+ widthB) a -> Array (ZeroBased Int) a)
-> Array2 height (widthA ::+ widthB) a
-> Array2 height widthA a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Array (ZeroBased Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> (Array2 height (widthA ::+ widthB) a -> Vector a)
-> Array2 height (widthA ::+ widthB) a
-> Array (ZeroBased Int) 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)
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Vector a] -> [Vector a]
forall a. Int -> [a] -> [a]
take Int
m ([Vector a] -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a) -> [Vector a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.take Int
na) ([Vector a] -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Vector a -> Vector a) -> Vector a -> [Vector a]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (Int
naInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nb)) (Vector a -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> Vector a)
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Array2 height (widthA ::+ widthB) a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
Array.toStorableVector (Array2 height (widthA ::+ widthB) a -> Array2 height widthA a)
-> Array2 height (widthA ::+ widthB) a -> Array2 height widthA a
forall a b. (a -> b) -> a -> b
$ Array2 height (widthA ::+ widthB) a
a

takeRight ::
   (Shape.C height, Shape.C widthA, Shape.C widthB, Storable a) =>
   Array2 height (widthA::+widthB) a ->
   Array2 height widthB a
takeRight :: forall height widthA widthB a.
(C height, C widthA, C widthB, Storable a) =>
Array2 height (widthA ::+ widthB) a -> Array2 height widthB a
takeRight Array2 height (widthA ::+ widthB) a
a =
   case Array2 height (widthA ::+ widthB) a -> (height, widthA ::+ widthB)
forall sh a. Array sh a -> sh
Array.shape Array2 height (widthA ::+ widthB) a
a of
      (height
height, widthA
widthA::+widthB
widthB) ->
         let m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
             na :: Int
na = widthA -> Int
forall sh. C sh => sh -> Int
Shape.size widthA
widthA
             nb :: Int
nb = widthB -> Int
forall sh. C sh => sh -> Int
Shape.size widthB
widthB
         in (height, widthB)
-> Array (ZeroBased Int) a -> Array2 height widthB a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (height
height, widthB
widthB) (Array (ZeroBased Int) a -> Array2 height widthB a)
-> (Array2 height (widthA ::+ widthB) a -> Array (ZeroBased Int) a)
-> Array2 height (widthA ::+ widthB) a
-> Array2 height widthB a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Array (ZeroBased Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> (Array2 height (widthA ::+ widthB) a -> Vector a)
-> Array2 height (widthA ::+ widthB) a
-> Array (ZeroBased Int) 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)
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Vector a] -> [Vector a]
forall a. Int -> [a] -> [a]
take Int
m ([Vector a] -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a) -> [Vector a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.take Int
nb) ([Vector a] -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> [Vector a])
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Vector a -> Vector a) -> Vector a -> [Vector a]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (Int
naInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nb)) (Vector a -> [Vector a])
-> (Array2 height (widthA ::+ widthB) a -> Vector a)
-> Array2 height (widthA ::+ widthB) a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop Int
na (Vector a -> Vector a)
-> (Array2 height (widthA ::+ widthB) a -> Vector a)
-> Array2 height (widthA ::+ widthB) a
-> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Array2 height (widthA ::+ widthB) a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
Array.toStorableVector (Array2 height (widthA ::+ widthB) a -> Array2 height widthB a)
-> Array2 height (widthA ::+ widthB) a -> Array2 height widthB a
forall a b. (a -> b) -> a -> b
$ Array2 height (widthA ::+ widthB) 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
   Array2.fromBlockArray
      (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 (Array2.fromNonEmptyBlockArray blocked)
   QC.===
   Array2.fromNonEmptyBlockArray
      (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 (Array2.fromNonEmptyBlockArray blocked)
   QC.===
   Array2.fromNonEmptyBlockArray
      (TestBoxedArray.transpose (fmap transpose blocked))
:}
-}
fromNonEmptyBlockArray ::
   (Ord row,    Shape.C height, Eq height) =>
   (Ord column, Shape.C width,  Eq width) =>
   (Storable a) =>
   BoxedArray.Array (Set row, Set column) (Array2 height width a) ->
   Array2 (Map row height) (Map column width) a
fromNonEmptyBlockArray :: 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) (Array2 height width a)
-> Array2 (Map row height) (Map column width) a
fromNonEmptyBlockArray Array (Set row, Set column) (Array2 height width a)
arr =
   let shapes :: [(height, width)]
shapes = (Array2 height width a -> (height, width))
-> [Array2 height width a] -> [(height, width)]
forall a b. (a -> b) -> [a] -> [b]
List.map Array2 height width a -> (height, width)
forall sh a. Array sh a -> sh
Array.shape ([Array2 height width a] -> [(height, width)])
-> [Array2 height width a] -> [(height, width)]
forall a b. (a -> b) -> a -> b
$ Array (Set row, Set column) (Array2 height width a)
-> [Array2 height width a]
forall sh a. C sh => Array sh a -> [a]
BoxedArray.toList Array (Set row, Set column) (Array2 height width a)
arr in
   let width :: Int
width = Set column -> Int
forall a. Set a -> Int
Set.size (Set column -> Int) -> Set column -> Int
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) (Array2 height width a)
-> (Set row, Set column)
forall sh a. Array sh a -> sh
BoxedArray.shape Array (Set row, Set column) (Array2 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) (Array2 height width a)
-> (Set row, Set column)
forall sh a. Array sh a -> sh
BoxedArray.shape Array (Set row, Set column) (Array2 height width a)
arr in
   case (Int -> [(height, width)] -> [(height, width)]
forall a. Int -> [a] -> [a]
ListHT.sieve Int
width [(height, width)]
shapes, Int -> [(height, width)] -> [(height, width)]
forall a. Int -> [a] -> [a]
take Int
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) (Array2 height width a)
-> Array2 (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) (Array2 height width a)
-> Array2 (Map row height) (Map column width) a
fromBlockArray
            ([(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) (Array2 height width a)
arr
      ([(height, width)], [(height, width)])
_ -> String -> String -> Array2 (Map row height) (Map column width) a
forall a. String -> String -> a
errorArray String
"fromNonEmptyBlockArray" 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)) $
   Array2.fromBlockArray
      (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.===
   Array2.fromBlockArray height width
      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)
:}
-}
fromBlockArray ::
   (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) (Array2 height width a) ->
   Array2 (Map row height) (Map column width) a
fromBlockArray :: 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) (Array2 height width a)
-> Array2 (Map row height) (Map column width) a
fromBlockArray Map row height
height Map column width
width =
   (Map row height, Map column width)
-> Array (ZeroBased Int) 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 Int) a
 -> Array (Map row height, Map column width) a)
-> (Array (Set row, Set column) (Array2 height width a)
    -> Array (ZeroBased Int) a)
-> Array (Set row, Set column) (Array2 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 Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> (Array (Set row, Set column) (Array2 height width a)
    -> Vector a)
-> Array (Set row, Set column) (Array2 height width a)
-> Array (ZeroBased Int) 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) (Array2 height width a)
    -> [Vector a])
-> Array (Set row, Set column) (Array2 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) (Array2 height width a)
    -> [[Vector a]])
-> Array (Set row, Set column) (Array2 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) (Array2 height width a)
    -> [[[Vector a]]])
-> Array (Set row, Set column) (Array2 height width a)
-> [[Vector a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> [[Vector a]] -> [[[Vector a]]]
forall a. Int -> [a] -> [[a]]
ListHT.sliceVertical (Map column width -> Int
forall k a. Map k a -> Int
Map.size Map column width
width) ([[Vector a]] -> [[[Vector a]]])
-> (Array (Set row, Set column) (Array2 height width a)
    -> [[Vector a]])
-> Array (Set row, Set column) (Array2 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) (Array2 height width a)
    -> Array (Set row, Set column) [Vector a])
-> Array (Set row, Set column) (Array2 height width a)
-> [[Vector a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((height, width) -> Array2 height width a -> [Vector a])
-> Array (Set row, Set column) (height, width)
-> Array (Set row, Set column) (Array2 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, width) -> Array2 height width a -> [Vector a]
forall sh0 sh1 a.
(C sh0, Eq sh0, C sh1, Eq sh1, Storable a) =>
(sh0, sh1) -> Array (sh0, sh1) a -> [Vector a]
checkSliceBlock
      (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]
-}



class (Shape.C sh) => ShapeSequence sh where
   switchSequence ::
      f Shape.Zero ->
      (forall sh0 shs. (Shape.C sh0, Eq sh0, ShapeSequence shs) =>
         f (sh0::+shs)) ->
      f sh

instance ShapeSequence Shape.Zero where
   switchSequence :: forall (f :: * -> *).
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f Zero
switchSequence f Zero
f forall sh0 shs.
(C sh0, Eq sh0, ShapeSequence shs) =>
f (sh0 ::+ shs)
_ = f Zero
f

instance
   (Shape.C sh, Eq sh, ShapeSequence shs) =>
      ShapeSequence (sh::+shs) where
   switchSequence :: forall (f :: * -> *).
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f (sh ::+ shs)
switchSequence f Zero
_ forall sh0 shs.
(C sh0, Eq sh0, ShapeSequence shs) =>
f (sh0 ::+ shs)
f = f (sh ::+ shs)
forall sh0 shs.
(C sh0, Eq sh0, ShapeSequence shs) =>
f (sh0 ::+ shs)
f


type family BlockFunction heights widths a r
type instance BlockFunction Shape.Zero widths a r = r
type instance BlockFunction (height::+heights) widths a r =
       RowFunction height widths a (BlockFunction heights widths a r)

newtype CreateBig widths a r heights =
   CreateBig {
      forall widths a r heights.
CreateBig widths a r heights
-> heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
getCreateBig ::
         heights -> widths ->
         ([[SV.Vector a]] -> r) ->
         BlockFunction heights widths a r
   }

createBig ::
   (ShapeSequence heights, ShapeSequence widths, Storable a) =>
   heights -> widths ->
   ([[SV.Vector a]] -> r) ->
   BlockFunction heights widths a r
createBig :: forall heights widths a r.
(ShapeSequence heights, ShapeSequence widths, Storable a) =>
heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
createBig =
   CreateBig widths a r heights
-> heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
forall widths a r heights.
CreateBig widths a r heights
-> heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
getCreateBig (CreateBig widths a r heights
 -> heights
 -> widths
 -> ([[Vector a]] -> r)
 -> BlockFunction heights widths a r)
-> CreateBig widths a r heights
-> heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
forall a b. (a -> b) -> a -> b
$
   CreateBig widths a r Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    CreateBig widths a r (sh0 ::+ shs))
-> CreateBig widths a r heights
forall sh (f :: * -> *).
ShapeSequence sh =>
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f sh
forall (f :: * -> *).
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f heights
switchSequence
      ((Zero
 -> widths -> ([[Vector a]] -> r) -> BlockFunction Zero widths a r)
-> CreateBig widths a r Zero
forall widths a r heights.
(heights
 -> widths
 -> ([[Vector a]] -> r)
 -> BlockFunction heights widths a r)
-> CreateBig widths a r heights
CreateBig ((Zero
  -> widths -> ([[Vector a]] -> r) -> BlockFunction Zero widths a r)
 -> CreateBig widths a r Zero)
-> (Zero
    -> widths -> ([[Vector a]] -> r) -> BlockFunction Zero widths a r)
-> CreateBig widths a r Zero
forall a b. (a -> b) -> a -> b
$ \Zero
Shape.Zero widths
_widths [[Vector a]] -> r
cons -> [[Vector a]] -> r
cons [])
      (((sh0 ::+ shs)
 -> widths
 -> ([[Vector a]] -> r)
 -> BlockFunction (sh0 ::+ shs) widths a r)
-> CreateBig widths a r (sh0 ::+ shs)
forall widths a r heights.
(heights
 -> widths
 -> ([[Vector a]] -> r)
 -> BlockFunction heights widths a r)
-> CreateBig widths a r heights
CreateBig (((sh0 ::+ shs)
  -> widths
  -> ([[Vector a]] -> r)
  -> BlockFunction (sh0 ::+ shs) widths a r)
 -> CreateBig widths a r (sh0 ::+ shs))
-> ((sh0 ::+ shs)
    -> widths
    -> ([[Vector a]] -> r)
    -> BlockFunction (sh0 ::+ shs) widths a r)
-> CreateBig widths a r (sh0 ::+ shs)
forall a b. (a -> b) -> a -> b
$ \(sh0
height::+shs
heights) widths
widths [[Vector a]] -> r
cons ->
         shs
-> widths
-> ([[Vector a]] -> r)
-> sh0
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction sh0 widths a (BlockFunction shs widths a r)
forall heightsRem widthsRem height widths a r.
(ShapeSequence heightsRem, ShapeSequence widthsRem, C height,
 Eq height, ShapeSequence widths, Storable a) =>
heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
createBlockRow shs
heights widths
widths [[Vector a]] -> r
cons sh0
height widths
widths [[Vector a]] -> [[Vector a]]
forall a. a -> a
id)


type family RowFunction height widths a r
type instance RowFunction height Shape.Zero a r = r
type instance RowFunction height (width::+widths) a r =
       Array2 height width a -> RowFunction height widths a r

newtype CreateBlockRow heightsRem widthsRem height a r widths =
   CreateBlockRow {
      forall heightsRem widthsRem height a r widths.
CreateBlockRow heightsRem widthsRem height a r widths
-> heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
getCreateBlockRow ::
         heightsRem -> widthsRem -> ([[SV.Vector a]] -> r) ->
         height ->     widths ->    ([[SV.Vector a]] -> [[SV.Vector a]]) ->
         RowFunction height widths a
            (BlockFunction heightsRem widthsRem a r)
   }

createBlockRow ::
   (ShapeSequence heightsRem, ShapeSequence widthsRem) =>
   (Shape.C height, Eq height, ShapeSequence widths, Storable a) =>
   heightsRem -> widthsRem -> ([[SV.Vector a]] -> r) ->
   height ->     widths ->    ([[SV.Vector a]] -> [[SV.Vector a]]) ->
   RowFunction height widths a
      (BlockFunction heightsRem widthsRem a r)
createBlockRow :: forall heightsRem widthsRem height widths a r.
(ShapeSequence heightsRem, ShapeSequence widthsRem, C height,
 Eq height, ShapeSequence widths, Storable a) =>
heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
createBlockRow =
   CreateBlockRow heightsRem widthsRem height a r widths
-> heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
forall heightsRem widthsRem height a r widths.
CreateBlockRow heightsRem widthsRem height a r widths
-> heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
getCreateBlockRow (CreateBlockRow heightsRem widthsRem height a r widths
 -> heightsRem
 -> widthsRem
 -> ([[Vector a]] -> r)
 -> height
 -> widths
 -> ([[Vector a]] -> [[Vector a]])
 -> RowFunction
      height widths a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r widths
-> heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
forall a b. (a -> b) -> a -> b
$
   CreateBlockRow heightsRem widthsRem height a r Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    CreateBlockRow heightsRem widthsRem height a r (sh0 ::+ shs))
-> CreateBlockRow heightsRem widthsRem height a r widths
forall sh (f :: * -> *).
ShapeSequence sh =>
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f sh
forall (f :: * -> *).
f Zero
-> (forall sh0 shs.
    (C sh0, Eq sh0, ShapeSequence shs) =>
    f (sh0 ::+ shs))
-> f widths
switchSequence
      ((heightsRem
 -> widthsRem
 -> ([[Vector a]] -> r)
 -> height
 -> Zero
 -> ([[Vector a]] -> [[Vector a]])
 -> RowFunction
      height Zero a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r Zero
forall heightsRem widthsRem height a r widths.
(heightsRem
 -> widthsRem
 -> ([[Vector a]] -> r)
 -> height
 -> widths
 -> ([[Vector a]] -> [[Vector a]])
 -> RowFunction
      height widths a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r widths
CreateBlockRow ((heightsRem
  -> widthsRem
  -> ([[Vector a]] -> r)
  -> height
  -> Zero
  -> ([[Vector a]] -> [[Vector a]])
  -> RowFunction
       height Zero a (BlockFunction heightsRem widthsRem a r))
 -> CreateBlockRow heightsRem widthsRem height a r Zero)
-> (heightsRem
    -> widthsRem
    -> ([[Vector a]] -> r)
    -> height
    -> Zero
    -> ([[Vector a]] -> [[Vector a]])
    -> RowFunction
         height Zero a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r Zero
forall a b. (a -> b) -> a -> b
$
         \heightsRem
heightsRem widthsRem
widthsRem [[Vector a]] -> r
consBig height
_height Zero
Shape.Zero [[Vector a]] -> [[Vector a]]
consRow ->
            heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> BlockFunction heightsRem widthsRem a r
forall heights widths a r.
(ShapeSequence heights, ShapeSequence widths, Storable a) =>
heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
createBig heightsRem
heightsRem widthsRem
widthsRem
               ([[Vector a]] -> r
consBig ([[Vector a]] -> r)
-> ([[Vector a]] -> [[Vector a]]) -> [[Vector a]] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Vector a]] -> [[Vector a]]
forall a. [[a]] -> [[a]]
List.transpose ([[Vector a]] -> [[Vector a]]
consRow []) [[Vector a]] -> [[Vector a]] -> [[Vector a]]
forall a. [a] -> [a] -> [a]
++)))
      ((heightsRem
 -> widthsRem
 -> ([[Vector a]] -> r)
 -> height
 -> (sh0 ::+ shs)
 -> ([[Vector a]] -> [[Vector a]])
 -> RowFunction
      height (sh0 ::+ shs) a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r (sh0 ::+ shs)
forall heightsRem widthsRem height a r widths.
(heightsRem
 -> widthsRem
 -> ([[Vector a]] -> r)
 -> height
 -> widths
 -> ([[Vector a]] -> [[Vector a]])
 -> RowFunction
      height widths a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r widths
CreateBlockRow ((heightsRem
  -> widthsRem
  -> ([[Vector a]] -> r)
  -> height
  -> (sh0 ::+ shs)
  -> ([[Vector a]] -> [[Vector a]])
  -> RowFunction
       height (sh0 ::+ shs) a (BlockFunction heightsRem widthsRem a r))
 -> CreateBlockRow heightsRem widthsRem height a r (sh0 ::+ shs))
-> (heightsRem
    -> widthsRem
    -> ([[Vector a]] -> r)
    -> height
    -> (sh0 ::+ shs)
    -> ([[Vector a]] -> [[Vector a]])
    -> RowFunction
         height (sh0 ::+ shs) a (BlockFunction heightsRem widthsRem a r))
-> CreateBlockRow heightsRem widthsRem height a r (sh0 ::+ shs)
forall a b. (a -> b) -> a -> b
$
         \heightsRem
heightsRem widthsRem
widthsRem [[Vector a]] -> r
consBig height
height (sh0
width::+shs
widths) [[Vector a]] -> [[Vector a]]
consRow Array (height, sh0) a
blk ->
            heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> shs
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height shs a (BlockFunction heightsRem widthsRem a r)
forall heightsRem widthsRem height widths a r.
(ShapeSequence heightsRem, ShapeSequence widthsRem, C height,
 Eq height, ShapeSequence widths, Storable a) =>
heightsRem
-> widthsRem
-> ([[Vector a]] -> r)
-> height
-> widths
-> ([[Vector a]] -> [[Vector a]])
-> RowFunction
     height widths a (BlockFunction heightsRem widthsRem a r)
createBlockRow
               heightsRem
heightsRem widthsRem
widthsRem [[Vector a]] -> r
consBig
               height
height shs
widths
                  ([[Vector a]] -> [[Vector a]]
consRow ([[Vector a]] -> [[Vector a]])
-> ([[Vector a]] -> [[Vector a]]) -> [[Vector a]] -> [[Vector a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((height, sh0) -> Array (height, sh0) a -> [Vector a]
forall sh0 sh1 a.
(C sh0, Eq sh0, C sh1, Eq sh1, Storable a) =>
(sh0, sh1) -> Array (sh0, sh1) a -> [Vector a]
checkSliceBlock (height
height,sh0
width) Array (height, sh0) a
blk [Vector a] -> [[Vector a]] -> [[Vector a]]
forall a. a -> [a] -> [a]
:)))


{- |
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
   let shapeR = shapeR0::+shapeR1::+Shape.Zero in
   let shapeC = shapeC0::+shapeC1::+Shape.Zero 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

   Array.reshape (shapeR, shapeC)
      (Array2.fromNonEmptyBlockArray blocked)
   QC.===
   Array2.fromBlocks shapeR shapeC Proxy
      blockA1 blockA2
      blockB1 blockB2
:}
-}
fromBlocks ::
   (ShapeSequence height, ShapeSequence width, Storable a) =>
   height -> width -> Proxy a ->
   BlockFunction height width a (Array2 height width a)
fromBlocks :: forall height width a.
(ShapeSequence height, ShapeSequence width, Storable a) =>
height
-> width
-> Proxy a
-> BlockFunction height width a (Array2 height width a)
fromBlocks height
height width
width Proxy a
proxy =
   height
-> width
-> ([[Vector a]] -> Array (height, width) a)
-> BlockFunction height width a (Array (height, width) a)
forall heights widths a r.
(ShapeSequence heights, ShapeSequence widths, Storable a) =>
heights
-> widths
-> ([[Vector a]] -> r)
-> BlockFunction heights widths a r
createBig height
height width
width
      ((height, width)
-> Array (ZeroBased Int) a -> Array (height, width) a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (height
height, width
width) (Array (ZeroBased Int) a -> Array (height, width) a)
-> ([[Vector a]] -> Array (ZeroBased Int) a)
-> [[Vector a]]
-> Array (height, width) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Array (ZeroBased Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> ([[Vector a]] -> Vector a)
-> [[Vector a]]
-> Array (ZeroBased Int) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       Proxy a -> Vector a -> Vector a
forall a. Proxy a -> Vector a -> Vector a
idSV Proxy a
proxy (Vector a -> Vector a)
-> ([[Vector a]] -> Vector a) -> [[Vector a]] -> Vector 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)
-> ([[Vector a]] -> [Vector a]) -> [[Vector 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)

idSV :: Proxy a -> SV.Vector a -> SV.Vector a
idSV :: forall a. Proxy a -> Vector a -> Vector a
idSV Proxy a
Proxy = Vector a -> Vector a
forall a. a -> a
id



data BlockArray shape a = BlockArray shape [[SV.Vector a]]
type BlockMatrix height width = BlockArray (height, width)

block ::
   (Block block, Shape.C height, Shape.C width, Storable a) =>
   block (height, width) a -> BlockMatrix height width a
block :: forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
block = block (height, width) a -> BlockMatrix height width a
forall height width a.
(C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
blockPrivate

class Block block where
   blockPrivate ::
      (Shape.C height, Shape.C width, Storable a) =>
      block (height, width) a -> BlockMatrix height width a

instance Block BlockArray where
   blockPrivate :: forall height width a.
(C height, C width, Storable a) =>
BlockMatrix height width a -> BlockMatrix height width a
blockPrivate = BlockArray (height, width) a -> BlockArray (height, width) a
forall a. a -> a
id

instance Block Array where
   blockPrivate :: forall height width a.
(C height, C width, Storable a) =>
Array (height, width) a -> BlockMatrix height width a
blockPrivate Array (height, width) a
arr =
      (height, width) -> [[Vector a]] -> BlockArray (height, width) a
forall shape a. shape -> [[Vector a]] -> BlockArray shape a
BlockArray (Array (height, width) a -> (height, width)
forall sh a. Array sh a -> sh
Array.shape Array (height, width) a
arr)
         ((Vector a -> [Vector a]) -> [Vector a] -> [[Vector a]]
forall a b. (a -> b) -> [a] -> [b]
map (Vector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
:[]) ([Vector a] -> [[Vector a]]) -> [Vector a] -> [[Vector a]]
forall a b. (a -> b) -> a -> b
$ Int -> [Vector a] -> [Vector a]
forall a. Int -> [a] -> [a]
take (height -> Int
forall sh. C sh => sh -> Int
Shape.size (height -> Int) -> height -> Int
forall a b. (a -> b) -> a -> b
$ (height, width) -> height
forall a b. (a, b) -> a
fst ((height, width) -> height) -> (height, width) -> height
forall a b. (a -> b) -> a -> b
$ Array (height, width) a -> (height, width)
forall sh a. Array sh a -> sh
Array.shape Array (height, width) a
arr) ([Vector a] -> [Vector a]) -> [Vector a] -> [Vector a]
forall a b. (a -> b) -> a -> b
$
         Array (height, width) a -> [Vector a]
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlicesInf Array (height, width) a
arr)

blockAbove ::
   (Eq width) =>
   BlockMatrix heightA width a -> BlockMatrix heightB width a ->
   BlockMatrix (heightA::+heightB) width a
blockAbove :: forall width heightA a heightB.
Eq width =>
BlockMatrix heightA width a
-> BlockMatrix heightB width a
-> BlockMatrix (heightA ::+ heightB) width a
blockAbove (BlockArray (heightA
heightA,width
widthA) [[Vector a]]
a) (BlockArray (heightB
heightB,width
widthB) [[Vector a]]
b) =
   (heightA ::+ heightB, width)
-> [[Vector a]] -> BlockArray (heightA ::+ heightB, width) a
forall shape a. shape -> [[Vector a]] -> BlockArray shape a
BlockArray
      (if width
widthA width -> width -> Bool
forall a. Eq a => a -> a -> Bool
== width
widthB
         then (heightA
heightAheightA -> heightB -> heightA ::+ heightB
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+heightB
heightB, width
widthA)
         else String -> (heightA ::+ heightB, width)
forall a. HasCallStack => String -> a
error String
"Array.Dim2.blockAbove: widths mismatch")
      ([[Vector a]]
a [[Vector a]] -> [[Vector a]] -> [[Vector a]]
forall a. [a] -> [a] -> [a]
++ [[Vector a]]
b)

blockBeside ::
   (Eq height) =>
   BlockMatrix height widthA a -> BlockMatrix height widthB a ->
   BlockMatrix height (widthA::+widthB) a
blockBeside :: forall height widthA a widthB.
Eq height =>
BlockMatrix height widthA a
-> BlockMatrix height widthB a
-> BlockMatrix height (widthA ::+ widthB) a
blockBeside (BlockArray (height
heightA,widthA
widthA) [[Vector a]]
a) (BlockArray (height
heightB,widthB
widthB) [[Vector a]]
b) =
   (height, widthA ::+ widthB)
-> [[Vector a]] -> BlockArray (height, widthA ::+ widthB) a
forall shape a. shape -> [[Vector a]] -> BlockArray shape a
BlockArray
      (if height
heightA height -> height -> Bool
forall a. Eq a => a -> a -> Bool
== height
heightB
         then (height
heightA, widthA
widthAwidthA -> widthB -> widthA ::+ widthB
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+widthB
widthB)
         else String -> (height, widthA ::+ widthB)
forall a. HasCallStack => String -> a
error String
"Array.Dim2.beside: heights mismatch")
      (([Vector a] -> [Vector a] -> [Vector a])
-> [[Vector a]] -> [[Vector a]] -> [[Vector a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Vector a] -> [Vector a] -> [Vector a]
forall a. [a] -> [a] -> [a]
(++) [[Vector a]]
a [[Vector a]]
b)

infixr 2 &===
infixr 3 &|||

(&===) ::
   (Block blockA, Block blockB) =>
   (Shape.C heightA, Shape.C heightB) =>
   (Shape.C width, Eq width) =>
   (Storable a) =>
   blockA (heightA,width) a -> blockB (heightB,width) a ->
   BlockMatrix (heightA::+heightB) width a
&=== :: forall (blockA :: * -> * -> *) (blockB :: * -> * -> *) heightA
       heightB width a.
(Block blockA, Block blockB, C heightA, C heightB, C width,
 Eq width, Storable a) =>
blockA (heightA, width) a
-> blockB (heightB, width) a
-> BlockMatrix (heightA ::+ heightB) width a
(&===) blockA (heightA, width) a
a blockB (heightB, width) a
b = BlockMatrix heightA width a
-> BlockMatrix heightB width a
-> BlockMatrix (heightA ::+ heightB) width a
forall width heightA a heightB.
Eq width =>
BlockMatrix heightA width a
-> BlockMatrix heightB width a
-> BlockMatrix (heightA ::+ heightB) width a
blockAbove (blockA (heightA, width) a -> BlockMatrix heightA width a
forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
block blockA (heightA, width) a
a) (blockB (heightB, width) a -> BlockMatrix heightB width a
forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
block blockB (heightB, width) a
b)

(&|||) ::
   (Block blockA, Block blockB) =>
   (Shape.C height, Eq height) =>
   (Shape.C widthA, Shape.C widthB) =>
   (Storable a) =>
   blockA (height,widthA) a -> blockB (height,widthB) a ->
   BlockMatrix height (widthA::+widthB) a
&||| :: forall (blockA :: * -> * -> *) (blockB :: * -> * -> *) height
       widthA widthB a.
(Block blockA, Block blockB, C height, Eq height, C widthA,
 C widthB, Storable a) =>
blockA (height, widthA) a
-> blockB (height, widthB) a
-> BlockMatrix height (widthA ::+ widthB) a
(&|||) blockA (height, widthA) a
a blockB (height, widthB) a
b = BlockMatrix height widthA a
-> BlockMatrix height widthB a
-> BlockMatrix height (widthA ::+ widthB) a
forall height widthA a widthB.
Eq height =>
BlockMatrix height widthA a
-> BlockMatrix height widthB a
-> BlockMatrix height (widthA ::+ widthB) a
blockBeside (blockA (height, widthA) a -> BlockMatrix height widthA a
forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
block blockA (height, widthA) a
a) (blockB (height, widthB) a -> BlockMatrix height widthB a
forall (block :: * -> * -> *) height width a.
(Block block, C height, C width, Storable a) =>
block (height, width) a -> BlockMatrix height width a
block blockB (height, widthB) a
b)



{- |
prop> :{
   QC.forAll genArray2 $ \blockA1 ->
   QC.forAll genArray2 $ \blockB3 ->
   QC.forAll
      (liftA2
         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))
         (QC.choose ('a','k')) (QC.choose ('a','k'))) $
      \shapeC1 ->
   let shapeR0 = fst $ Array.shape blockA1 in
   let shapeC0 = snd $ Array.shape blockA1 in
   let shapeR1 = fst $ Array.shape blockB3 in
   let shapeC2 = snd $ Array.shape blockB3 in
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->

   Array2.fromBlockMatrix
      (blockA1 &||| Array2.beside blockA2 blockA3
       &===
       blockB1 &||| blockB2 &||| blockB3)
   QC.===
   Array.reshape
      (shapeR0::+shapeR1, shapeC0::+shapeC1::+shapeC2)
      (Array2.fromBlocks
         (shapeR0::+shapeR1::+Shape.Zero)
         (shapeC0::+shapeC1::+shapeC2::+Shape.Zero)
         Proxy
         blockA1 blockA2 blockA3
         blockB1 blockB2 blockB3)
:}

prop> :{
   QC.forAll
      (liftA2
         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))
         (QC.choose ('a','k')) (QC.choose ('a','k'))) $
      \shapeR0 ->
   QC.forAll
         (liftA2 Shape.Shifted (QC.choose (-10,10)) (QC.choose (0,10::Int))) $
      \shapeR1 ->
   let shapeR2 = () in
   QC.forAll (fmap Shape.ZeroBased (QC.choose (0,10::Int))) $
      \shapeC0 ->
   QC.forAll (fmap Shape.OneBased (QC.choose (0,10::Int))) $
      \shapeC1 ->
   let shapeC2 :: Shape.Enumeration Ordering
       shapeC2 = Shape.Enumeration in

   QC.forAll (genArrayForShape (shapeR0, shapeC0)) $ \blockA1 ->
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC2)) $ \blockC3 ->

   Array2.fromBlockMatrix
      (blockA1 &||| blockA2 &||| blockA3
       &===
       blockB1 &||| blockB2 &||| blockB3
       &===
       blockC1 &||| blockC2 &||| blockC3)
   QC.===
   Array2.beside
      (Array2.above blockA1 $ Array2.above blockB1 blockC1)
      (Array2.above
         (Array2.beside blockA2 blockA3)
         (Array2.beside
            (Array2.above blockB2 blockC2)
            (Array2.above blockB3 blockC3)))
:}
-}
fromBlockMatrix ::
   (Shape.C height, Shape.C width, Storable a) =>
   BlockMatrix height width a -> Array2 height width a
fromBlockMatrix :: forall height width a.
(C height, C width, Storable a) =>
BlockMatrix height width a -> Array2 height width a
fromBlockMatrix (BlockArray (height
height, width
width) [[Vector a]]
rows) =
   (height, width)
-> Array (ZeroBased Int) a -> Array (height, width) a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape (height
height, width
width) (Array (ZeroBased Int) a -> Array (height, width) a)
-> ([[Vector a]] -> Array (ZeroBased Int) a)
-> [[Vector a]]
-> Array (height, width) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Vector a -> Array (ZeroBased Int) a
forall a. Storable a => Vector a -> Array (ZeroBased Int) a
Array.fromStorableVector (Vector a -> Array (ZeroBased Int) a)
-> ([[Vector a]] -> Vector a)
-> [[Vector a]]
-> Array (ZeroBased Int) 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)
-> ([[Vector a]] -> [Vector a]) -> [[Vector 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]] -> Array (height, width) a)
-> [[Vector a]] -> Array (height, width) a
forall a b. (a -> b) -> a -> b
$ [[Vector a]]
rows


checkSliceBlock ::
   (Shape.C sh0, Eq sh0, Shape.C sh1, Eq sh1, Storable a) =>
   (sh0, sh1) -> Array (sh0, sh1) a -> [SV.Vector a]
checkSliceBlock :: forall sh0 sh1 a.
(C sh0, Eq sh0, C sh1, Eq sh1, Storable a) =>
(sh0, sh1) -> Array (sh0, sh1) a -> [Vector a]
checkSliceBlock (sh0, sh1)
sh Array (sh0, sh1) a
blk =
   if (sh0, sh1)
sh (sh0, sh1) -> (sh0, sh1) -> Bool
forall a. Eq a => a -> a -> Bool
== Array (sh0, sh1) a -> (sh0, sh1)
forall sh a. Array sh a -> sh
Array.shape Array (sh0, sh1) a
blk
      then Array (sh0, sh1) a -> [Vector a]
forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlices Array (sh0, sh1) a
blk
      else String -> String -> [Vector a]
forall a. String -> String -> a
errorArray String
"fromBlockArray" String
"block shapes mismatch"

toRowSlices ::
   (Shape.C sh0, Shape.C sh1, Storable a) =>
   Array2 sh0 sh1 a -> [SV.Vector a]
toRowSlices :: forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlices Array2 sh0 sh1 a
arr =
   Int -> Vector a -> [Vector a]
forall a. Storable a => Int -> Vector a -> [Vector a]
SV.sliceVertical (sh1 -> Int
forall sh. C sh => sh -> Int
Shape.size (sh1 -> Int) -> sh1 -> Int
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
$ Array2 sh0 sh1 a -> (sh0, sh1)
forall sh a. Array sh a -> sh
Array.shape Array2 sh0 sh1 a
arr) (Vector a -> [Vector a]) -> Vector a -> [Vector a]
forall a b. (a -> b) -> a -> b
$
   Array2 sh0 sh1 a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
Array.toStorableVector Array2 sh0 sh1 a
arr

toRowSlicesInf ::
   (Shape.C sh0, Shape.C sh1, Storable a) =>
   Array2 sh0 sh1 a -> [SV.Vector a]
toRowSlicesInf :: forall sh0 sh1 a.
(C sh0, C sh1, Storable a) =>
Array2 sh0 sh1 a -> [Vector a]
toRowSlicesInf Array2 sh0 sh1 a
arr =
   let n :: Int
n = sh1 -> Int
forall sh. C sh => sh -> Int
Shape.size (sh1 -> Int) -> sh1 -> Int
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
$ Array2 sh0 sh1 a -> (sh0, sh1)
forall sh a. Array sh a -> sh
Array.shape Array2 sh0 sh1 a
arr in
   (Vector a -> Vector a) -> [Vector a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.take Int
n) ([Vector a] -> [Vector a])
-> (Array2 sh0 sh1 a -> [Vector a])
-> Array2 sh0 sh1 a
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a) -> Vector a -> [Vector a]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop Int
n) (Vector a -> [Vector a])
-> (Array2 sh0 sh1 a -> Vector a) -> Array2 sh0 sh1 a -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array2 sh0 sh1 a -> Vector a
forall sh a. (C sh, Storable a) => Array sh a -> Vector a
Array.toStorableVector (Array2 sh0 sh1 a -> [Vector a]) -> Array2 sh0 sh1 a -> [Vector a]
forall a b. (a -> b) -> a -> b
$ Array2 sh0 sh1 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.Dim2." 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)