-- | Calculs de combinaisons.
module Reloto.Combin where

import Data.Bool
import Data.Eq (Eq(..))
import Data.Foldable (any, sum)
import Data.Int (Int)
import Data.List ((!!), length)
import Data.Ord (Ord(..))
import Prelude (Integral(..), Num(..), pred, undefined)

-- | @'nCk' n k@ retourne le nombre de combinaisons
-- de longueur 'k' d’un ensemble de longueur 'n'.
--
-- Computed using the formula:
-- @'nCk' n (k+1) == 'nCk' n (k-1) * (n-k+1) / k@
nCk :: Integral i => i -> i -> i
i
nnCk :: i -> i -> i
`nCk`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) i -> i -> i
forall a. Integral a => a -> a -> a
`div` i
i)
        -- Use a symmetry to compute over smaller numbers,
        -- which is more efficient and safer
        k' :: i
k' = if i
ni -> i -> i
forall a. Integral a => a -> a -> a
`div`i
2 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
k then i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
k else i
k

-- | @combinOfRank n k r@ retourne les indices de permutation
-- de la combinaison de 'k' entiers parmi @[1..n]@
-- au rang lexicographique 'r' dans @[0..'nCk' n k - 1]@.
-- 
-- Construit chaque choix de la combinaison en prenant le prochain plus grand
-- dont le successeur engendre un nombre de combinaisons
-- qui dépasse le rang restant à atteindre.
--
-- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
combinOfRank :: Integral i => i -> i -> i -> [i]
combinOfRank :: i -> i -> i -> [i]
combinOfRank 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 a. Integral a => a -> a -> a
`nCk`i
ki -> i -> Bool
forall a. Ord a => a -> a -> Bool
<i
rk = [i]
forall a. HasCallStack => a
undefined
                    | Bool
otherwise = i -> i -> i -> [i]
for1K i
1 i
1 i
rk
  where
  for1K :: i -> i -> i -> [i]
for1K i
i i
j i
r | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<  i
k    = i -> i -> i -> [i]
uptoRank i
i i
j i
r
              | i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
k    = [i
ji -> i -> i
forall a. Num a => a -> a -> a
+i
r] -- because when i == k, nbCombs is always 1
              | Bool
otherwise = []
  uptoRank :: i -> i -> i -> [i]
uptoRank i
i i
j i
r | i
nbCombs <- (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
j)i -> i -> i
forall a. Integral a => a -> a -> a
`nCk`(i
ki -> i -> i
forall a. Num a => a -> a -> a
-i
i)
                 , i
nbCombs i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
r = i -> i -> i -> [i]
uptoRank i
i (i
ji -> i -> i
forall a. Num a => a -> a -> a
+i
1) (i
ri -> i -> i
forall a. Num a => a -> a -> a
-i
nbCombs)
                 | Bool
otherwise    = i
j 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
ji -> i -> i
forall a. Num a => a -> a -> a
+i
1) i
r

-- | @rankOfCombin n ns@ retourne le rang lexicographique dans @[0..'nCk' n (length ns) - 1]@
-- de la combinaison 'ns' d’entiers parmi @[1..n]@.
--
-- WARNING: 'ns' doit être triée de manière ascendante.
--
-- Compte le nombre de combinaisons précédant celle de rang 'r'.
--
-- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, pp.24-25
--
-- @
-- 'rankOfCombin' n ('combinOfRank' n k r) == r
-- 'combinOfRank' n ('length' ns) ('rankOfCombin' n ns) == ns
-- @
rankOfCombin :: Integral i => i -> [i] -> i
rankOfCombin :: i -> [i] -> i
rankOfCombin 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
for1K i
1 i
0 i
0 [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))
  for1K :: i -> i -> i -> [i] -> i
for1K i
_ i
r i
_ []      = i
r
  for1K i
i i
r i
x1 (i
x:[i]
xs) = i -> i -> i -> [i] -> i
for1K (i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1) i
r' i
x [i]
xs
    where r' :: i
r' = i
r i -> i -> i
forall a. Num a => a -> a -> a
+ [i] -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ (i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
j)i -> i -> i
forall a. Integral a => a -> a -> a
`nCk`(i
ki -> i -> i
forall a. Num a => a -> a -> a
-i
i)
                       | i
j <- [i
x1i -> i -> i
forall a. Num a => a -> a -> a
+i
1..i
xi -> i -> i
forall a. Num a => a -> a -> a
-i
1]
                       ]

-- | @permute ps xs@ remplace chaque élément de 'ps'
-- par l’élement qu’il indexe dans 'xs' entre @[1..'length' xs]@.
permute :: [Int] -> [a] -> [a]
permute :: [Int] -> [a] -> [a]
permute [Int]
ps [a]
xs = [[a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int -> Int
forall a. Enum a => a -> a
pred Int
p | Int
p <- [Int]
ps]