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.Bool
  15 import Data.Eq (Eq(..))
  16 import Data.Foldable (all)
  17 import Data.Int (Int)
  18 import Data.List ((++), length, nub, sort)
  19 import Data.Ord (Ord(..))
  20 import Prelude (Integer, Num(..), undefined, (^))
  21
  22 import Htirage.Bits
  23 import Htirage.Combin
  24 import Htirage.Sequence
  25
  26 -- | @equiprobableBits n@ retourne le nombre maximal de bits de 'i'
  27 -- équiprobables quand @i@ parcourt @[0..n-1]@.
  28 --
  29 -- Ce nombre est le plus grand 'b' dans @[0..]@ tel que @2^b-1 <= n@.
  30 --
  31 -- @
  32 -- 'equiprobableBits' '<$>' [0..17] == [0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4]
  33 -- @
  34 equiprobableBits :: Integer -> Int
  35 equiprobableBits n | n == 2^b-1 = b
  36                    | otherwise  = b-1
  37                    where b = bitSize n
  38
  39 -- | @randomOfCombin n k c@ retourne des bits équiprobables donnés
  40 -- par la combinaison 'c' obtenue par tirage équiprobable
  41 -- d’une combinaison de 'k' entiers parmi @[1..n]@.
  42 --
  43 -- WARNING: aucun bit n’est extrait du tirage 'c'
  44 -- dans le cas où 'c' a un rang lexicographique encodé par
  45 -- un nombre de bits strictement supérieur à @'equiprobableBits' (n`nCk`k)@.
  46 randomOfCombin :: Integer -> Integer -> [Integer] -> [Bool]
  47 randomOfCombin n k xs
  48  | 0<=n, 0<=k, k<=n
  49  , all (\x -> 1<=x&&x<=n) xs
  50  , length (nub xs) == length xs =
  51         if bitSize rank <= epBits
  52         then epBits `bitsOfInteger` rank
  53         else []
  54         where rank   = rankOfCombin n (sort xs)
  55               epBits = equiprobableBits (n`nCk`k)
  56 randomOfCombin _ _ _ = undefined
  57
  58 -- | @randomOfSequence n k a@ retourne des bits équiprobables donnés
  59 -- par l’arrangement 'a' obtenue par tirage équiprobable
  60 -- d’une combinaison de 'k' entiers parmi @[1..n]@.
  61 --
  62 -- WARNING: aucun bit n’est extrait du tirage 'a'
  63 -- dans le cas où 'a' a un rang lexicographique encodé par
  64 -- un nombre de bits strictement supérieur à @'equiprobableBits' (n`nAk`k)@.
  65 randomOfSequence :: Integer -> Integer -> [Integer] -> [Bool]
  66 randomOfSequence n k xs
  67  | 0<=n, 0<=k, k<=n
  68  , all (\x -> 1<=x&&x<=n) xs
  69  , length (nub xs) == length xs =
  70         if bitSize rank <= epBits
  71         then epBits `bitsOfInteger` rank
  72         else []
  73         where rank   = rankOfSequence n (sort xs)
  74               epBits = equiprobableBits (n`nAk`k)
  75 randomOfSequence _ _ _ = undefined
  76
  77 -- * Aléas publics
  78
  79 -- | @randomOf6aus49 nums numComplementaire@ retourne les bits équiprobables donnés
  80 -- par un tirage du <https://www.lotto.de/de/ergebnisse/lotto-6aus49/archiv.html 6aus49>.
  81 --
  82 -- Il peut produire @26@ bits équiprobables :
  83 -- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`6, 10\`nCk\`1]@
  84 --
  85 -- @
  86 -- 'randomOf6aus49' (1,2,3,4,5,6)      1 == 'replicate' (23+3) False
  87 -- 'randomOf6aus49' (7,14,20,30,37,45) 8 == 'replicate' (23+3) True
  88 --
  89 -- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6) - 1) == [7,14,20,30,37,45]
  90 -- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6))     == [7,14,20,30,37,46]
  91 -- 'randomOf6aus49' (7,14,20,30,37,45) 1 == 'replicate' 23 True ++ 'replicate' 3 False
  92 -- 'randomOf6aus49' (7,14,20,30,37,46) 1 == [False,False,False]
  93 --
  94 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
  95 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1))     == [9]
  96 -- 'randomOf6aus49' (7,14,20,30,37,46) 8 == [True,True,True]
  97 -- 'randomOf6aus49' (7,14,20,30,37,46) 9 == []
  98 -- @
  99 randomOf6aus49 :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 100 randomOf6aus49 (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 49 6 [n1,n2,n3,n4,n5,n6] ++
 101                                         randomOfCombin 10 1 [nc]
 102
 103 -- | @randomOfEuroMillions nums numComplementaires@ retourne les bits équiprobables donnés
 104 -- par un tirage de l’<https://www.fdj.fr/jeux/jeux-de-tirage/euromillions/resultats EuroMillions>.
 105 --
 106 -- Il peut produire @27@ bits équiprobables :
 107 -- @'sum' $ 'equiprobableBits' '<$>' [50\`nCk\`5, 12\`nCk\`2]@
 108 --
 109 -- @
 110 -- 'randomOfEuroMillions' (1,2,3,4,5)      (1,2) == 'replicate' (21+5) False
 111 -- 'randomOfEuroMillions' (29,36,38,41,48) (1,9) == 'replicate' (21+5) True
 112 --
 113 -- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5) - 1) == [29,36,38,41,48]
 114 -- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5))     == [29,36,38,41,49]
 115 -- 'randomOfEuroMillions' (29,36,38,41,48) (1,2) == 'replicate' 21 True ++ 'replicate' 6 False
 116 -- 'randomOfEuroMillions' (29,36,38,41,49) (1,2) == [False,False,False,False,False,False]
 117 --
 118 -- 'combinOfRank' 12 2 (2 ^ 'equiprobableBits' (12`nCk`2) - 1) == [10,11]
 119 -- 'combinOfRank' 12 2 (2 ^ 'equiprobableBits' (12`nCk`2))     == [10,12]
 120 -- 'randomOfEuroMillions' (29,36,38,41,49) (10,11)  == [True,True,True,True,True,True]
 121 -- 'randomOfEuroMillions' (29,36,38,41,49) (10,12) == []
 122 -- @
 123 randomOfEuroMillions :: (Integer,Integer,Integer,Integer,Integer) -> (Integer,Integer) -> [Bool]
 124 randomOfEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) = randomOfCombin 50 5 [n1,n2,n3,n4,n5] ++
 125                                                   randomOfCombin 12 2 [nc1,nc2]
 126 randomOfOrderedEuroMillions :: (Integer,Integer,Integer,Integer,Integer) -> (Integer,Integer) -> [Bool]
 127 randomOfOrderedEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) = randomOfSequence 50 5 [n1,n2,n3,n4,n5] ++
 128                                                          randomOfSequence 12 2 [nc1,nc2]
 129
 130 -- | @randomOfFrenchLoto nums numComplementaire@ retourne les bits équiprobables donnés
 131 -- par un tirage du <https://www.fdj.fr/jeux/jeux-de-tirage/loto/resultats/ Loto Français>.
 132 --
 133 -- Il peut produire @23@ bits équiprobables :
 134 -- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`5, 10\`nCk\`1]@
 135 --
 136 -- @
 137 -- 'randomOfFrenchLoto' (1,2,3,4,5)     1 == 'replicate' (20+3) False
 138 -- 'randomOfFrenchLoto' (7,27,36,40,46) 8 == 'replicate' (20+3) True
 139 --
 140 -- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5) - 1) == [7,27,36,40,46]
 141 -- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5))     == [7,27,36,40,47]
 142 -- 'randomOfFrenchLoto' (7,27,36,40,46) 1 == 'replicate' 20 True ++ 'replicate' 3 False
 143 -- 'randomOfFrenchLoto' (7,27,36,40,47) 1 == [False,False,False]
 144 --
 145 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
 146 -- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1))     == [9]
 147 -- 'randomOfFrenchLoto' (7,27,36,40,47) 8 == [True,True,True]
 148 -- 'randomOfFrenchLoto' (7,27,36,40,47) 9 == []
 149 -- @
 150 randomOfFrenchLoto :: (Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 151 randomOfFrenchLoto (n1,n2,n3,n4,n5) nc = randomOfCombin 49 5 [n1,n2,n3,n4,n5] ++
 152                                          randomOfCombin 10 1 [nc]
 153 randomOfOrderedFrenchLoto :: (Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 154 randomOfOrderedFrenchLoto (n1,n2,n3,n4,n5) nc = randomOfSequence 49 5 [n1,n2,n3,n4,n5] ++
 155                                                 randomOfSequence 10 1 [nc]
 156
 157 -- | @randomOfSwissLoto nums numComplementaire@ retourne les bits équiprobables donnés
 158 -- par un tirage du <https://jeux.loro.ch/FR/1/SwissLoto#action=game-history SwissLoto>.
 159 --
 160 -- Il peut produire @24@ bits équiprobables :
 161 -- @'sum' $ 'equiprobableBits' '<$>' [42\`nCk\`6, 6\`nCk\`1]@
 162 --
 163 -- @
 164 -- 'randomOfSwissLoto' (1,2,3,4,5,6)       1 == 'replicate' (22+2) False
 165 -- 'randomOfSwissLoto' (10,12,25,28,33,38) 4 == 'replicate' (22+2) True
 166 --
 167 -- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6) - 1) == [10,12,25,28,33,38]
 168 -- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6))     == [10,12,25,28,33,39]
 169 -- 'randomOfSwissLoto' (10,12,25,28,33,38) 1 == 'replicate' 22 True ++ 'replicate' 2 False
 170 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 1 == [False,False]
 171 --
 172 -- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1) - 1) == [4]
 173 -- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1))     == [5]
 174 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 4 == [True,True]
 175 -- 'randomOfSwissLoto' (10,12,25,28,33,39) 5 == []
 176 -- @
 177 randomOfSwissLoto :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
 178 randomOfSwissLoto (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 42 6 [n1,n2,n3,n4,n5,n6] ++
 179                                            randomOfCombin  6 1 [nc]