module ForSyDe.Atom.Skel.FastVector.Matrix where

import qualified GHC.List as L (take, drop)
import Prelude hiding (take, drop)
import qualified Data.List as L
import ForSyDe.Atom.Skel.FastVector (Vector(..), vector, fromVector, (<++>))
import qualified ForSyDe.Atom.Skel.FastVector as V

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

-- | Prints out to the terminal a matrix in a readable format, where
-- all elements are right-aligned and separated by a custom separator.
--
-- >>> let m = matrix 3 3 [1,2,3,3,100,4,12,32,67]
-- >>> pretty "|" m
--  1|  2| 3
--  3|100| 4
-- 12| 32|67
pretty :: Show a
       => String   -- ^ separator string
       -> Matrix a -- ^ input matrix
       -> IO ()
pretty :: String -> Matrix a -> IO ()
pretty sep :: String
sep mat :: Matrix a
mat = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector String -> [String]
forall a. Vector a -> [a]
fromVector (Vector String -> [String]) -> Vector String -> [String]
forall a b. (a -> b) -> a -> b
$ Vector Int -> Vector (Vector String) -> Vector String
forall (f :: * -> *).
Functor f =>
Vector Int -> f (Vector String) -> f String
printMat Vector Int
maxWdt Vector (Vector String)
strMat
  where
    maxWdt :: Vector Int
maxWdt = (Vector Int -> Vector Int -> Vector Int)
-> Vector (Vector Int) -> Vector Int
forall t. (t -> t -> t) -> Vector t -> t
V.reduce ((Int -> Int -> Int) -> Vector Int -> Vector Int -> Vector Int
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 Int -> Int -> Int
forall a. Ord a => a -> a -> a
max) (Vector (Vector Int) -> Vector Int)
-> Vector (Vector Int) -> Vector Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> Vector (Vector String) -> Vector (Vector Int)
forall a b. (a -> b) -> Matrix a -> Matrix b
farm11 String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Vector String)
strMat
    strMat :: Vector (Vector String)
strMat = (a -> String) -> Matrix a -> Vector (Vector String)
forall a b. (a -> b) -> Matrix a -> Matrix b
farm11 a -> String
forall a. Show a => a -> String
show Matrix a
mat
    printMat :: Vector Int -> f (Vector String) -> f String
printMat w :: Vector Int
w  = (Vector String -> String) -> f (Vector String) -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Vector Int -> Vector String -> String
printRow Vector Int
w)
    printRow :: Vector Int -> Vector String -> String
printRow w :: Vector Int
w  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
sep ([String] -> String)
-> (Vector String -> [String]) -> Vector String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector String -> [String]
forall a. Vector a -> [a]
fromVector (Vector String -> [String])
-> (Vector String -> Vector String) -> Vector String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String -> String)
-> Vector Int -> Vector String -> Vector String
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 Int -> String -> String
align Vector Int
w
    align :: Int -> String -> String
align n :: Int
n str :: String
str = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.isNull'.
isNull :: Matrix a -> Bool
isNull :: Matrix a -> Bool
isNull (Vector []) = Bool
True
isNull (Vector [Vector []]) = Bool
True
isNull _ = Bool
False

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.size'.
size :: Matrix a -> (Int,Int)
size :: Matrix a -> (Int, Int)
size m :: Matrix a
m = (Int
x,Int
y)
  where
    y :: Int
y = Matrix a -> Int
forall a. Vector a -> Int
V.length Matrix a
m
    x :: Int
x = (Vector a -> Int
forall a. Vector a -> Int
V.length (Vector a -> Int) -> (Matrix a -> Vector a) -> Matrix a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Vector a
forall t. Vector t -> t
V.first) (Matrix a
m)

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.wellFormed'.
wellFormed :: Matrix a -> Matrix a
wellFormed :: Matrix a -> Matrix a
wellFormed (Vector []) = [Vector a] -> Matrix a
forall a. [a] -> Vector a
Vector []
wellFormed m :: Matrix a
m@(Vector (_ : [])) = Matrix a
m
wellFormed m :: Matrix a
m@(Vector (x :: Vector a
x:xs :: [Vector a]
xs))
  | (Vector a -> Bool) -> [Vector a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\r :: Vector a
r -> Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
x) [Vector a]
xs = Matrix a
m
  | Bool
otherwise = String -> Matrix a
forall a. HasCallStack => String -> a
error "matrix ill-formed: rows are of unequal lengths"

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
$ "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 "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)

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.Matrix'.
matrix :: Int      -- ^ number of columns (X dimension) @= x@
       -> Int      -- ^ number of rows (Y dimension) @= y@
       -> [a]      -- ^ list of values; /length/ = @x * y@
       -> Matrix a -- ^ 'Matrix' of values; /size/ = @(x,y)@
matrix :: Int -> Int -> [a] -> Matrix a
matrix x :: Int
x y :: Int
y = [Vector a] -> Matrix a
forall a. [a] -> Vector a
vector ([Vector a] -> Matrix a) -> ([a] -> [Vector a]) -> [a] -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Vector a) -> [[a]] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Vector a
forall a. [a] -> Vector a
vector ([[a]] -> [Vector a]) -> ([a] -> [[a]]) -> [a] -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
groupEvery Int
x ([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 = 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 matrix (" 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]
++ ") 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"

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.fromMatrix'.
fromMatrix :: Matrix a -- ^ /size/ = @(x,y)@
           -> [a]      -- ^ /length/ = @x * y@
fromMatrix :: Matrix a -> [a]
fromMatrix = (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]) -> (Matrix a -> [Vector a]) -> Matrix a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> [Vector a]
forall a. Vector a -> [a]
fromVector

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.fanout'.
fanout :: a -> Matrix a
fanout :: a -> Matrix a
fanout n :: a
n = Vector a -> Matrix a
forall a. a -> Vector a
V.fanout (Vector a -> Matrix a) -> Vector a -> Matrix a
forall a b. (a -> b) -> a -> b
$ a -> Vector a
forall a. a -> Vector a
V.fanout a
n

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.indexes'.
indexes :: Matrix (Int, Int)
indexes :: Matrix (Int, Int)
indexes = (Int -> Int -> (Int, Int))
-> Vector (Vector Int) -> Vector (Vector Int) -> Matrix (Int, Int)
forall a b c. (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
farm21 (,) Vector (Vector Int)
colix Vector (Vector Int)
rowix
  where
    colix :: Vector (Vector Int)
colix = [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 :: Vector (Vector Int)
rowix = Vector (Vector Int) -> Vector (Vector Int)
forall a. Matrix a -> Matrix a
transpose Vector (Vector Int)
colix

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.farm11'.
farm11 :: (a -> b)
       -> Matrix a -- ^ /size/ = @(xa,ya)@
       -> Matrix b -- ^ /size/ = @(xa,ya)@
farm11 :: (a -> b) -> Matrix a -> Matrix b
farm11 = (Vector a -> Vector b) -> Matrix a -> Matrix b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 ((Vector a -> Vector b) -> Matrix a -> Matrix b)
-> ((a -> b) -> Vector a -> Vector b)
-> (a -> b)
-> Matrix a
-> Matrix b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.farm21'.
farm21 :: (a -> b -> c)
           -> Matrix a -- ^ /size/ = @(xa,ya)@
           -> Matrix b -- ^ /size/ = @(xb,yb)@
           -> Matrix c -- ^ /size/ = @(minimum [xa,xb], minimum [ya,yb])@
farm21 :: (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
farm21 f :: a -> b -> c
f = (Vector a -> Vector b -> Vector c)
-> Matrix a -> Matrix b -> Matrix c
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 a -> b -> c
f)

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.farm31'.
farm31 :: (a -> b -> c -> d)
            -> Matrix a -- ^ /size/ = @(xa,ya)@
            -> Matrix b -- ^ /size/ = @(xb,yb)@
            -> Matrix c -- ^ /size/ = @(xc,yc)@
            -> Matrix d -- ^ /size/ = @(minimum [xa,xb,xc], minimum [ya,yb,yc])@
farm31 :: (a -> b -> c -> d) -> Matrix a -> Matrix b -> Matrix c -> Matrix d
farm31 f :: a -> b -> c -> d
f = (Vector a -> Vector b -> Vector c -> Vector d)
-> Matrix a -> Matrix b -> Matrix c -> Matrix d
forall (f :: * -> *) a1 a2 a3 b.
Applicative f =>
(a1 -> a2 -> a3 -> b) -> f a1 -> f a2 -> f a3 -> f b
V.farm31 ((a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
forall (f :: * -> *) a1 a2 a3 b.
Applicative f =>
(a1 -> a2 -> a3 -> b) -> f a1 -> f a2 -> f a3 -> f b
V.farm31 a -> b -> c -> d
f)

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.reduce'.
reduce :: (a -> a -> a) -> Matrix a -> a
reduce :: (a -> a -> a) -> Matrix a -> a
reduce f :: a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall t. (t -> t -> t) -> Vector t -> t
V.reduce a -> a -> a
f (Vector a -> a) -> (Matrix a -> Vector a) -> Matrix a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> a) -> Matrix a -> Vector a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 ((a -> a -> a) -> Vector a -> a
forall t. (t -> t -> t) -> Vector t -> t
V.reduce a -> a -> a
f)

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.fotV'.
dotV :: (a -> a -> a)
     -- ^ kernel function for a row/column reduction, e.g. @(+)@ for dot product
     -> (b -> a -> a)
     -- ^ binary operation for pair-wise elements, e.g. @(*)@ for dot product
     -> Matrix b      -- ^ /size/ = @(xa,ya)@
     -> Vector a      -- ^ /length/ = @xa@
     -> Vector a      -- ^ /length/ = @xa@
dotV :: (a -> a -> a) -> (b -> a -> a) -> Matrix b -> Vector a -> Vector a
dotV f :: a -> a -> a
f g :: b -> a -> a
g mA :: Matrix b
mA y :: Vector a
y = (Vector b -> a) -> Matrix b -> Vector a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (\x :: Vector b
x -> (a -> a -> a) -> Vector a -> a
forall t. (t -> t -> t) -> Vector t -> t
V.reduce a -> a -> a
f (Vector a -> a) -> Vector a -> a
forall a b. (a -> b) -> a -> b
$ (b -> a -> a) -> Vector b -> Vector a -> Vector a
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 b -> a -> a
g Vector b
x Vector a
y) Matrix b
mA

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.dot'.
dot :: (a -> a -> a) -- ^ kernel function for a row/column reduction, e.g. @(+)@ for dot product
    -> (b -> a -> a) -- ^ binary operation for pair-wise elements, e.g. @(*)@ for dot product
    -> Matrix b      -- ^ /size/ = @(xa,ya)@
    -> Matrix a      -- ^ /size/ = @(ya,xa)@
    -> Matrix a      -- ^ /size/ = @(xa,xa)@
dot :: (a -> a -> a) -> (b -> a -> a) -> Matrix b -> Matrix a -> Matrix a
dot f :: a -> a -> a
f g :: b -> a -> a
g m :: Matrix b
m = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 ((a -> a -> a) -> (b -> a -> a) -> Matrix b -> Vector a -> Vector a
forall a b.
(a -> a -> a) -> (b -> a -> a) -> Matrix b -> Vector a -> Vector a
dotV a -> a -> a
f b -> a -> a
g Matrix b
m) (Matrix a -> Matrix a)
-> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Matrix a
forall a. Matrix a -> Matrix a
transpose

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.get'.
get :: Int       -- ^ X index starting from zero
    -> Int       -- ^ Y index starting from zero
    -> Matrix a
    -> Maybe a
get :: Int -> Int -> Matrix a -> Maybe a
get x :: Int
x y :: Int
y mat :: Matrix a
mat = Maybe (Vector a) -> Maybe a
forall a. Maybe (Vector a) -> Maybe a
getMaybe (Int -> Matrix a -> Maybe (Vector a)
forall a. Int -> Vector a -> Maybe a
V.get Int
y Matrix a
mat)
  where getMaybe :: Maybe (Vector a) -> Maybe a
getMaybe Nothing = Maybe a
forall a. Maybe a
Nothing
        getMaybe (Just a :: Vector a
a) = Int -> Vector a -> Maybe a
forall a. Int -> Vector a -> Maybe a
V.get Int
x Vector a
a

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.take'.
take :: Int       -- ^ X index starting from zero
     -> Int       -- ^ Y index starting from zero
     -> Matrix a
     -> Matrix a
take :: Int -> Int -> Matrix a -> Matrix a
take x :: Int
x y :: Int
y = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
x) (Matrix a -> Matrix a)
-> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Matrix a -> Matrix a
forall a. Int -> Vector a -> Vector a
V.take Int
y

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.drop'.
drop :: Int       -- ^ X index starting from zero
     -> Int       -- ^ Y index starting from zero
     -> Matrix a
     -> Matrix a
drop :: Int -> Int -> Matrix a -> Matrix a
drop x :: Int
x y :: Int
y = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop Int
x) (Matrix a -> Matrix a)
-> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Matrix a -> Matrix a
forall a. Int -> Vector a -> Vector a
V.drop Int
y

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.crop'.
crop :: Int      -- ^ crop width  = @w@
     -> Int      -- ^ crop height = @h@
     -> Int      -- ^ X start position = @x0@
     -> Int      -- ^ Y start position = @y0@
     -> Matrix a -- ^ /size/ = @(xa,ya)@
     -> Matrix a -- ^ /size/ = @(minimum [w,xa-x0], minimum [h,xa-x0])@
crop :: Int -> Int -> Int -> Int -> Matrix a -> Matrix a
crop w :: Int
w h :: Int
h pX :: Int
pX pY :: Int
pY = Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
take Int
w Int
h (Matrix a -> Matrix a)
-> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
drop Int
pX Int
pY

-- cropMat w h pX pY = V.farm11 (crop w pX) . crop h pY
--   where crop size pos = V.drop pos . V.take (pos + size) 

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.group'.
group :: Int      -- ^ width of groups = @w@
      -> Int      -- ^ height of groups = @h@
      -> Matrix a -- ^ /size/ = @(xa,ya)@
      -> Matrix (Matrix a) -- ^ /size/ = @(xa `div` w,ya `div` h)@
group :: Int -> Int -> Matrix a -> Matrix (Matrix a)
group w :: Int
w h :: Int
h = (Matrix (Vector a) -> Matrix (Vector a))
-> Matrix (Matrix a) -> Matrix (Matrix a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 Matrix (Vector a) -> Matrix (Vector a)
forall a. Matrix a -> Matrix a
transpose (Matrix (Matrix a) -> Matrix (Matrix a))
-> (Matrix a -> Matrix (Matrix a)) -> Matrix a -> Matrix (Matrix a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Matrix (Vector a) -> Matrix (Matrix a)
forall a. Int -> Vector a -> Vector (Vector a)
V.group Int
h (Matrix (Vector a) -> Matrix (Matrix a))
-> (Matrix a -> Matrix (Vector a)) -> Matrix a -> Matrix (Matrix a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Matrix a) -> Matrix a -> Matrix (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Int -> Vector a -> Matrix a
forall a. Int -> Vector a -> Vector (Vector a)
V.group Int
w)


-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.stencil'.
stencil :: Int -> Int -> Matrix a -> Matrix (Matrix a)
stencil :: Int -> Int -> Matrix a -> Matrix (Matrix a)
stencil r :: Int
r c :: Int
c = Matrix (Matrix a) -> Matrix (Matrix a)
forall a. Vector (Matrix a) -> Vector (Matrix a)
arrange (Matrix (Matrix a) -> Matrix (Matrix a))
-> (Matrix a -> Matrix (Matrix a)) -> Matrix a -> Matrix (Matrix a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (Vector a) -> Matrix (Matrix a)
forall a. Matrix (Vector a) -> Matrix (Vector (Vector a))
groupCols (Matrix (Vector a) -> Matrix (Matrix a))
-> (Matrix a -> Matrix (Vector a)) -> Matrix a -> Matrix (Matrix a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Matrix (Vector a)
forall a. Vector a -> Vector (Vector a)
groupRows
  where
    groupRows :: Vector a -> Vector (Vector a)
groupRows =         (Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
r) (Vector (Vector a) -> Vector (Vector a))
-> (Vector a -> Vector (Vector a)) -> Vector a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector (Vector a) -> Vector (Vector a)
forall a. Int -> Vector a -> Vector a
dropFromEnd Int
r (Vector (Vector a) -> Vector (Vector a))
-> (Vector a -> Vector (Vector a)) -> Vector a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector (Vector a)
forall a. Vector a -> Vector (Vector a)
V.tails
    groupCols :: Matrix (Vector a) -> Matrix (Vector (Vector a))
groupCols = (Vector a -> Vector (Vector a))
-> Matrix (Vector a) -> Matrix (Vector (Vector a))
forall a b. (a -> b) -> Matrix a -> Matrix b
farm11 ((Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
c) (Vector (Vector a) -> Vector (Vector a))
-> (Vector a -> Vector (Vector a)) -> Vector a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector (Vector a) -> Vector (Vector a)
forall a. Int -> Vector a -> Vector a
dropFromEnd Int
c (Vector (Vector a) -> Vector (Vector a))
-> (Vector a -> Vector (Vector a)) -> Vector a -> Vector (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector (Vector a)
forall a. Vector a -> Vector (Vector a)
V.tails)
    arrange :: Vector (Matrix a) -> Vector (Matrix a)
arrange   = (Matrix a -> Matrix a) -> Vector (Matrix a) -> Vector (Matrix a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 Matrix a -> Matrix a
forall a. Matrix a -> Matrix a
transpose
    dropFromEnd :: Int -> Vector a -> Vector a
dropFromEnd n :: Int
n v :: Vector a
v = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Vector a
v

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.reverse'.
reverse :: Matrix a -> Matrix a
reverse :: Matrix a -> Matrix a
reverse = Matrix a -> Matrix a
forall a. Vector a -> Vector a
V.reverse (Matrix a -> Matrix a)
-> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a) -> Matrix a -> Matrix a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
V.farm11 Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse

-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.transpose'.
transpose :: Matrix a     -- ^ @X:Y@ orientation
          -> Matrix a     -- ^ @Y:X@ orientation
transpose :: Matrix a -> Matrix a
transpose =  [Vector a] -> Matrix a
forall a. [a] -> Vector a
vector ([Vector a] -> Matrix a)
-> (Matrix a -> [Vector a]) -> Matrix a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Vector a) -> [[a]] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Vector a
forall a. [a] -> Vector a
vector ([[a]] -> [Vector a])
-> (Matrix a -> [[a]]) -> Matrix a -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
L.transpose ([[a]] -> [[a]]) -> (Matrix a -> [[a]]) -> Matrix a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> [a]) -> [Vector a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map Vector a -> [a]
forall a. Vector a -> [a]
fromVector ([Vector a] -> [[a]])
-> (Matrix a -> [Vector a]) -> Matrix a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> [Vector a]
forall a. Vector a -> [a]
fromVector


-- | See 'ForSyDe.Atom.Skel.Vector.Matrix.replace'.
replace :: Int -> Int -> Matrix a -> Matrix a -> Matrix a
replace :: Int -> Int -> Matrix a -> Matrix a -> Matrix a
replace x :: Int
x y :: Int
y mask :: Matrix a
mask = Int -> Int -> (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall a.
Int -> Int -> (Vector a -> Vector a) -> Vector a -> Vector a
replace Int
y Int
h ((Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
forall (f :: * -> *) a1 a2 b.
Applicative f =>
(a1 -> a2 -> b) -> f a1 -> f a2 -> f b
V.farm21 (\m :: Vector a
m o :: Vector a
o -> Int -> Int -> (Vector a -> Vector a) -> Vector a -> Vector a
forall a.
Int -> Int -> (Vector a -> Vector a) -> Vector a -> Vector a
replace Int
x Int
w (Vector a -> Vector a -> Vector a
forall a b. a -> b -> a
const Vector a
m) Vector a
o) Matrix a
mask)
  where
    (w :: Int
w,h :: Int
h) = Matrix a -> (Int, Int)
forall a. Matrix a -> (Int, Int)
size Matrix a
mask
    replace :: Int -> Int -> (Vector a -> Vector a) -> Vector a -> Vector a
replace start :: Int
start size :: Int
size replaceF :: Vector a -> Vector a
replaceF vec :: Vector a
vec
      = let begin :: Vector a
begin  = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
start Vector a
vec
            middle :: Vector a
middle = Vector a -> Vector a
replaceF (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop Int
start (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) Vector a
vec
            end :: Vector a
end    = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) Vector a
vec
        in Vector a
begin Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<++> Vector a
middle Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<++> Vector a
end