-- | Square arrays, where the number of rows and columns are equal.
module Music.Theory.Array.Square where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Data.Map as Map {- containers -}
import qualified Data.List.Split as Split {- split -}

import qualified Music.Theory.Array as T {- hmt-base -}
import qualified Music.Theory.Array.Text as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}

import qualified Music.Theory.Math.Oeis as T {- hmt -}

-- | Square as list of lists.
type Square t = [[t]]

-- | Squares are functors
sq_map :: (t -> t) -> Square t -> Square t
sq_map :: forall t. (t -> t) -> Square t -> Square t
sq_map t -> t
f = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map t -> t
f)

-- | 'sq_map' of '*' /n/
sq_scale :: Num t => t -> Square t -> Square t
sq_scale :: forall t. Num t => t -> Square t -> Square t
sq_scale t
n = forall t. (t -> t) -> Square t -> Square t
sq_map (forall a. Num a => a -> a -> a
* t
n)

-- | /f/ pointwise at two squares (of equal size, un-checked)
sq_zip :: (t -> t -> t) -> Square t -> Square t -> Square t
sq_zip :: forall t. (t -> t -> t) -> Square t -> Square t -> Square t
sq_zip t -> t -> t
f = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith t -> t -> t
f)

-- | 'sq_zip' of '*'
sq_mul :: Num t => Square t -> Square t -> Square t
sq_mul :: forall t. Num t => Square t -> Square t -> Square t
sq_mul = forall t. (t -> t -> t) -> Square t -> Square t -> Square t
sq_zip forall a. Num a => a -> a -> a
(*)

-- | 'sq_zip' of '+'
sq_add :: Num t => Square t -> Square t -> Square t
sq_add :: forall t. Num t => Square t -> Square t -> Square t
sq_add = forall t. (t -> t -> t) -> Square t -> Square t -> Square t
sq_zip forall a. Num a => a -> a -> a
(+)

-- | 'foldl1' of 'sq_add'
sq_sum :: Num t => [Square t] -> Square t
sq_sum :: forall t. Num t => [Square t] -> Square t
sq_sum = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall t. Num t => Square t -> Square t -> Square t
sq_add

-- | Predicate to determine if 'Square' is actually square.
sq_is_square :: Square t -> Bool
sq_is_square :: forall t. Square t -> Bool
sq_is_square Square t
sq = forall a. Eq a => [a] -> [a]
nub (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length Square t
sq) forall a. Eq a => a -> a -> Bool
== [forall (t :: * -> *) a. Foldable t => t a -> Int
length Square t
sq]

-- | Square as row order list
type Square_Linear t = [t]

-- | Given degree of square, form 'Square' from 'Square_Linear'.
sq_from_list :: Int -> Square_Linear t -> Square t
sq_from_list :: forall t. Int -> Square_Linear t -> Square t
sq_from_list = forall t. Int -> Square_Linear t -> Square t
Split.chunksOf

-- | True if list can form a square, ie. if 'length' is a square.
--
-- > sq_is_linear_square T.a126710 == True
sq_is_linear_square :: Square_Linear t -> Bool
sq_is_linear_square :: forall t. Square_Linear t -> Bool
sq_is_linear_square Square_Linear t
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length Square_Linear t
l forall t. Ord t => t -> [t] -> Bool
`T.elem_ordered` forall n. Integral n => [n]
T.a000290

-- | Calculate degree of linear square, ie. square root of 'length'.
--
-- > sq_linear_degree T.a126710 == 4
sq_linear_degree :: Square_Linear t -> Int
sq_linear_degree :: forall t. Square_Linear t -> Int
sq_linear_degree =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"sq_linear_degree") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t. Ord t => t -> [t] -> Maybe Int
T.elemIndex_ordered forall n. Integral n => [n]
T.a000290 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Type specialised 'transpose'
sq_transpose :: Square t -> Square t
sq_transpose :: forall t. Square t -> Square t
sq_transpose = forall t. Square t -> Square t
transpose

{- | Full upper-left (ul) to lower-right (lr) diagonals of a square.

> sq = sq_from_list 4 T.a126710
> sq_wr $ sq
> sq_wr $ sq_diagonals_ul_lr sq
> sq_wr $ sq_diagonals_ll_ur sq
> sq_undiagonals_ul_lr (sq_diagonals_ul_lr sq) == sq
> sq_undiagonals_ll_ur (sq_diagonals_ll_ur sq) == sq

> sq_diagonal_ul_lr sq == sq_diagonals_ul_lr sq !! 0
> sq_diagonal_ll_ur sq == sq_diagonals_ll_ur sq !! 0

-}
sq_diagonals_ul_lr :: Square t -> Square t
sq_diagonals_ul_lr :: forall t. Square t -> Square t
sq_diagonals_ul_lr = forall t. Square t -> Square t
sq_transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> [a] -> [a]
T.rotate_left [Int
0..]

-- | Full lower-left (ll) to upper-right (ur) diagonals of a square.
sq_diagonals_ll_ur :: Square t -> Square t
sq_diagonals_ll_ur :: forall t. Square t -> Square t
sq_diagonals_ll_ur = forall t. Square t -> Square t
sq_diagonals_ul_lr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Inverse of 'diagonals_ul_lr'
sq_undiagonals_ul_lr :: Square t -> Square t
sq_undiagonals_ul_lr :: forall t. Square t -> Square t
sq_undiagonals_ul_lr = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> [a] -> [a]
T.rotate_right [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_transpose

-- | Inverse of 'diagonals_ll_ur'
sq_undiagonals_ll_ur :: Square t -> Square t
sq_undiagonals_ll_ur :: forall t. Square t -> Square t
sq_undiagonals_ll_ur = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_undiagonals_ul_lr

-- | Main diagonal (upper-left -> lower-right)
sq_diagonal_ul_lr :: Square t -> [t]
sq_diagonal_ul_lr :: forall t. Square t -> [t]
sq_diagonal_ul_lr Square t
sq = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> Int -> a
(!!) Square t
sq [Int
0 ..]

-- | Main diagonal (lower-left -> upper-right)
sq_diagonal_ll_ur :: Square t -> [t]
sq_diagonal_ll_ur :: forall t. Square t -> [t]
sq_diagonal_ll_ur = forall t. Square t -> [t]
sq_diagonal_ul_lr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

{- | Horizontal reflection (ie. map reverse).

> sq = sq_from_list 4 T.a126710
> sq_wr $ sq
> sq_wr $ sq_h_reflection sq

-}
sq_h_reflection :: Square t -> Square t
sq_h_reflection :: forall t. Square t -> Square t
sq_h_reflection = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse

-- | An n×n square is /normal/ if it has the elements (1 .. n×n).
sq_is_normal :: Integral n => Square n -> Bool
sq_is_normal :: forall n. Integral n => Square n -> Bool
sq_is_normal Square n
sq =
  let n :: n
n = forall i a. Num i => [a] -> i
genericLength Square n
sq
  in forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Square n
sq) forall a. Eq a => a -> a -> Bool
== [n
1 .. n
n forall a. Num a => a -> a -> a
* n
n]

-- | Sums of (rows, columns, left-right-diagonals, right-left-diagonals)
sq_sums :: Num n => Square n -> ([n],[n],[n],[n])
sq_sums :: forall n. Num n => Square n -> ([n], [n], [n], [n])
sq_sums Square n
sq =
  (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Square n
sq
  ,forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall t. Square t -> Square t
sq_transpose Square n
sq)
  ,forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall t. Square t -> Square t
sq_diagonals_ul_lr Square n
sq)
  ,forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall t. Square t -> Square t
sq_diagonals_ll_ur Square n
sq))

-- * PP

sq_opt :: T.Text_Table_Opt
sq_opt :: Text_Table_Opt
sq_opt = (Bool
False,Bool
True,Bool
False,[Char]
" ",Bool
False)

sq_pp :: Show t => Square t -> String
sq_pp :: forall t. Show t => Square t -> [Char]
sq_pp = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Show t => Text_Table_Opt -> Table t -> [[Char]]
T.table_pp_show Text_Table_Opt
sq_opt

sq_wr :: Show t => Square t -> IO ()
sq_wr :: forall t. Show t => Square t -> IO ()
sq_wr = [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\n' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Show t => Square t -> [Char]
sq_pp

sq_pp_m :: Show t => String -> Square (Maybe t) -> String
sq_pp_m :: forall t. Show t => [Char] -> Square (Maybe t) -> [Char]
sq_pp_m [Char]
e = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text_Table_Opt -> Text_Table -> [[Char]]
T.table_pp Text_Table_Opt
sq_opt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
e (forall a. a -> Int -> [a] -> [a]
T.pad_left Char
'·' Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show)))

sq_wr_m :: Show t => String -> Square (Maybe t) -> IO ()
sq_wr_m :: forall t. Show t => [Char] -> Square (Maybe t) -> IO ()
sq_wr_m [Char]
e = [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Show t => [Char] -> Square (Maybe t) -> [Char]
sq_pp_m [Char]
e

-- * Square Map

-- | (row,column) index.
type Square_Ix = T.Ix Int

-- | Map from Square_Ix to value.
type Square_Map t = Map.Map Square_Ix t

-- | 'Square' to 'Square_Map'.
sq_to_map :: Square t -> Square_Map t
sq_to_map :: forall t. Square t -> Square_Map t
sq_to_map =
    let f :: a -> [b] -> [((a, b), b)]
f a
r = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\b
c b
e -> ((a
r,b
c),b
e)) [b
0..]
    in forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b} {a} {b}. (Num b, Enum b) => a -> [b] -> [((a, b), b)]
f [Int
0..]

-- | Alias for 'Map.!'
sqm_ix :: Square_Map t -> Square_Ix -> t
sqm_ix :: forall t. Square_Map t -> Square_Ix -> t
sqm_ix = forall k a. Ord k => Map k a -> k -> a
(Map.!)

-- | 'map' of 'sqm_ix'.
sqm_ix_seq :: Square_Map t -> [Square_Ix] -> [t]
sqm_ix_seq :: forall t. Square_Map t -> [Square_Ix] -> [t]
sqm_ix_seq Square_Map t
m = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Square_Map t -> Square_Ix -> t
sqm_ix Square_Map t
m)

-- | Make a 'Square' of dimension /dm/ that has elements from /m/ at
-- indicated indices, else 'Nothing'.
sqm_to_partial_sq :: Int -> Square_Map t -> [Square_Ix] -> Square (Maybe t)
sqm_to_partial_sq :: forall t. Int -> Square_Map t -> [Square_Ix] -> Square (Maybe t)
sqm_to_partial_sq Int
dm Square_Map t
m [Square_Ix]
ix_set =
    let f :: Square_Ix -> Maybe t
f Square_Ix
i = if Square_Ix
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Square_Ix]
ix_set then forall a. a -> Maybe a
Just (Square_Map t
m forall k a. Ord k => Map k a -> k -> a
Map.! Square_Ix
i) else forall a. Maybe a
Nothing
    in forall t. Int -> Square_Linear t -> Square t
Split.chunksOf Int
dm (forall a b. (a -> b) -> [a] -> [b]
map Square_Ix -> Maybe t
f (forall t. (Enum t, Num t) => Dimensions t -> [Dimensions t]
T.matrix_indices (Int
dm,Int
dm)))

-- * TRS SEQ

sq_trs_op :: [(String,Square t -> Square t)]
sq_trs_op :: forall t. [([Char], Square t -> Square t)]
sq_trs_op =
    [([Char]
"≡",forall a. a -> a
id)
    ,([Char]
"←",forall t. Square t -> Square t
sq_h_reflection)
    ,([Char]
"↓",forall t. Square t -> Square t
sq_transpose)
    ,([Char]
"(← · ↓)",forall t. Square t -> Square t
sq_h_reflection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_transpose)
    ,([Char]
"(↓ · ← · ↓)",forall t. Square t -> Square t
sq_transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_h_reflection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_transpose)
    ,([Char]
"(↓ · ←)",forall t. Square t -> Square t
sq_transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_h_reflection)
    ,([Char]
"(← · ↓ · ←)",forall t. Square t -> Square t
sq_h_reflection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_h_reflection)
    ,([Char]
"↘",forall t. Square t -> Square t
sq_diagonals_ul_lr)
    ,([Char]
"↙ = (↘ · ←)",forall t. Square t -> Square t
sq_diagonals_ul_lr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_h_reflection)
    ,([Char]
"↗ = (← · ↙)",forall t. Square t -> Square t
sq_h_reflection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_diagonals_ul_lr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_h_reflection)
    ,([Char]
"↖ = (← · ↘)",forall t. Square t -> Square t
sq_h_reflection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Square t -> Square t
sq_diagonals_ul_lr)
    ]

sq_trs_seq :: Square t -> [(String,Square t)]
sq_trs_seq :: forall t. Square t -> [([Char], Square t)]
sq_trs_seq Square t
sq = forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
nm,Square t -> Square t
fn) -> ([Char]
nm,Square t -> Square t
fn Square t
sq)) forall t. [([Char], Square t -> Square t)]
sq_trs_op