{-# 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 #-}