-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Atom.Skel.Vector.Cube
-- Copyright   :  (c) George Ungureanu, KTH/EECS/ESY 2019-2020
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module exports an alias 'Cube' and a couple of patterns and utilities to work
-- with data cubes constructed as 3D vectors. Since names might overlap, this library
-- is recommended to be imported qualified.
-----------------------------------------------------------------------------
module ForSyDe.Atom.Skel.Vector.Cube where

import ForSyDe.Atom.Skel.Vector (Vector(..), vector, fromVector, (<++>))
import ForSyDe.Atom.Skel.Vector.Matrix (Matrix, matrix, fromMatrix)

import qualified Data.List as L
import qualified ForSyDe.Atom.Skel.Vector as V
import qualified ForSyDe.Atom.Skel.Vector.Matrix as M

-- | 'Cube' is a type synonym for vector of vectors. This means that /any/ function on
-- 'Vector' works also on 'Cube'.
type Cube a = Vector (Vector (Vector a))

-- | Prints out to the terminal a cube in a readable format, where
-- all elements are right-aligned and separated by a custom separator.
--
-- >>> let m = cube 2 2 2 [1,2,3,3,100,4,12,32]
-- >>> pretty "|" m
-- --------
-- 1|2
-- 3|3
-- --------
-- 100| 4
--  12|32
-- --------
pretty :: Show a
       => String   -- ^ separator string
       -> Cube a -- ^ input cube
       -> IO ()
pretty :: String -> Cube a -> IO ()
pretty sep :: String
sep mat :: Cube a
mat = (Matrix a -> IO ()) -> Cube a -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\m :: Matrix a
m -> String -> IO ()
putStrLn "--------" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Matrix a -> IO ()
forall a. Show a => String -> Matrix a -> IO ()
M.pretty String
sep Matrix a
m) Cube a
mat IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn "--------"

-- | Checks if a cube is null. @<>@, @<<>>@ and @<<<>>>@ are all null
-- cubes.
isNull :: Cube a -> Bool
isNull :: Cube a -> Bool
isNull Null = Bool
True
isNull (Null:>Null) = Bool
True
isNull (Null:>Null:>Null) = Bool
True
isNull _ = Bool
False

-- | Returns the X and Y dimensions of cube and checks if it is well formed.
size :: Cube a -> (Int,Int,Int)
size :: Cube a -> (Int, Int, Int)
size m :: Cube a
m = (Int
x,Int
y,Int
z)
  where
    z :: Int
z = Cube a -> Int
forall p a. Num p => Vector a -> p
V.length (Cube a -> Cube a
forall a. Cube a -> Cube a
wellFormed Cube a
m)
    y :: Int
y = (Vector (Vector a) -> Int
forall p a. Num p => Vector a -> p
V.length (Vector (Vector a) -> Int)
-> (Cube a -> Vector (Vector a)) -> Cube a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cube a -> Vector (Vector a)
forall a. Vector a -> a
V.first) Cube a
m
    x :: Int
x = (Vector a -> Int
forall p a. Num p => Vector a -> p
V.length (Vector a -> Int) -> (Cube a -> Vector a) -> Cube a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Vector a) -> Vector a
forall a. Vector a -> a
V.first (Vector (Vector a) -> Vector a)
-> (Cube a -> Vector (Vector a)) -> Cube a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cube a -> Vector (Vector a)
forall a. Vector a -> a
V.first) Cube a
m

-- | Checks if a cube is well-formed, meaning that all its rows are of equal
-- length. Returns the same cube in case it is well-formed or throws an exception if
-- it is ill-formed.
wellFormed :: Cube a -> Cube a
wellFormed :: Cube a -> Cube a
wellFormed Null = Cube a
forall a. Vector a
Null
wellFormed (x :: Vector (Vector a)
x:>xs :: Cube a
xs) = Vector (Vector a) -> Vector (Vector a)
forall a. Matrix a -> Matrix a
M.wellFormed Vector (Vector a)
x Vector (Vector a) -> Cube a -> Cube a
forall a. a -> Vector a -> Vector a
:> Cube a -> Cube a
forall a. Cube a -> Cube a
wellFormed Cube a
xs

-- | Converts a list into a 'Cube'. See example from 'pretty'.
cube :: Int      -- ^ number of columns (X dimension) @= x@
     -> Int      -- ^ number of rows (Y dimension) @= y@
     -> Int      -- ^ depth (Z dimension) @= z@
     -> [a]      -- ^ list of values; /length/ = @x * y * z@
     -> Cube a -- ^ 'Cube' of values; /size/ = @(x,y,z)@
cube :: Int -> Int -> Int -> [a] -> Cube a
cube x :: Int
x y :: Int
y z :: Int
z = [Matrix a] -> Cube a
forall a. [a] -> Vector a
vector ([Matrix a] -> Cube a) -> ([a] -> [Matrix a]) -> [a] -> Cube a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Matrix a) -> [[a]] -> [Matrix a]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Int -> Int -> [a] -> Matrix a
forall a. Int -> Int -> [a] -> Matrix a
matrix Int
x Int
y) ([[a]] -> [Matrix a]) -> ([a] -> [[a]]) -> [a] -> [Matrix a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
groupEvery (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> t a
check
  where
    check :: t a -> t a
check l :: t a
l | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
z = t a
l
            | Bool
otherwise
      = String -> t a
forall a. HasCallStack => String -> a
error (String -> t a) -> String -> t a
forall a b. (a -> b) -> a -> b
$ "cannot form cube (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ","
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ "," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
z String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") from a list with "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " elements"
    groupEvery :: Int -> [a] -> [[a]]
    groupEvery :: Int -> [a] -> [[a]]
groupEvery _ [] = []
    groupEvery n :: Int
n l :: [a]
l
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0        = String -> [[a]]
forall a. HasCallStack => String -> a
error (String -> [[a]]) -> String -> [[a]]
forall a b. (a -> b) -> a -> b
$ "matrix: cannot group list by negative n: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
      | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = String -> [[a]]
forall a. HasCallStack => String -> a
error "matrix: input list cannot be split into all-equal parts"
      | Bool
otherwise    = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
n [a]
l [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
groupEvery Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop Int
n [a]
l)

-- | Converts a cube back to a list.
fromCube :: Cube a -- ^ /size/ = @(x,y)@
         -> [a]      -- ^ /length/ = @x * y@
fromCube :: Cube a -> [a]
fromCube = (Vector a -> [a]) -> [Vector a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Vector a -> [a]
forall a. Vector a -> [a]
fromVector ([Vector a] -> [a]) -> (Cube a -> [Vector a]) -> Cube a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cube a -> [Vector a]
forall a. Matrix a -> [a]
fromMatrix

-- | Creates a unit (i.e. singleton) cube, which is a cube with only one element.
unit :: a -> Cube a -- ^ /size/ = @(1,1)@
unit :: a -> Cube a
unit a :: a
a = ((a
aa -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:>Vector a
forall a. Vector a
Null)Vector a -> Vector (Vector a) -> Vector (Vector a)
forall a. a -> Vector a -> Vector a
:>Vector (Vector a)
forall a. Vector a
Null)Vector (Vector a) -> Cube a -> Cube a
forall a. a -> Vector a -> Vector a
:>Cube a
forall a. Vector a
Null

-- | Creates an /infinite cube/ which repeats one element
fanout :: a -> Cube a
fanout :: a -> Cube a
fanout n :: a
n = Vector (Vector a) -> Cube a
forall t. t -> Vector t
V.fanout (Vector (Vector a) -> Cube a) -> Vector (Vector a) -> Cube a
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector (Vector a)
forall t. t -> Vector t
V.fanout (Vector a -> Vector (Vector a)) -> Vector a -> Vector (Vector a)
forall a b. (a -> b) -> a -> b
$ a -> Vector a
forall t. t -> Vector t
V.fanout a
n

-- | Returns an /infinite cube/ with (X,Y) index pairs. You need to zip it against
-- another (finite) cube or to extract a finite subset in order to be useful (see
-- example below).
--
-- >>> pretty " " $ take 3 4 2 indexes 
-- (0,0) (1,0) (2,0)
-- (0,1) (1,1) (2,1)
-- (0,2) (1,2) (2,2)
-- (0,3) (1,3) (2,3)
indexes :: Cube (Int, Int, Int)
indexes :: Cube (Int, Int, Int)
indexes = (Int -> Int -> Int -> (Int, Int, Int))
-> Cube Int -> Cube Int -> Cube Int -> Cube (Int, Int, Int)
forall a b c d.
(a -> b -> c -> d) -> Cube a -> Cube b -> Cube c -> Cube d
farm31 (,,) Cube Int
colix Cube Int
rowix Cube Int
depthix
  where
    colix :: Cube Int
colix = [Vector (Vector Int)] -> Cube Int
forall a. [a] -> Vector a
vector ([Vector (Vector Int)] -> Cube Int)
-> [Vector (Vector Int)] -> Cube Int
forall a b. (a -> b) -> a -> b
$ Vector (Vector Int) -> [Vector (Vector Int)]
forall a. a -> [a]
repeat (Vector (Vector Int) -> [Vector (Vector Int)])
-> Vector (Vector Int) -> [Vector (Vector Int)]
forall a b. (a -> b) -> a -> b
$ [Vector Int] -> Vector (Vector Int)
forall a. [a] -> Vector a
vector ([Vector Int] -> Vector (Vector Int))
-> [Vector Int] -> Vector (Vector Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> [Vector Int]
forall a. a -> [a]
repeat (Vector Int -> [Vector Int]) -> Vector Int -> [Vector Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> Vector Int
forall a. [a] -> Vector a
vector [0..]
    rowix :: Cube Int
rowix = (Vector (Vector Int) -> Vector (Vector Int))
-> Cube Int -> Cube Int
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 Vector (Vector Int) -> Vector (Vector Int)
forall a. Matrix a -> Matrix a
M.transpose Cube Int
colix
    depthix :: Cube Int
depthix =  Cube Int -> Cube Int
forall a. Matrix a -> Matrix a
M.transpose (Cube Int -> Cube Int) -> Cube Int -> Cube Int
forall a b. (a -> b) -> a -> b
$ (Vector (Vector Int) -> Vector (Vector Int))
-> Cube Int -> Cube Int
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 Vector (Vector Int) -> Vector (Vector Int)
forall a. Matrix a -> Matrix a
M.transpose Cube Int
colix

-- | Transposes a cube from @(Z,Y,X)@ to @(Y,X,Z)@.
transpose :: Cube a -- ^ dimensions @(Z,Y,X)@
           -> Cube a -- ^ dimensions @(Y,X,Z)@
transpose :: Cube a -> Cube a
transpose = (Matrix a -> Matrix a) -> Cube a -> Cube a
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 Matrix a -> Matrix a
forall a. Matrix a -> Matrix a
M.transpose (Cube a -> Cube a) -> (Cube a -> Cube a) -> Cube a -> Cube a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cube a -> Cube a
forall a. Matrix a -> Matrix a
M.transpose

-- | Transposes a cube from @(Z,Y,X)@ to @(Z,Y,X)@.
transpose' :: Cube a -- ^ dimensions @(Y,X,Z)@
            -> Cube a -- ^ dimensions @(Z,Y,X)@
transpose' :: Cube a -> Cube a
transpose' = Cube a -> Cube a
forall a. Matrix a -> Matrix a
M.transpose (Cube a -> Cube a) -> (Cube a -> Cube a) -> Cube a -> Cube a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix a -> Matrix a) -> Cube a -> Cube a
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 Matrix a -> Matrix a
forall a. Matrix a -> Matrix a
M.transpose

-- | Maps a function on every value of a cube.
--
-- __OBS:__ this function does not check if the output cube is well-formed.
farm11 :: (a -> b)
       -> Cube a -- ^ /size/ = @(xa,ya)@
       -> Cube b -- ^ /size/ = @(xa,ya)@
farm11 :: (a -> b) -> Cube a -> Cube b
farm11 = (Vector (Vector a) -> Vector (Vector b)) -> Cube a -> Cube b
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 ((Vector (Vector a) -> Vector (Vector b)) -> Cube a -> Cube b)
-> ((a -> b) -> Vector (Vector a) -> Vector (Vector b))
-> (a -> b)
-> Cube a
-> Cube b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector b) -> Vector (Vector a) -> Vector (Vector b)
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 ((Vector a -> Vector b) -> Vector (Vector a) -> Vector (Vector b))
-> ((a -> b) -> Vector a -> Vector b)
-> (a -> b)
-> Vector (Vector a)
-> Vector (Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Vector a -> Vector b
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11

-- | Applies a binary function pair-wise on each element in two matrices.
--
-- __OBS:__ this function does not check if the output cube is well-formed.
farm21 :: (a -> b -> c)
           -> Cube a -- ^ /size/ = @(xa,ya)@
           -> Cube b -- ^ /size/ = @(xb,yb)@
           -> Cube c -- ^ /size/ = @(minimum [xa,xb], minimum [ya,yb])@
farm21 :: (a -> b -> c) -> Cube a -> Cube b -> Cube c
farm21 f :: a -> b -> c
f = (Vector (Vector a) -> Vector (Vector b) -> Vector (Vector c))
-> Cube a -> Cube b -> Cube c
forall a1 a2 b1.
(a1 -> a2 -> b1) -> Vector a1 -> Vector a2 -> Vector b1
V.farm21 ((Vector a -> Vector b -> Vector c)
-> Vector (Vector a) -> Vector (Vector b) -> Vector (Vector c)
forall a1 a2 b1.
(a1 -> a2 -> b1) -> Vector a1 -> Vector a2 -> Vector b1
V.farm21 ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a1 a2 b1.
(a1 -> a2 -> b1) -> Vector a1 -> Vector a2 -> Vector b1
V.farm21 a -> b -> c
f))

-- | Applies a function 3-tuple-wise on each element in three matrices.
--
-- __OBS:__ this function does not check if the output cube is well-formed.
farm31 :: (a -> b -> c -> d)
            -> Cube a -- ^ /size/ = @(xa,ya)@
            -> Cube b -- ^ /size/ = @(xb,yb)@
            -> Cube c -- ^ /size/ = @(xc,yc)@
            -> Cube d -- ^ /size/ = @(minimum [xa,xb,xc], minimum [ya,yb,yc])@
farm31 :: (a -> b -> c -> d) -> Cube a -> Cube b -> Cube c -> Cube d
farm31 f :: a -> b -> c -> d
f = (Vector (Vector a)
 -> Vector (Vector b) -> Vector (Vector c) -> Vector (Vector d))
-> Cube a -> Cube b -> Cube c -> Cube d
forall a1 a2 a3 b1.
(a1 -> a2 -> a3 -> b1)
-> Vector a1 -> Vector a2 -> Vector a3 -> Vector b1
V.farm31 ((Vector a -> Vector b -> Vector c -> Vector d)
-> Vector (Vector a)
-> Vector (Vector b)
-> Vector (Vector c)
-> Vector (Vector d)
forall a1 a2 a3 b1.
(a1 -> a2 -> a3 -> b1)
-> Vector a1 -> Vector a2 -> Vector a3 -> Vector b1
V.farm31 ((a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
forall a1 a2 a3 b1.
(a1 -> a2 -> a3 -> b1)
-> Vector a1 -> Vector a2 -> Vector a3 -> Vector b1
V.farm31 a -> b -> c -> d
f))

-- | Reduces all the elements of a cube to one element based on a
-- binary function.
--
-- >>> let m = cube 3 3 [1,2,3,11,12,13,21,22,23]
-- >>> reduce (+) m
-- 108
reduce :: (a -> a -> a) -> Cube a -> a
reduce :: (a -> a -> a) -> Cube a -> a
reduce f :: a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.reduce a -> a -> a
f (Vector a -> a) -> (Cube a -> Vector a) -> Cube a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix a -> a) -> Cube a -> Vector a
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 ((a -> a -> a) -> Matrix a -> a
forall a. (a -> a -> a) -> Matrix a -> a
M.reduce a -> a -> a
f)

-- | Returns the element of a matrix at a certain position.
--
-- >>> let m = matrix 3 3 [1,2,3,11,12,13,21,22,23]
-- >>> at 2 1 m
-- 13
get :: Int       -- ^ X index starting from zero
    -> Int       -- ^ Y index starting from zero
    -> Int       -- ^ Z index starting from zero
    -> Cube a
    -> Maybe a
get :: Int -> Int -> Int -> Cube a -> Maybe a
get x :: Int
x y :: Int
y z :: Int
z = Maybe (Matrix a) -> Maybe a
forall a. Maybe (Matrix a) -> Maybe a
getMaybe (Maybe (Matrix a) -> Maybe a)
-> (Cube a -> Maybe (Matrix a)) -> Cube a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Cube a -> Maybe (Matrix a)
forall a. Int -> Vector a -> Maybe a
V.get Int
z
  where getMaybe :: Maybe (Matrix a) -> Maybe a
getMaybe Nothing = Maybe a
forall a. Maybe a
Nothing
        getMaybe (Just a :: Matrix a
a) = Int -> Int -> Matrix a -> Maybe a
forall a. Int -> Int -> Matrix a -> Maybe a
M.get Int
x Int
y Matrix a
a

-- | Returns the upper-left part of a matrix until a specific
-- position.
--
-- >>> let m = matrix 4 4 [1,2,3,4,11,12,13,14,21,22,23,24,31,32,33,34]
-- >>> pretty " " $ take 2 2 m
--  1  2
-- 11 12
take :: Int       -- ^ X index starting from zero
     -> Int       -- ^ Y index starting from zero
     -> Int       -- ^ > index starting from zero
     -> Cube a
     -> Cube a
take :: Int -> Int -> Int -> Cube a -> Cube a
take x :: Int
x y :: Int
y z :: Int
z = (Matrix a -> Matrix a) -> Cube a -> Cube a
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 (Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
M.take Int
x Int
y) (Cube a -> Cube a) -> (Cube a -> Cube a) -> Cube a -> Cube a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Cube a -> Cube a
forall a. Int -> Vector a -> Vector a
V.take Int
z

-- | Returns the upper-left part of a matrix until a specific
-- position.
--
-- >>> let m = matrix 4 4 [1,2,3,4,11,12,13,14,21,22,23,24,31,32,33,34]
-- >>> pretty " " $ drop 2 2 m
-- 23 24
-- 33 34
drop :: Int       -- ^ X index starting from zero
     -> Int       -- ^ Y index starting from zero
     -> Int       -- ^ Z index starting from zero
     -> Cube a
     -> Cube a
drop :: Int -> Int -> Int -> Cube a -> Cube a
drop x :: Int
x y :: Int
y z :: Int
z = (Matrix a -> Matrix a) -> Cube a -> Cube a
forall a1 b1. (a1 -> b1) -> Vector a1 -> Vector b1
V.farm11 (Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
M.drop Int
x Int
y) (Cube a -> Cube a) -> (Cube a -> Cube a) -> Cube a -> Cube a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Cube a -> Cube a
forall a. Int -> Vector a -> Vector a
V.drop Int
z