ArrMini1.hs

{-# 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 n = listArray (0,l-1) xs
 where xs = pairsSwapP1 . take n $ [0..]
       l = length xs
{-# INLINE genPairwisePermutations1 #-}

pairsSwapP1 :: [Int] -> [[Int]]
pairsSwapP1 xs = xs:[swap2Ls1 k m xs | k <- xs, m <- xs , abs (k - m) > 1] `mappend` [swap2Ls1 k (k - 1) xs | k <- drop 1 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 k n m
 | n > k =
    if
      | m < k -> m
      | m > n -> m
      | m >= k && m < n -> m + 1
      | otherwise -> k
 | otherwise =
     if
       | m > k -> m
       | m < n -> m
       | m <= k && m > n -> m - 1
       | otherwise -> k
{-# INLINE swap2ns1 #-}

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

genPairwisePermutationsArrN1 :: Int -> Array Int (Array Int [Int])
genPairwisePermutationsArrN1 n = amap genPairwisePermutations1 . listArray (0,n - 2) $ [2..n]
{-# INLINE genPairwisePermutationsArrN1 #-}

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

genPairwisePermutationsLN1 :: Int -> [Array Int Int]
genPairwisePermutationsLN1 n = map (\xs -> listArray (0,n - 1) xs) . pairsSwapP1 . take n $ [0..]
{-# INLINE genPairwisePermutationsLN1 #-}

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

genPairwisePermutationsArrLN1 :: Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN1 n = amap genPairwisePermutationsLN1 . listArray (0,n - 2) $ [2..n]
{-# INLINE genPairwisePermutationsArrLN1 #-}

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