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

{- |
Module      :  Aftovolio.PermutationsArrMini
Copyright   :  (c) OleksandrZhabenko 2021-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

Special permutations functions for the phonetic-languages and phladiprelio series of packages. This
module uses no vectors, but instead uses arrays.
-}
module Aftovolio.PermutationsArrMini (
    genPairwisePermutations,
    pairsSwapP,
    genPairwisePermutationsArrN,
    genPairwisePermutationsArr,
    genPairwisePermutationsLN,
    genPairwisePermutationsL,
    genPairwisePermutationsArrLN,
    genPairwisePermutationsArrL,
) where

import Data.Bits (shiftR)
import GHC.Arr
import GHC.Base
import GHC.Enum
import GHC.List
import GHC.Num

genPairwisePermutations :: (Ord a, Enum a, Num a) => Int -> Array Int [a]
genPairwisePermutations :: forall a. (Ord a, Enum a, Num a) => Int -> Array Int [a]
genPairwisePermutations Int
n = (Int, Int) -> [[a]] -> Array Int [a]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) 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. (Ord a, Enum a, Num a) => [a] -> [[a]]
pairsSwapP ([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 genPairwisePermutations #-}
{-# SPECIALIZE genPairwisePermutations :: Int -> Array Int [Int] #-}

pairsSwapP :: (Ord a, Enum a, Num a) => [a] -> [[a]]
pairsSwapP :: forall a. (Ord a, Enum a, Num a) => [a] -> [[a]]
pairsSwapP [a]
xs = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a -> a -> [a] -> [a]
forall a. Eq a => a -> a -> [a] -> [a]
swap2Ls a
k a
m [a]
xs | a
k <- [a]
xs, a
m <- [a]
xs, a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
m]
{-# SPECIALIZE pairsSwapP :: [Int] -> [[Int]] #-}

-- | The first two arguments are considered not equal, though it is not checked.
swap2ns :: (Eq a) => a -> a -> a -> a
swap2ns :: forall a. Eq a => a -> a -> a -> a
swap2ns a
k a
m a
n
    | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
k = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
m then a
n else a
k
    | Bool
otherwise = a
m
{-# INLINE swap2ns #-}
{-# SPECIALIZE swap2ns :: Int -> Int -> Int -> Int #-}

swap2Ls :: (Eq a) => a -> a -> [a] -> [a]
swap2Ls :: forall a. Eq a => a -> a -> [a] -> [a]
swap2Ls a
k a
m = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a -> a
forall a. Eq a => a -> a -> a -> a
swap2ns a
k a
m)
{-# INLINE swap2Ls #-}
{-# SPECIALIZE swap2Ls :: Int -> Int -> [Int] -> [Int] #-}

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

genPairwisePermutationsArr ::
    (Ord a, Enum a, Num a) => Array Int (Array Int [a])
genPairwisePermutationsArr :: forall a. (Ord a, Enum a, Num a) => Array Int (Array Int [a])
genPairwisePermutationsArr = Int -> Array Int (Array Int [a])
forall a.
(Ord a, Enum a, Num a) =>
Int -> Array Int (Array Int [a])
genPairwisePermutationsArrN Int
10
{-# INLINE genPairwisePermutationsArr #-}
{-# SPECIALIZE genPairwisePermutationsArr :: Array Int (Array Int [Int]) #-}

genPairwisePermutationsLN :: (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPairwisePermutationsLN :: forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPairwisePermutationsLN 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. (Ord a, Enum a, Num a) => [a] -> [[a]]
pairsSwapP ([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 genPairwisePermutationsLN #-}
{-# SPECIALIZE genPairwisePermutationsLN :: Int -> [Array Int Int] #-}

genPairwisePermutationsL :: (Ord a, Enum a, Num a) => [Array Int a]
genPairwisePermutationsL :: forall a. (Ord a, Enum a, Num a) => [Array Int a]
genPairwisePermutationsL = Int -> [Array Int a]
forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPairwisePermutationsLN Int
10
{-# INLINE genPairwisePermutationsL #-}
{-# SPECIALIZE genPairwisePermutationsL :: [Array Int Int] #-}

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

genPairwisePermutationsArrL ::
    (Ord a, Enum a, Num a) => Array Int [Array Int a]
genPairwisePermutationsArrL :: forall a. (Ord a, Enum a, Num a) => Array Int [Array Int a]
genPairwisePermutationsArrL = Int -> Array Int [Array Int a]
forall a. (Ord a, Enum a, Num a) => Int -> Array Int [Array Int a]
genPairwisePermutationsArrLN Int
10
{-# INLINE genPairwisePermutationsArrL #-}
{-# SPECIALIZE genPairwisePermutationsArrL :: Array Int [Array Int Int] #-}