{-# LANGUAGE MultiWayIf #-}

-- |
-- Module      :  Phonetic.Languages.Permutations.ArrMini1
-- Copyright   :  (c) OleksandrZhabenko 2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Special permutations functions for the phonetic-languages series of packages. This
-- module uses no vectors, but instead uses arrays.

module Phonetic.Languages.Permutations.ArrMini1 (
  genPairwisePermutations1
  , pairsSwapP1
  , genPairwisePermutationsArrN1
  , genPairwisePermutationsArr1
  , genPairwisePermutationsLN1
  , genPairwisePermutationsL1
  , genPairwisePermutationsArrLN1
  , genPairwisePermutationsArrL1
) where

import GHC.Arr

genPairwisePermutations1 :: Int -> Array Int [Int]
genPairwisePermutations1 :: Int -> Array Int [Int]
genPairwisePermutations1 Int
n = (Int, Int) -> [[Int]] -> Array Int [Int]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [[Int]]
xs
 where xs :: [[Int]]
xs = [Int] -> [[Int]]
pairsSwapP1 ([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] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int
0..]
       l :: Int
l = [[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
xs
{-# INLINE genPairwisePermutations1 #-}

pairsSwapP1 :: [Int] -> [[Int]]
pairsSwapP1 :: [Int] -> [[Int]]
pairsSwapP1 [Int]
xs = [Int]
xs[Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:[Int -> Int -> [Int] -> [Int]
swap2Ls1 Int
k Int
m [Int]
xs | Int
k <- [Int]
xs, Int
m <- [Int]
xs , Int -> Int
forall a. Num a => a -> a
abs (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1] [[Int]] -> [[Int]] -> [[Int]]
forall a. Monoid a => a -> a -> a
`mappend` [Int -> Int -> [Int] -> [Int]
swap2Ls1 Int
k (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
xs | Int
k <- Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
xs ]
{-# INLINABLE pairsSwapP1 #-}

-- | The first two arguments are considered not equal and all three of the arguments are considered greater or equal to 0, though it is not checked.
swap2ns1 :: Int -> Int -> Int -> Int
swap2ns1 :: Int -> Int -> Int -> Int
swap2ns1 Int
k Int
n Int
m
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
k =
    if
      | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k -> Int
m
      | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n -> Int
m
      | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n -> Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      | Bool
otherwise -> Int
k
 | Bool
otherwise =
     if
       | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
k -> Int
m
       | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n -> Int
m
       | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n -> Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
       | Bool
otherwise -> Int
k
{-# INLINE swap2ns1 #-}

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

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

genPairwisePermutationsArr1 :: Array Int (Array Int [Int])
genPairwisePermutationsArr1 :: Array Int (Array Int [Int])
genPairwisePermutationsArr1 = Int -> Array Int (Array Int [Int])
genPairwisePermutationsArrN1 Int
10
{-# INLINE genPairwisePermutationsArr1 #-}

genPairwisePermutationsLN1 :: Int -> [Array Int Int]
genPairwisePermutationsLN1 :: Int -> [Array Int Int]
genPairwisePermutationsLN1 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]]
pairsSwapP1 ([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 genPairwisePermutationsLN1 #-}

genPairwisePermutationsL1 :: [Array Int Int]
genPairwisePermutationsL1 :: [Array Int Int]
genPairwisePermutationsL1 = Int -> [Array Int Int]
genPairwisePermutationsLN1 Int
10
{-# INLINE genPairwisePermutationsL1 #-}

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

genPairwisePermutationsArrL1 :: Array Int [Array Int Int]
genPairwisePermutationsArrL1 :: Array Int [Array Int Int]
genPairwisePermutationsArrL1 = Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN1 Int
10
{-# INLINE genPairwisePermutationsArrL1 #-}