{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Strict #-}

-- |
-- Module      :  Aftovolio.PermutationsArr
-- Copyright   :  (c) OleksandrZhabenko 2020-2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Permutations and universal set functions for the phonetic-languages series and phladiprelio of packages
-- (AFTOVolio-related). This module uses no vectors, but instead uses arrays.

module Aftovolio.PermutationsArr (
  universalSetGL
  , genPermutations
  , genPermutationsArr
  , genPermutationsL
  , genPermutationsArrL
) where

import GHC.Enum
import GHC.List
import GHC.Num (Num,(*), (-))
import GHC.Base
import GHC.Arr
import qualified Data.List as L (permutations,product)
import Data.InsertLeft
import qualified Data.Foldable as F (Foldable,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, F.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 :: forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
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 a b. (a -> b -> b) -> b -> [a] -> b
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 #-}
{-# SPECIALIZE universalSetGL :: String -> [String] -> (String -> String) -> ([String] -> [String]) -> [Array Int Int] -> Array Int String -> [String]   #-}

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

genPermutationsArr ::  (Ord a, Enum a, Num a) => Array Int (Array Int [a])
genPermutationsArr :: forall a. (Ord a, Enum a, Num a) => Array Int (Array Int [a])
genPermutationsArr = (Int -> Array Int [a])
-> Array Int Int -> Array Int (Array Int [a])
forall a b i. (a -> b) -> Array i a -> Array i b
amap Int -> Array Int [a]
forall a. (Ord a, Enum a, Num a) => Int -> Array Int [a]
genPermutations (Array Int Int -> Array Int (Array Int [a]))
-> ([Int] -> Array Int Int) -> [Int] -> Array Int (Array Int [a])
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 [a]))
-> [Int] -> Array Int (Array Int [a])
forall a b. (a -> b) -> a -> b
$ [Int
2..Int
7]
{-# INLINE genPermutationsArr #-}
{-# SPECIALIZE genPermutationsArr :: Array Int (Array Int [Int]) #-}

genPermutationsL ::  (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPermutationsL :: forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPermutationsL Int
n = ([a] -> Array Int a) -> [[a]] -> [Array Int a]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
xs -> (Int, Int) -> [a] -> Array Int a
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) [a]
xs) ([[a]] -> [Array Int a]) -> ([a] -> [[a]]) -> [a] -> [Array Int a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. [a] -> [[a]]
L.permutations ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [Array Int a]) -> [a] -> [Array Int a]
forall a b. (a -> b) -> a -> b
$ [a
0..]
{-# INLINE genPermutationsL #-}
{-# SPECIALIZE genPermutationsL :: Int  -> [Array Int Int] #-}

genPermutationsArrL ::  (Ord a, Enum a, Num a) => Array Int [Array Int a]
genPermutationsArrL :: forall a. (Ord a, Enum a, Num a) => Array Int [Array Int a]
genPermutationsArrL = (Int -> [Array Int a]) -> Array Int Int -> Array Int [Array Int a]
forall a b i. (a -> b) -> Array i a -> Array i b
amap Int -> [Array Int a]
forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPermutationsL (Array Int Int -> Array Int [Array Int a])
-> ([Int] -> Array Int Int) -> [Int] -> Array Int [Array Int a]
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 a])
-> [Int] -> Array Int [Array Int a]
forall a b. (a -> b) -> a -> b
$ [Int
2..Int
7]
{-# INLINE genPermutationsArrL #-}
{-# SPECIALIZE genPermutationsArrL :: Array Int [Array Int Int] #-}