]> Git — Sourcephile - reloto.git/blob - Htirage/Sequence.hs
90abaa8e35aba0f0d94f422ec83f8ea7a0f96a74
[reloto.git] / Htirage / Sequence.hs
1 -- | Calculs d’arrangements.
2 module Htirage.Sequence where
3
4 import Data.Bool
5 import Data.Foldable (any, foldr)
6 import Data.Functor ((<$>))
7 import Data.List (length)
8 import Data.Ord (Ord(..))
9 import Prelude (Integral(..), Num(..), undefined)
10
11 -- | @'nAk' n k@ retourne le nombre de combinaisons
12 -- de longueur 'k' d’un ensemble de longueur 'n'.
13 nAk :: Integral i => i -> i -> i
14 n`nAk`k | n<0||k<0||n<k = undefined
15 | otherwise = go 1 1
16 where
17 go i acc = if k < i then acc else go (i+1) (acc * (n-i+1))
18
19 sequenceOfRank :: Integral i => i -> i -> i -> [i]
20 sequenceOfRank n k rk | rk<0||n`nAk`k<rk = undefined
21 | otherwise = shiftPositions (for1K 1 rk (n`nAk`k))
22 where
23 for1K i r a =
24 if k < i then []
25 else q+1 : for1K (i+1) r' a'
26 where
27 -- Optimized computation of: n-i`nAk`k-i
28 a' = a `div` (n-i+1)
29 -- Greatest multiple of 'a' lower or equal to the rank 'r',
30 -- and the remaining of the rank
31 (q, r') = r `divMod` a'
32 shiftPositions = -- Promote the positions in the good interval.
33 foldr (\x acc -> x : ((\x' -> if x' >= x then x'+1 else x') <$> acc)) []
34
35 rankOfSequence :: Integral i => i -> [i] -> i
36 rankOfSequence n ns | any (\x -> x<1||n<x) ns || n<k = undefined
37 | otherwise = for0K 1 0 (n`nAk`k) ns
38 where
39 k = fromInteger (toInteger (length ns))
40 for0K _ r _ [] = r
41 for0K i r a (x:xs) = for0K (i+1) r' a' xs'
42 where
43 -- Optimized computation of: n-i`nAk`k-i
44 a' = a `div` (n-i+1)
45 -- Next rank
46 r' = r + (x-1) * a'
47 xs' = (\x' -> if x < x' then x'-1 else x') <$> xs