-- |
-- Module      :  Phonetic.Languages.Permutations.Arr
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Permutations and universal set functions for the phonetic-languages series of packages. This
-- module uses no vectors, but instead uses arrays.

module Phonetic.Languages.Permutations.Arr (
  universalSetGL
  , genPermutations
  , genPermutationsArr
  , genPermutationsL
  , genPermutationsArrL
) where

import GHC.Arr
import qualified Data.List as L (permutations)
import Data.SubG
import qualified Data.Foldable as F (concat,foldr',foldl')
import Data.Monoid

-- | A key point of the evaluation -- the universal set of the task represented as a @[[a]]@.
universalSetGL ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => t a
  -> t (t a)
  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations
  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the needed representation so that the function can process further
  -> [Array Int Int] -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).
  -> Array Int [a]
  -> [[a]]
universalSetGL :: t a
-> t (t a)
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> [Array Int Int]
-> Array Int [a]
-> [[a]]
universalSetGL t a
ts t (t a)
uss t a -> [a]
f1 t (t a) -> [[a]]
f2 [Array Int Int]
permsL Array Int [a]
baseArr = (Array Int Int -> [a]) -> [Array Int Int] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
F.concat ([[a]] -> [a]) -> (Array Int Int -> [[a]]) -> Array Int Int -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' (:) [] ([[a]] -> [[a]])
-> (Array Int Int -> [[a]]) -> Array Int Int -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> [a]
f1 t a
ts[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]])
-> (Array Int Int -> [[a]]) -> Array Int Int -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[a]] -> [[a]] -> [[a]]
forall a. Monoid a => a -> a -> a
`mappend` t (t a) -> [[a]]
f2 t (t a)
uss) ([[a]] -> [[a]])
-> (Array Int Int -> [[a]]) -> Array Int Int -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int [a] -> [[a]]
forall i e. Array i e -> [e]
elems (Array Int [a] -> [[a]])
-> (Array Int Int -> Array Int [a]) -> Array Int Int -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [a]) -> Array Int Int -> Array Int [a]
forall a b i. (a -> b) -> Array i a -> Array i b
amap (Array Int [a] -> Int -> [a]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [a]
baseArr)) [Array Int Int]
permsL
{-# INLINE universalSetGL #-}

-- | One of the popular examples:  realization of the factorial function using 'F.foldl''. Is taken from some
-- teaching material.
factorial :: b -> b
factorial b
n = (b -> b -> b) -> b -> [b] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> b -> b
forall a. Num a => a -> a -> a
(*) b
1 [b
1..b
n]

genPermutations :: Int -> Array Int [Int]
genPermutations :: Int -> Array Int [Int]
genPermutations Int
n = (Int, Int) -> [[Int]] -> Array Int [Int]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall b. (Num b, Enum b) => b -> b
factorial Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([[Int]] -> Array Int [Int])
-> ([Int] -> [[Int]]) -> [Int] -> Array Int [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations ([Int] -> [[Int]]) -> ([Int] -> [Int]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> Array Int [Int]) -> [Int] -> Array Int [Int]
forall a b. (a -> b) -> a -> b
$ [Int
0..]
{-# INLINE genPermutations #-}

genPermutationsArr :: Array Int (Array Int [Int])
genPermutationsArr :: Array Int (Array Int [Int])
genPermutationsArr = (Int -> Array Int [Int])
-> Array Int Int -> Array Int (Array Int [Int])
forall a b i. (a -> b) -> Array i a -> Array i b
amap Int -> Array Int [Int]
genPermutations (Array Int Int -> Array Int (Array Int [Int]))
-> ([Int] -> Array Int Int) -> [Int] -> Array Int (Array Int [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([Int] -> Array Int (Array Int [Int]))
-> [Int] -> Array Int (Array Int [Int])
forall a b. (a -> b) -> a -> b
$ [Int
2..Int
7]
{-# INLINE genPermutationsArr #-}

genPermutationsL :: Int -> [Array Int Int]
genPermutationsL :: Int -> [Array Int Int]
genPermutationsL Int
n = ([Int] -> Array Int Int) -> [[Int]] -> [Array Int Int]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
xs -> (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
xs) ([[Int]] -> [Array Int Int])
-> ([Int] -> [[Int]]) -> [Int] -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations ([Int] -> [[Int]]) -> ([Int] -> [Int]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> [Array Int Int]) -> [Int] -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ [Int
0..]
{-# INLINE genPermutationsL #-}

genPermutationsArrL :: Array Int [Array Int Int]
genPermutationsArrL :: Array Int [Array Int Int]
genPermutationsArrL = (Int -> [Array Int Int])
-> Array Int Int -> Array Int [Array Int Int]
forall a b i. (a -> b) -> Array i a -> Array i b
amap Int -> [Array Int Int]
genPermutationsL (Array Int Int -> Array Int [Array Int Int])
-> ([Int] -> Array Int Int) -> [Int] -> Array Int [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([Int] -> Array Int [Array Int Int])
-> [Int] -> Array Int [Array Int Int]
forall a b. (a -> b) -> a -> b
$ [Int
2..Int
7]
{-# INLINE genPermutationsArrL #-}