{-# LANGUAGE NoImplicitPrelude #-}

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

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

import GHC.List
import GHC.Num ((*), (-))
import GHC.Base
import GHC.Arr
import qualified Data.List as L (permutations)
import Data.SubG
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
F.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' (:) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> [a]
f1 t a
tsforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => a -> a -> a
`mappend` t (t a) -> [[a]]
f2 t (t a)
uss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> [e]
elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b i. (a -> b) -> Array i a -> Array i b
amap (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 :: a -> a
factorial a
n = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall a. Num a => a -> a -> a
(*) a
1 [a
1..a
n]

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

genPermutationsArr :: Array Int (Array Int [Int])
genPermutationsArr :: Array Int (Array Int [Int])
genPermutationsArr = forall a b i. (a -> b) -> Array i a -> Array i b
amap Int -> Array Int [Int]
genPermutations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) 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 = forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
xs -> forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n forall a. Num a => a -> a -> a
- Int
1) [Int]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
L.permutations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ [Int
0..]
{-# INLINE genPermutationsL #-}

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