{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}

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

Permutations data type to mark the needed permutations type from the other modules.
-}
module Aftovolio.PermutationsRepresent (
    PermutationsType (..),
    bTransform2Perms,
    permChoose
) where

import GHC.Base
import Text.Show
import Aftovolio.PermutationsArr
import Aftovolio.PermutationsArrMini1
import Aftovolio.PermutationsArrMini2
import Aftovolio.PermutationsArrMini
import GHC.Arr 

data PermutationsType = P Int deriving (PermutationsType -> PermutationsType -> Bool
(PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> Eq PermutationsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PermutationsType -> PermutationsType -> Bool
== :: PermutationsType -> PermutationsType -> Bool
$c/= :: PermutationsType -> PermutationsType -> Bool
/= :: PermutationsType -> PermutationsType -> Bool
Eq, Eq PermutationsType
Eq PermutationsType =>
(PermutationsType -> PermutationsType -> Ordering)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> PermutationsType)
-> (PermutationsType -> PermutationsType -> PermutationsType)
-> Ord PermutationsType
PermutationsType -> PermutationsType -> Bool
PermutationsType -> PermutationsType -> Ordering
PermutationsType -> PermutationsType -> PermutationsType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PermutationsType -> PermutationsType -> Ordering
compare :: PermutationsType -> PermutationsType -> Ordering
$c< :: PermutationsType -> PermutationsType -> Bool
< :: PermutationsType -> PermutationsType -> Bool
$c<= :: PermutationsType -> PermutationsType -> Bool
<= :: PermutationsType -> PermutationsType -> Bool
$c> :: PermutationsType -> PermutationsType -> Bool
> :: PermutationsType -> PermutationsType -> Bool
$c>= :: PermutationsType -> PermutationsType -> Bool
>= :: PermutationsType -> PermutationsType -> Bool
$cmax :: PermutationsType -> PermutationsType -> PermutationsType
max :: PermutationsType -> PermutationsType -> PermutationsType
$cmin :: PermutationsType -> PermutationsType -> PermutationsType
min :: PermutationsType -> PermutationsType -> PermutationsType
Ord)

instance Show PermutationsType where
    show :: PermutationsType -> String
show (P Int
x) = String
"+P " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Int -> String
forall a. Show a => a -> String
show Int
x

bTransform2Perms :: [String] -> PermutationsType
bTransform2Perms :: [String] -> PermutationsType
bTransform2Perms [String]
ys
    | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"1"] = Int -> PermutationsType
P Int
1
    | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"2"] = Int -> PermutationsType
P Int
2
    | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"3"] = Int -> PermutationsType
P Int
3
    | Bool
otherwise = Int -> PermutationsType
P Int
0

permChoose :: PermutationsType -> Int -> [Array Int Int]
permChoose :: PermutationsType -> Int -> [Array Int Int]
permChoose PermutationsType
permType
    | PermutationsType
permType PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
0 = Int -> [Array Int Int]
forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPermutationsL
    | PermutationsType
permType PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
1 = Int -> [Array Int Int]
forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genElementaryPermutationsLN1
    | PermutationsType
permType PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> [Array Int Int]
forall a. (Ord a, Enum a, Num a) => Int -> [Array Int a]
genPairwisePermutationsLN
    | PermutationsType
permType PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
3 = Int -> [Array Int Int]
genDoublePermutationsLN2