{-# 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))
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
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
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`
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
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
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"
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))
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]
:)))
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)
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)