{-# LANGUAGE NoImplicitPrelude #-}

-- |
-- Module      :  Phladiprelio.PermutationsArrMini
-- Copyright   :  (c) OleksandrZhabenko 2021-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Special permutations functions for the phonetic-languages series of packages. This
-- module uses no vectors, but instead uses arrays.

module Phladiprelio.PermutationsArrMini (
  genPairwisePermutations
  , pairsSwapP
  , genPairwisePermutationsArrN
  , genPairwisePermutationsArr
  , genPairwisePermutationsLN
  , genPairwisePermutationsL
  , genPairwisePermutationsArrLN
  , genPairwisePermutationsArrL
) where

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

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

pairsSwapP :: [Int] -> [[Int]]
pairsSwapP :: [Int] -> [[Int]]
pairsSwapP [Int]
xs = [Int]
xsforall a. a -> [a] -> [a]
:[Int -> Int -> [Int] -> [Int]
swap2Ls Int
k Int
m [Int]
xs | Int
k <- [Int]
xs, Int
m <- [Int]
xs , Int
k forall a. Ord a => a -> a -> Bool
< Int
m]
{-# INLINABLE pairsSwapP #-}

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

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

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

genPairwisePermutationsArr :: Array Int (Array Int [Int])
genPairwisePermutationsArr :: Array Int (Array Int [Int])
genPairwisePermutationsArr = Int -> Array Int (Array Int [Int])
genPairwisePermutationsArrN Int
10
{-# INLINE genPairwisePermutationsArr #-}

genPairwisePermutationsLN :: Int -> [Array Int Int]
genPairwisePermutationsLN :: Int -> [Array Int Int]
genPairwisePermutationsLN 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
. [Int] -> [[Int]]
pairsSwapP 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 genPairwisePermutationsLN #-}

genPairwisePermutationsL :: [Array Int Int]
genPairwisePermutationsL :: [Array Int Int]
genPairwisePermutationsL = Int -> [Array Int Int]
genPairwisePermutationsLN Int
10
{-# INLINE genPairwisePermutationsL #-}

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

genPairwisePermutationsArrL :: Array Int [Array Int Int]
genPairwisePermutationsArrL :: Array Int [Array Int Int]
genPairwisePermutationsArrL = Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN Int
10
{-# INLINE genPairwisePermutationsArrL #-}