]> Git — Sourcephile - reloto.git/blob - Htirage/Random.hs
024d5dc78a621b0d1db5584fcc5e816c2302546d
[reloto.git] / 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]