Htirage/Random.hs

   1 -- | Extraction d’aléa.
   2 --
   3 -- NOTE: Afin de ne produire que des bits qui ont chacun
   4 -- une probabilité d’un sur deux d’être à 'True' ou à 'False',
   5 -- les fonctions de ce module n’extraient que les bits
   6 -- des combinaisons de rang lexicographique strictement inférieur
   7 -- à la plus grande puissance de 2 inférieure ou égale
   8 -- au nombre de combinaisons possibles.
   9 -- Car il n’y a que @2^n@ combinaisons de @n@ bits.
  10 -- Et que parmi ces combinaisons un bit a une probabilité
  11 -- de @2^(n-1)@ sur @2^n@ soit de @1/2@ d’être à 'True', et autant d’être à 'False'.
  12 module Htirage.Random where
  13
  14 import Data.List
  15
  16 import Htirage.Bits
  17 import Htirage.Combin
  18
  19 -- | @equiprobableBits n@ retourne le nombre maximal de bits de 'i'
  20 -- équiprobables quand @i@ parcourt @[0..n-1]@.
  21 --
  22 -- Ce nombre est le plus grand 'b' dans @[0..]@ tel que @2^b-1 <= n@.
  23 --
  24 -- @
  25 -- 'equiprobableBits' '<$>' [0..17] == [0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4]
  26 -- @
  27 equiprobableBits :: Integer -> Int
  28 equiprobableBits n | n == 2^b-1 = b
  29                    | otherwise  = b-1
  30                    where b = nbBits n
  31
  32 -- | @randomOfCombin n k c@ retourne des bits équiprobables donnés
  33 -- par la combinaison 'c' obtenue par tirage équiprobable
  34 -- d’une combinaison de 'k' entiers parmi @[1..n]@.
  35 --
  36 -- WARNING: aucun bit n’est extrait du tirage 'c'
  37 -- dans le cas où 'c' a un rang lexicographique encodé par
  38 -- un nombre de bits strictement supérieur à @'equiprobableBits' (n`nCk`k)@.
  39 randomOfCombin :: Integer -> Integer -> [Integer] -> [Bool]
  40 randomOfCombin n k xs
  41  | 0<=n, 0<=k, k<=n
  42  , all (\x -> 1<=x&&x<=n) xs
  43  , length (nub xs) == length xs =
  44         if nbBits rank <= epBits
  45         then epBits `bitsOfInteger` rank
  46         else []
  47         where rank   = rankOfCombin n (sort xs)
  48               epBits = equiprobableBits (n`nCk`k)
  49 randomOfCombin _ _ _ = undefined
  50
  51 -- * Aléas publics
  52
  53 -- | @randomOf6aus49 nums numComplementaire@ retourne les bits équiprobables donnés
  54 -- par un tirage du <https://www.lotto.de/de/ergebnisse/lotto-6aus49/archiv.html 6aus49>.
  55 --
  56 -- Il peut produire @26@ bits équiprobables :
  57 -- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`6, 10\`nCk\`1]@
  58 --
  59 -- @
  60 -- 'randomOf6aus49' (1,2,3,4,5,6)      1 == 'replicate' (23+3) False
  61 -- 'randomOf6aus49' (7,14,20,30,37,45) 8 == 'replicate' (23+3) True
  62 --
  63 -- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6) - 1) == [7,14,20,30,37,45]
  64 -- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6))     == [7,14,20,30,37,46]
  65 -- 'randomOf6aus49' (7,14,20,30,37,45) 1 == 'replicate' 23 True ++ 'replicate' 3 False
  66 -- 'randomOf6aus49' (7,14,20,30,37,46) 1 == [False,False,False]
  67 --
  68 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
  69 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1))     == [9]
  70 -- 'randomOf6aus49' (7,14,20,30,37,46) 8 == [True,True,True]
  71 -- 'randomOf6aus49' (7,14,20,30,37,46) 9 == []
  72 -- @
  73 randomOf6aus49 :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
  74 randomOf6aus49 (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 49 6 [n1,n2,n3,n4,n5,n6] ++
  75                                         randomOfCombin 10 1 [nc]
  76
  77 -- | @randomOfEuroMillions nums numComplementaires@ retourne les bits équiprobables donnés
  78 -- par un tirage de l’<https://www.fdj.fr/jeux/jeux-de-tirage/euromillions/resultats EuroMillions>.
  79 --
  80 -- Il peut produire @26@ bits équiprobables :
  81 -- @'sum' $ 'equiprobableBits' '<$>' [50\`nCk\`5, 11\`nCk\`2]@
  82 --
  83 -- @
  84 -- 'randomOfEuroMillions' (1,2,3,4,5)      (1,2) == 'replicate' (21+5) False
  85 -- 'randomOfEuroMillions' (29,36,38,41,48) (1,9) == 'replicate' (21+5) True
  86 --
  87 -- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5) - 1) == [29,36,38,41,48]
  88 -- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5))     == [29,36,38,41,49]
  89 -- 'randomOfEuroMillions' (29,36,38,41,48) (1,2) == 'replicate' 21 True ++ 'replicate' 5 False
  90 -- 'randomOfEuroMillions' (29,36,38,41,49) (1,2) == [False,False,False,False,False]
  91 --
  92 -- 'combinOfRank' 11 2 (2 ^ 'equiprobableBits' (11`nCk`2) - 1) == [4,9]
  93 -- 'combinOfRank' 11 2 (2 ^ 'equiprobableBits' (11`nCk`2))     == [4,10]
  94 -- 'randomOfEuroMillions' (29,36,38,41,49) (1,9)  == [True,True,True,True,True]
  95 -- 'randomOfEuroMillions' (29,36,38,41,49) (1,10) == []
  96 -- @
  97 randomOfEuroMillions :: (Integer,Integer,Integer,Integer,Integer) -> (Integer,Integer) -> [Bool]
  98 randomOfEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) = randomOfCombin 50 5 [n1,n2,n3,n4,n5] ++
  99                                                   randomOfCombin 11 2 [nc1,nc2]
 100
 101 -- | @randomOfFrenchLoto nums numComplementaire@ retourne les bits équiprobables donnés
 102 -- par un tirage du <https://www.fdj.fr/jeux/jeux-de-tirage/loto/resultats/ Loto Français>.
 103 --
 104 -- Il peut produire @23@ bits équiprobables :
 105 -- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`5, 10\`nCk\`1]@
 106 --
 107 -- @
 108 -- 'randomOfFrenchLoto' (1,2,3,4,5)     1 == 'replicate' (20+3) False
 109 -- 'randomOfFrenchLoto' (7,27,36,40,46) 8 == 'replicate' (20+3) True
 110 --
 111 -- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5) - 1) == [7,27,36,40,46]
 112 -- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5))     == [7,27,36,40,47]
 113 -- 'randomOfFrenchLoto' (7,27,36,40,46) 1 == 'replicate' 20 True ++ 'replicate' 3 False
 114 -- 'randomOfFrenchLoto' (7,27,36,40,47) 1 == [False,False,False]
 115 --
 116 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
 117 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1))     == [9]
 118 -- 'randomOfFrenchLoto' (7,27,36,40,47) 8 == [True,True,True]
 119 -- 'randomOfFrenchLoto' (7,27,36,40,47) 9 == []
 120 -- @
 121 randomOfFrenchLoto :: (Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 122 randomOfFrenchLoto (n1,n2,n3,n4,n5) nc = randomOfCombin 49 5 [n1,n2,n3,n4,n5] ++
 123                                          randomOfCombin 10 1 [nc]
 124
 125 -- | @randomOfSwissLoto nums numComplementaire@ retourne les bits équiprobables donnés
 126 -- par un tirage du <https://jeux.loro.ch/FR/1/SwissLoto#action=game-history SwissLoto>.
 127 --
 128 -- Il peut produire @24@ bits équiprobables :
 129 -- @'sum' $ 'equiprobableBits' '<$>' [42\`nCk\`6, 6\`nCk\`1]@
 130 --
 131 -- @
 132 -- 'randomOfSwissLoto' (1,2,3,4,5,6)       1 == 'replicate' (22+2) False
 133 -- 'randomOfSwissLoto' (10,12,25,28,33,38) 4 == 'replicate' (22+2) True
 134 --
 135 -- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6) - 1) == [10,12,25,28,33,38]
 136 -- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6))     == [10,12,25,28,33,39]
 137 -- 'randomOfSwissLoto' (10,12,25,28,33,38) 1 == 'replicate' 22 True ++ 'replicate' 2 False
 138 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 1 == [False,False]
 139 --
 140 -- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1) - 1) == [4]
 141 -- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1))     == [5]
 142 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 4 == [True,True]
 143 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 5 == []
 144 -- @
 145 randomOfSwissLoto :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 146 randomOfSwissLoto (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 42 6 [n1,n2,n3,n4,n5,n6] ++
 147                                            randomOfCombin  6 1 [nc]