Htirage/Combin.hs

   1 -- | Calculs de combinaisons.
   2 module Htirage.Combin 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 | n<0||k<0||n<k = undefined
   8         | k > n `div` 2 = go n (n - k) -- more efficient and safe with smaller numbers
   9         | otherwise     = go n k
  10         where go i j | j == 0    = 1
  11                      | otherwise = go i (j-1) * (i-j+1) `div` j
  12
  13 -- | @combinOfRank n k r@ retourne les indices de permutation
  14 -- de la combinaison de 'k' entiers parmi @[1..n]@
  15 -- au rang lexicographique 'r' dans @[0..(n`nCk`k)-1]@.
  16 --
  17 -- Construit chaque choix de la combinaison en prenant le prochain plus grand
  18 -- dont le successeur engendre un nombre de combinaisons
  19 -- qui dépasse le rang restant à atteindre.
  20 --
  21 -- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
  22 combinOfRank :: Integral i => i -> i -> i -> [i]
  23 combinOfRank n k rk | rk<0||n`nCk`k<rk = undefined
  24                     | otherwise = for1K 1 1 rk
  25         where
  26         for1K i j r | i <  k    = uptoRank i j r
  27                     | i == k    = [j+r] -- because when i == k, nbCombs is always 1
  28                     | otherwise = []
  29         uptoRank i j r | nbCombs <- (n-j)`nCk`(k-i)
  30                        , nbCombs <= r = uptoRank i (j+1) (r-nbCombs)
  31                        | otherwise    = j : for1K (i+1) (j+1) r
  32
  33 -- | @rankOfCombin n ns@ retourne le rang lexicographique dans @[0..(n`nCk`length ns)-1]@
  34 -- de la combinaison 'ns' d’entiers parmi @[1..n]@.
  35 --
  36 -- WARNING: 'ns' doit être triée de manière ascendante.
  37 --
  38 -- Compte le nombre de combinaisons précédant celle de rang 'r'.
  39 --
  40 -- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, pp.24-25
  41 --
  42 -- @
  43 -- 'rankOfCombin' n ('combinOfRank' n k r) == r
  44 -- 'combinOfRank' n ('length' ns) ('rankOfCombin' n ns) == ns
  45 -- @
  46 rankOfCombin :: Integral i => i -> [i] -> i
  47 rankOfCombin n ns | any (\x -> x<1||n<x) ns || n<k = undefined
  48                   | otherwise = for1K 1 0 0 ns
  49         where
  50         k = fromInteger (toInteger (length ns))
  51         for1K _ r _ []      = r
  52         for1K i r x1 (x:xs) = for1K (i+1) r' x xs
  53                 where r' = r + sum [ (n-j)`nCk`(k-i)
  54                                    | j <- [x1+1..x-1]
  55                                    ]
  56
  57 -- | @permute ps xs@ remplace chaque élément de 'ps'
  58 -- par l’élement qu’il indexe dans 'xs' entre @[1..'length' xs]@.
  59 permute :: [Int] -> [a] -> [a]
  60 permute ps xs = [xs !! pred p | p <- ps]