-- | Calculs d’arrangements.
module Reloto.Sequence where

import Data.Bool
import Data.Foldable (any, foldr)
import Data.Functor ((<$>))
import Data.List (length)
import Data.Ord (Ord(..))
import Prelude (Integral(..), Num(..), undefined)

-- | @'nAk' n k@ retourne le nombre de combinaisons
-- de longueur 'k' d’un ensemble de longueur 'n'.
nAk :: Integral i => i -> i -> i
i
nnAk :: i -> i -> i
`nAk`i
k | i
ni -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
0Bool -> Bool -> Bool
||i
ki -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
0Bool -> Bool -> Bool
||i
ni -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
k = i
forall a. HasCallStack => a
undefined
        | Bool
otherwise     = i -> i -> i
go i
1 i
1
        where
        go :: i -> i -> i
go i
i i
acc = if i
k i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i then i
acc else i -> i -> i
go (i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1) (i
acc i -> i -> i
forall a. Num a => a -> a -> a
* (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1))

sequenceOfRank :: Integral i => i -> i -> i -> [i]
sequenceOfRank :: i -> i -> i -> [i]
sequenceOfRank i
n i
k i
rk | i
rki -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
0Bool -> Bool -> Bool
||i
ni -> i -> i
forall i. Integral i => i -> i -> i
`nAk`i
ki -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
rk = [i]
forall a. HasCallStack => a
undefined
                      | Bool
otherwise = [i] -> [i]
shiftPositions (i -> i -> i -> [i]
for1K i
1 i
rk (i
ni -> i -> i
forall i. Integral i => i -> i -> i
`nAk`i
k))
  where
  for1K :: i -> i -> i -> [i]
for1K i
i i
r i
a =
    if i
k i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i then []
    else i
qi -> i -> i
forall a. Num a => a -> a -> a
+i
1 i -> [i] -> [i]
forall a. a -> [a] -> [a]
: i -> i -> i -> [i]
for1K (i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1) i
r' i
a'
    where
    -- Optimized computation of: n-i`nAk`k-i
    a' :: i
a' = i
a i -> i -> i
forall i. Integral i => i -> i -> i
`div` (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1)
    -- Greatest multiple of 'a' lower or equal to the rank 'r',
    -- and the remaining of the rank
    (i
q, i
r') = i
r i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
`divMod` i
a'
  shiftPositions :: [i] -> [i]
shiftPositions = -- Promote the positions in the good interval.
    (i -> [i] -> [i]) -> [i] -> [i] -> [i]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\i
x [i]
acc -> i
x i -> [i] -> [i]
forall a. a -> [a] -> [a]
: ((\i
x' -> if i
x' i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
x then i
x'i -> i -> i
forall a. Num a => a -> a -> a
+i
1 else i
x') (i -> i) -> [i] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [i]
acc)) []

rankOfSequence :: Integral i => i -> [i] -> i
rankOfSequence :: i -> [i] -> i
rankOfSequence i
n [i]
ns | (i -> Bool) -> [i] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\i
x -> i
xi -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
1Bool -> Bool -> Bool
||i
ni -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
x) [i]
ns Bool -> Bool -> Bool
|| i
ni -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
k = i
forall a. HasCallStack => a
undefined
                    | Bool
otherwise = i -> i -> i -> [i] -> i
for0K i
1 i
0 (i
ni -> i -> i
forall i. Integral i => i -> i -> i
`nAk`i
k) [i]
ns
  where
  k :: i
k = Integer -> i
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
ns))
  for0K :: i -> i -> i -> [i] -> i
for0K i
_ i
r i
_ []     = i
r
  for0K i
i i
r i
a (i
x:[i]
xs) = i -> i -> i -> [i] -> i
for0K (i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1) i
r' i
a' [i]
xs'
    where
    -- Optimized computation of: n-i`nAk`k-i
    a' :: i
a' = i
a i -> i -> i
forall i. Integral i => i -> i -> i
`div` (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1)
    -- Next rank
    r' :: i
r' = i
r i -> i -> i
forall a. Num a => a -> a -> a
+ (i
xi -> i -> i
forall a. Num a => a -> a -> a
-i
1) i -> i -> i
forall a. Num a => a -> a -> a
* i
a'
    xs' :: [i]
xs' = (\i
x' -> if i
x i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
x' then i
x'i -> i -> i
forall a. Num a => a -> a -> a
-i
1 else i
x') (i -> i) -> [i] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [i]
xs