Htirage/Combinatorics.hs

   1 -- | Calculs combinatoires.
   2 module Htirage.Combinatorics where
   3
   4 -- | @n`nCk`k@ retourne le nombre de combinaisons
   5 -- de longueur 'k' d’un ensemble de longueur 'n'.
   6 nCk :: Integral i => i -> i -> i
   7 n`nCk`k | k == 0        = 1
   8         | k > n `div` 2 = n`nCk`(n - k) -- more efficient and safe with smaller numbers
   9         | otherwise     = (n`nCk`(k - 1)) * (n - k + 1) `div` k
  10
  11 -- | @combOfRank n k r@ retourne les indices de permutation
  12 -- de la combinaison de 'k' entiers parmi @[1..n]@
  13 -- au rang lexicographique 'r'.
  14 --
  15 -- Construit chaque choix de la combinaison en prenant le prochain plus petit
  16 -- dont le successeur engendre un nombre de combinaisons
  17 -- qui dépasse le rang restant à atteindre.
  18 --
  19 -- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
  20 combOfRank :: Integral i => Show i => i -> i -> i -> [i]
  21 combOfRank n k = for1K 1 1 where
  22         for1K i j r | i <  k    = uptoRank i j r
  23                     | i == k    = [j+r] -- because when i == k, nbCombs is always 1
  24                     | otherwise = []
  25         uptoRank i j r | nbCombs <- (n-j)`nCk`(k-i)
  26                        , nbCombs <= r = uptoRank i (j+1) (r-nbCombs)
  27                        | otherwise    = j : for1K (i+1) (j+1) r
  28
  29 -- | @rankOfComb n ns@ retourne le rang lexicographique
  30 -- de la combinaison 'ns' d’entiers parmi @[1..n]@.
  31 --
  32 -- Compte le nombre de combinaisons précédant celle de rang 'r'.
  33 --
  34 -- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
  35 --
  36 -- @rankOfComb n . combOfRank n k == id@
  37 -- @combOfRank n k . rankOfComb n == id@
  38 rankOfComb :: Integral i => i -> [i] -> i
  39 rankOfComb n ns = for1K 1 0 0 ns where
  40         k = fromInteger (toInteger (length ns))
  41         for1K _ r _ []      = r
  42         for1K i r x1 (x:xs) = for1K (i+1) r' x xs
  43                 where r' = r + sum [ (n-j)`nCk`(k-i)
  44                                    | j <- [x1+1..x-1]
  45                                    ]
  46
  47 -- | @permute ps xs@ remplace chaque élément de 'ps'
  48 -- par l’élement qu’il indexe dans 'xs' entre @[1..length xs]@.
  49 permute :: [Int] -> [a] -> [a]
  50 permute ps xs = [xs !! pred p | p <- ps]
  51
  52 {- Implémentations alternatives
  53
  54 -- | @n`nAk`k@ retourne le nombre d’arrangements de longueur 'k' d’une liste de longueur 'n'.
  55 nAk :: Integral i => i -> i -> i
  56 n`nAk`k = product [n-k+1 .. n]
  57
  58 -- | @n`nCk`k@ retourne le nombre de combinaisons
  59 -- de longueur 'k' d’une liste de longueur 'n'.
  60 nCk :: Integral i => i -> i -> i
  61 n`nCk`k | k > n `div` 2 = n`nCk`(n-k) -- more efficient with smaller numbers
  62         | otherwise     = n`nAk`k `div` product [1..k]
  63
  64
  65 -- | @combs k xs@ retourne les combinaisons de longueur 'k' d’une liste 'xs'.
  66 combs :: Int -> [a] -> [[a]]
  67 combs 0 _      = [[]]
  68 combs _ []     = []
  69 combs k (x:xs) = combs k xs ++
  70                  (x :) `map` combs (k - 1) xs
  71
  72 -- | @combs k xs@ retourne les combinaisons
  73 -- de longueur 'k' des éléments de la liste 'xs'.
  74 combs :: Int -> [a] -> [[a]]
  75 combs k xs = combsK xs !! (length xs - k)
  76
  77 -- | @combsK xs@ retourne toutes les combinaisons
  78 -- de longueur allant de @length xs@ à 0 de la liste 'xs',
  79 --
  80 -- Algorithme dynamique permettant un calcul de 'combs'
  81 -- relativement rapide du fait du partage de 'combsKmoins1'.
  82 combsK :: [a] -> [[[a]]]
  83 combsK [] = [[[]]]
  84 combsK (x : xs) =
  85         zipWith (++) ([] : combsKmoins1)
  86                      (map (map (x :)) combsKmoins1 ++ [[]])
  87         where combsKmoins1 = combsK xs
  88 -}