--- /dev/null
+*.hi
+*.html
+*.o
+.cabal-sandbox/
+.stack-work/
+bug/
+cabal.sandbox.config
+dist/
+hlint.html
+old/
+stats/
-- | Tirage au sort équiprobable par aléa publiquement vérifiable.
module Htirage
( module Htirage.Bits
- , module Htirage.Combinatorics
+ , module Htirage.Combin
, module Htirage.Draw
- , module Htirage.Entropy
+ , module Htirage.Random
) where
import Htirage.Bits
-import Htirage.Combinatorics
+import Htirage.Combin
import Htirage.Draw
-import Htirage.Entropy
+import Htirage.Random
-- | Manipulation de bits.
module Htirage.Bits where
-import Data.Bits
-import Data.List
-
-import Htirage.Combinatorics
-
-- | @nbBits n@ retourne le nombre de bits servant à encoder 'n'.
-nbBits :: FiniteBits i => i -> Int
-nbBits n = finiteBitSize n - countLeadingZeros n
-
--- | @intOfBits bs@ retourne le nombre encodé par les bits 'bs'.
-intOfBits :: (FiniteBits i, Num i) => [Bool] -> i
-intOfBits bs = foldr (.|.) 0 (zipWith (\i b -> if b then bit i else 0) [0..] bs)
+nbBits :: Integer -> Int
+nbBits n | 0<=n = go n
+ | otherwise = undefined
+ where go 0 = 0
+ go i = 1 + go (i`div`2)
--- | @bitsOfInt m n@ retourne les 'm' premiers bits de poids faible encodant le nombre 'n'.
-bitsOfInt :: FiniteBits i => Int -> i -> [Bool]
-bitsOfInt m n = [testBit n i | i <- [0..m-1]]
+-- | @integerOfBits bs@ retourne le nombre encodé par les bits 'bs'.
+integerOfBits :: [Bool] -> Integer
+integerOfBits [] = 0
+integerOfBits (b:bs) = integerOfBits bs * 2 + (if b then 1 else 0)
--- | @equiprobableBits n@ retourne l’exposant
--- de la plus grande puissance de 2 inférieure ou égale 'n'.
-equiprobableBits :: (FiniteBits i, Num i) => i -> Int
-equiprobableBits n | n == 2 ^ b = b
- | otherwise = b - 1
- where b = nbBits n
+-- | @bitsOfInteger m n@ retourne les 'm' premiers bits de poids faible
+-- encodant le nombre 'n'.
+bitsOfInteger :: Int -> Integer -> [Bool]
+bitsOfInteger m n | 0<=m,0<=n = go m n
+ | otherwise = undefined
+ where go 0 _ = []
+ go i j = (r==1) : go (i-1) q
+ where (q,r) = j`divMod`2
--- | @bitsOfComb n k c@ retourne des bits équiprobables donnés
--- par la combinaison 'c' obtenue par tirage équiprobable
--- d’une combinaison de 'k' entiers parmi @[1..n]@.
---
--- Pour que les bits retournés aient chacun
--- la même probabilité d’être à 'True' ou à 'False',
--- seulement les combinaisons de rang lexicographique inférieur ou égal
--- à la plus grande puissance de 2 inférieure ou égal à @k`combsIn`n@
--- sont considérées comme valides ; les autres donnant des doublons.
---
--- Dans le cas où survient une combinaison invalide,
--- aucun bit n’est extrait du tirage 'c'.
-bitsOfComb :: (FiniteBits i, Integral i) => i -> i -> [i] -> [Bool]
-bitsOfComb n k c =
- case rankOfComb n (sort c) of
- r | nbBits r <= epBits -> epBits `bitsOfInt` r
- _ -> []
- where epBits = equiprobableBits (n`nCk`k)
+-- | @randomIntOfBits n bs@ retourne le premier entier 'i' formé par les bits 'bs'
+-- qui a le potentiel d’atteindre un entier dans @[0..n-1]@,
+-- ou recommence en ignorant le premier bit si @n < i@.
+randomIntegerOfBits :: Integer -> [Bool] -> Integer
+randomIntegerOfBits n bs | given < enough = error (show (enough - given) ++ " bits missing")
+ | n < i = randomIntegerOfBits n (tail bits ++ bs')
+ | otherwise = i
+ where (bits, bs') = splitAt enough bs
+ i = integerOfBits bits
+ given = length bits
+ enough = nbBits n
--- /dev/null
+-- | Calculs de combinaisons.
+module Htirage.Combin where
+
+-- | @n`nCk`k@ retourne le nombre de combinaisons
+-- de longueur 'k' d’un ensemble de longueur 'n'.
+nCk :: Integral i => i -> i -> i
+n`nCk`k | n<0||k<0||n<k = undefined
+ | k > n `div` 2 = go n (n - k) -- more efficient and safe with smaller numbers
+ | otherwise = go n k
+ where go i j | j == 0 = 1
+ | otherwise = go i (j-1) * (i-j+1) `div` j
+
+-- | @combinOfRank n k r@ retourne les indices de permutation
+-- de la combinaison de 'k' entiers parmi @[1..n]@
+-- au rang lexicographique 'r' dans @[0..(n`nCk`k)-1]@.
+--
+-- Construit chaque choix de la combinaison en prenant le prochain plus grand
+-- dont le successeur engendre un nombre de combinaisons
+-- qui dépasse le rang restant à atteindre.
+--
+-- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
+combinOfRank :: Integral i => i -> i -> i -> [i]
+combinOfRank n k rk | rk<0||n`nCk`k<rk = undefined
+ | otherwise = for1K 1 1 rk
+ where
+ for1K i j r | i < k = uptoRank i j r
+ | i == k = [j+r] -- because when i == k, nbCombs is always 1
+ | otherwise = []
+ uptoRank i j r | nbCombs <- (n-j)`nCk`(k-i)
+ , nbCombs <= r = uptoRank i (j+1) (r-nbCombs)
+ | otherwise = j : for1K (i+1) (j+1) r
+
+-- | @rankOfCombin n ns@ retourne le rang lexicographique dans @[0..(n`nCk`length ns)-1]@
+-- de la combinaison 'ns' d’entiers parmi @[1..n]@.
+--
+-- Compte le nombre de combinaisons précédant celle de rang 'r'.
+--
+-- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, pp.24-25
+--
+-- @
+-- 'rankOfCombin' n . 'combinOfRank' n k == 'id'
+-- 'combinOfRank' n k . 'rankOfCombin' n == 'id'
+-- @
+rankOfCombin :: Integral i => i -> [i] -> i
+rankOfCombin n ns | any (\x -> x<1||n<x) ns || n<k = undefined
+ | otherwise = for1K 1 0 0 ns
+ where
+ k = fromInteger (toInteger (length ns))
+ for1K _ r _ [] = r
+ for1K i r x1 (x:xs) = for1K (i+1) r' x xs
+ where r' = r + sum [ (n-j)`nCk`(k-i)
+ | j <- [x1+1..x-1]
+ ]
+
+-- | @permute ps xs@ remplace chaque élément de 'ps'
+-- par l’élement qu’il indexe dans 'xs' entre @[1..'length' xs]@.
+permute :: [Int] -> [a] -> [a]
+permute ps xs = [xs !! pred p | p <- ps]
+++ /dev/null
--- | Calculs combinatoires.
-module Htirage.Combinatorics where
-
--- | @n`nCk`k@ retourne le nombre de combinaisons
--- de longueur 'k' d’un ensemble de longueur 'n'.
-nCk :: Integral i => i -> i -> i
-n`nCk`k | k == 0 = 1
- | k > n `div` 2 = n`nCk`(n - k) -- more efficient and safe with smaller numbers
- | otherwise = (n`nCk`(k - 1)) * (n - k + 1) `div` k
-
--- | @combOfRank n k r@ retourne les indices de permutation
--- de la combinaison de 'k' entiers parmi @[1..n]@
--- au rang lexicographique 'r'.
---
--- Construit chaque choix de la combinaison en prenant le prochain plus petit
--- dont le successeur engendre un nombre de combinaisons
--- qui dépasse le rang restant à atteindre.
---
--- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
-combOfRank :: Integral i => Show i => i -> i -> i -> [i]
-combOfRank n k = for1K 1 1 where
- for1K i j r | i < k = uptoRank i j r
- | i == k = [j+r] -- because when i == k, nbCombs is always 1
- | otherwise = []
- uptoRank i j r | nbCombs <- (n-j)`nCk`(k-i)
- , nbCombs <= r = uptoRank i (j+1) (r-nbCombs)
- | otherwise = j : for1K (i+1) (j+1) r
-
--- | @rankOfComb n ns@ retourne le rang lexicographique
--- de la combinaison 'ns' d’entiers parmi @[1..n]@.
---
--- Compte le nombre de combinaisons précédant celle de rang 'r'.
---
--- DOC: <http://www.site.uottawa.ca/~lucia/courses/5165-09/GenCombObj.pdf>, p.26
---
--- @rankOfComb n . combOfRank n k == id@
--- @combOfRank n k . rankOfComb n == id@
-rankOfComb :: Integral i => i -> [i] -> i
-rankOfComb n ns = for1K 1 0 0 ns where
- k = fromInteger (toInteger (length ns))
- for1K _ r _ [] = r
- for1K i r x1 (x:xs) = for1K (i+1) r' x xs
- where r' = r + sum [ (n-j)`nCk`(k-i)
- | j <- [x1+1..x-1]
- ]
-
--- | @permute ps xs@ remplace chaque élément de 'ps'
--- par l’élement qu’il indexe dans 'xs' entre @[1..length xs]@.
-permute :: [Int] -> [a] -> [a]
-permute ps xs = [xs !! pred p | p <- ps]
-
-{- Implémentations alternatives
-
--- | @n`nAk`k@ retourne le nombre d’arrangements de longueur 'k' d’une liste de longueur 'n'.
-nAk :: Integral i => i -> i -> i
-n`nAk`k = product [n-k+1 .. n]
-
--- | @n`nCk`k@ retourne le nombre de combinaisons
--- de longueur 'k' d’une liste de longueur 'n'.
-nCk :: Integral i => i -> i -> i
-n`nCk`k | k > n `div` 2 = n`nCk`(n-k) -- more efficient with smaller numbers
- | otherwise = n`nAk`k `div` product [1..k]
-
-
--- | @combs k xs@ retourne les combinaisons de longueur 'k' d’une liste 'xs'.
-combs :: Int -> [a] -> [[a]]
-combs 0 _ = [[]]
-combs _ [] = []
-combs k (x:xs) = combs k xs ++
- (x :) `map` combs (k - 1) xs
-
--- | @combs k xs@ retourne les combinaisons
--- de longueur 'k' des éléments de la liste 'xs'.
-combs :: Int -> [a] -> [[a]]
-combs k xs = combsK xs !! (length xs - k)
-
--- | @combsK xs@ retourne toutes les combinaisons
--- de longueur allant de @length xs@ à 0 de la liste 'xs',
---
--- Algorithme dynamique permettant un calcul de 'combs'
--- relativement rapide du fait du partage de 'combsKmoins1'.
-combsK :: [a] -> [[[a]]]
-combsK [] = [[[]]]
-combsK (x : xs) =
- zipWith (++) ([] : combsKmoins1)
- (map (map (x :)) combsKmoins1 ++ [[]])
- where combsKmoins1 = combsK xs
--}
module Htirage.Draw where
import Htirage.Bits
+import Htirage.Combin
--- * Sélection de choix
+-- | @draw1 xs bs@ retourne un choix parmi 'xs' déterminé par l’entropie 'bs'.
+draw1 :: [a] -> [Bool] -> a
+draw1 xs bs = xs !! fromInteger (randomIntegerOfBits (toInteger (length xs - 1)) bs)
--- | @draw1 bs cs@ retourne un choix de la liste de choix 'cs'
--- déterminé par le premier nombre binaire formé par l’entropie 'bs'
--- qui a le potentiel d’atteindre tous les choix,
--- et qui en atteint effectivement un.
-draw1 :: [Bool] -> [a] -> a
-draw1 bs cs
- | given < enough = error (show (enough - given) ++ " missing bits")
- | i > iMax = draw1 (tail bits ++ bs') cs
- | otherwise = cs !! i
- where (bits, bs') = splitAt enough bs
- i = intOfBits bits
- iMax = length cs - 1
- enough = nbBits iMax
- given = length bs
-
-{-
--- | @drawComb k cs ns@ retourne les 'k' choix parmi 'cs', déterminés par les bits 'bs'.
-drawComb :: Int -> [a] -> [Bool] -> [a]
-drawComb k cs bs = draw1 bs (k`combs'Dyn`cs)
-drawComb k cs bs =
- | given < enough = error (show (enough - given) ++ " missing bits")
- | i > iMax = drawComb k (tail bits ++ bs') cs
- | otherwise = combOfRank k n i `applyPerm` cs
- where (bits, bs') = splitAt enough bs
- n = length cs
- i = intOfBits bits
- iMax = pred n
- enough = nbBits iMax
- given = length bs
--}
-{-
-pr l = putStrLn (foldMap (\x -> show x ++ " ") l)
-
-res = forM_ (zipWith (,) [0..] $ allCombsB 5 9) (\(i,l) -> putStr (show i ++ ": ") >> pr l)
-allCombsB k n = combAt'Buckles k n <$> [0..k`combsIn`n - 1]
--}
+-- | @drawMany xs k bs@ retourne 'k' choix (sans répétition) parmi 'xs'
+-- déterminés par l’entropie 'bs'.
+drawMany :: [a] -> Integer -> [Bool] -> [a]
+drawMany xs k bs = (fromInteger <$> combinOfRank n k r) `permute` xs
+ where n = toInteger (length xs)
+ r = randomIntegerOfBits ((n`nCk`k) - 1) bs
+++ /dev/null
--- | Extractions d’entropie publique.
---
--- NOTE: Afin de ne produire que des bits
--- qui ont chacun une probabilité d’un sur deux d’être à 'True' ou à 'False',
--- les fonctions de ce module n’extraient que les bits
--- des combinaisons de rang lexicographique inférieur ou égal
--- à la plus grande puissance de 2 inférieure ou égale
--- au nombre de combinaisons possibles.
--- Car il n’y a que @2^n@ combinaisons de @n@ bits.
--- Et que parmi ces combinaisons un bit
--- a une probabilité de @2^(n-1)@ sur @2^n@ soit de @1/2@ d’être à 'True',
--- et autant d’être à 'False'.
-module Htirage.Entropy where
-
-import Htirage.Bits
-
--- | @bitsOfLOTO nums numComplementaire@ retourne les bits équiprobables donnés
--- par un tirage du <https://www.fdj.fr/jeux/jeux-de-tirage/loto/resultats/ LOTO Français>.
---
--- Il peut produire @23@ bits équiprobables :
--- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`5, 10\`nCk\`1 ::Int]@
-bitsOfLOTO :: (Int,Int,Int,Int,Int) -> Int -> [Bool]
-bitsOfLOTO (n1,n2,n3,n4,n5) nc =
- bitsOfComb 49 5 [n1,n2,n3,n4,n5] ++
- bitsOfComb 10 1 [nc]
-
--- | @bitsOfSwissLOTO nums numComplementaire@ retourne les bits équiprobables donnés
--- par un tirage du <https://jeux.loro.ch/FR/1/SwissLoto#action=game-history SwissLOTO>.
---
--- Il peut produire @24@ bits équiprobables :
--- @'sum' $ 'equiprobableBits' '<$>' [42\`nCk\`6, 6\`nCk\`1 ::Int]@
-bitsOfSwissLOTO :: (Int,Int,Int,Int,Int,Int) -> Int -> [Bool]
-bitsOfSwissLOTO (n1,n2,n3,n4,n5,n6) nc =
- bitsOfComb 42 6 [n1,n2,n3,n4,n5,n6] ++
- bitsOfComb 6 1 [nc]
-
--- | @bitsOfSwissLOTO nums numComplementaires@ retourne les bits équiprobables donnés
--- par un tirage de l’<https://www.fdj.fr/jeux/jeux-de-tirage/euromillions/resultats EuroMillions>.
---
--- Il peut produire @26@ bits équiprobables :
--- @'sum' $ 'equiprobableBits' '<$>' [50\`nCk\`5, 11\`nCk\`2 ::Int]@
-bitsOfEuroMillions :: (Int,Int,Int,Int,Int) -> (Int,Int) -> [Bool]
-bitsOfEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) =
- bitsOfComb 50 5 [n1,n2,n3,n4,n5] ++
- bitsOfComb 11 2 [nc1,nc2]
-
--- | @bitsOf6aus49 nums numComplementaire@ retourne les bits équiprobables donnés
--- par un tirage du <https://www.lotto.de/de/ergebnisse/lotto-6aus49/archiv.html 6aus49>.
---
--- Il peut produire @26@ bits équiprobables :
--- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`6, 10\`nCk\`1 ::Int]@
-bitsOf6aus49 :: (Int,Int,Int,Int,Int,Int) -> Int -> [Bool]
-bitsOf6aus49 (n1,n2,n3,n4,n5,n6) nc =
- bitsOfComb 49 6 [n1,n2,n3,n4,n5,n6] ++
- bitsOfComb 10 1 [nc]
--- /dev/null
+-- | Extraction d’aléa.
+--
+-- NOTE: Afin de ne produire que des bits qui ont chacun
+-- une probabilité d’un sur deux d’être à 'True' ou à 'False',
+-- les fonctions de ce module n’extraient que les bits
+-- des combinaisons de rang lexicographique strictement inférieur
+-- à la plus grande puissance de 2 inférieure ou égale
+-- au nombre de combinaisons possibles.
+-- Car il n’y a que @2^n@ combinaisons de @n@ bits.
+-- Et que parmi ces combinaisons un bit a une probabilité
+-- de @2^(n-1)@ sur @2^n@ soit de @1/2@ d’être à 'True', et autant d’être à 'False'.
+module Htirage.Random where
+
+import Data.List
+
+import Htirage.Bits
+import Htirage.Combin
+
+-- | @equiprobableBits n@ retourne le nombre maximal de bits de 'i'
+-- équiprobables quand @i@ parcourt @[0..n-1]@.
+--
+-- Ce nombre est le plus grand 'b' dans @[0..]@ tel que @2^b-1 <= n@.
+--
+-- @
+-- 'equiprobableBits' '<$>' [0..17] == [0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4]
+-- @
+equiprobableBits :: Integer -> Int
+equiprobableBits n | n == 2^b-1 = b
+ | otherwise = b-1
+ where b = nbBits n
+
+-- | @randomOfCombin n k c@ retourne des bits équiprobables donnés
+-- par la combinaison 'c' obtenue par tirage équiprobable
+-- d’une combinaison de 'k' entiers parmi @[1..n]@.
+--
+-- WARNING: aucun bit n’est extrait du tirage 'c'
+-- dans le cas où 'c' a un rang lexicographique encodé par
+-- un nombre de bits strictement supérieur à @'equiprobableBits' (n`nCk`k)@.
+randomOfCombin :: Integer -> Integer -> [Integer] -> [Bool]
+randomOfCombin n k xs
+ | 0<=n, 0<=k, k<=n
+ , all (\x -> 1<=x&&x<=n) xs
+ , length (nub xs) == length xs =
+ if nbBits rank <= epBits
+ then epBits `bitsOfInteger` rank
+ else []
+ where rank = rankOfCombin n (sort xs)
+ epBits = equiprobableBits (n`nCk`k)
+randomOfCombin _ _ _ = undefined
+
+-- * Aléas publics
+
+-- | @randomOf6aus49 nums numComplementaire@ retourne les bits équiprobables donnés
+-- par un tirage du <https://www.lotto.de/de/ergebnisse/lotto-6aus49/archiv.html 6aus49>.
+--
+-- Il peut produire @26@ bits équiprobables :
+-- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`6, 10\`nCk\`1]@
+--
+-- @
+-- 'randomOf6aus49' (1,2,3,4,5,6) 1 == 'replicate' (23+3) False
+-- 'randomOf6aus49' (7,14,20,30,37,45) 8 == 'replicate' (23+3) True
+--
+-- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6) - 1) == [7,14,20,30,37,45]
+-- 'combinOfRank' 49 6 (2 ^ 'equiprobableBits' (49`nCk`6)) == [7,14,20,30,37,46]
+-- 'randomOf6aus49' (7,14,20,30,37,45) 1 == 'replicate' 23 True ++ 'replicate' 3 False
+-- 'randomOf6aus49' (7,14,20,30,37,46) 1 == [False,False,False]
+--
+-- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
+-- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1)) == [9]
+-- 'randomOf6aus49' (7,14,20,30,37,46) 8 == [True,True,True]
+-- 'randomOf6aus49' (7,14,20,30,37,46) 9 == []
+-- @
+randomOf6aus49 :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
+randomOf6aus49 (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 49 6 [n1,n2,n3,n4,n5,n6] ++
+ randomOfCombin 10 1 [nc]
+
+-- | @randomOfEuroMillions nums numComplementaires@ retourne les bits équiprobables donnés
+-- par un tirage de l’<https://www.fdj.fr/jeux/jeux-de-tirage/euromillions/resultats EuroMillions>.
+--
+-- Il peut produire @26@ bits équiprobables :
+-- @'sum' $ 'equiprobableBits' '<$>' [50\`nCk\`5, 11\`nCk\`2]@
+--
+-- @
+-- 'randomOfEuroMillions' (1,2,3,4,5) (1,2) == 'replicate' (21+5) False
+-- 'randomOfEuroMillions' (29,36,38,41,48) (1,9) == 'replicate' (21+5) True
+--
+-- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5) - 1) == [29,36,38,41,48]
+-- 'combinOfRank' 50 5 (2 ^ 'equiprobableBits' (50`nCk`5)) == [29,36,38,41,49]
+-- 'randomOfEuroMillions' (29,36,38,41,48) (1,2) == 'replicate' 21 True ++ 'replicate' 5 False
+-- 'randomOfEuroMillions' (29,36,38,41,49) (1,2) == [False,False,False,False,False]
+--
+-- 'combinOfRank' 11 2 (2 ^ 'equiprobableBits' (11`nCk`2) - 1) == [4,9]
+-- 'combinOfRank' 11 2 (2 ^ 'equiprobableBits' (11`nCk`2)) == [4,10]
+-- 'randomOfEuroMillions' (29,36,38,41,49) (1,9) == [True,True,True,True,True]
+-- 'randomOfEuroMillions' (29,36,38,41,49) (1,10) == []
+-- @
+randomOfEuroMillions :: (Integer,Integer,Integer,Integer,Integer) -> (Integer,Integer) -> [Bool]
+randomOfEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) = randomOfCombin 50 5 [n1,n2,n3,n4,n5] ++
+ randomOfCombin 11 2 [nc1,nc2]
+
+-- | @randomOfFrenchLoto nums numComplementaire@ retourne les bits équiprobables donnés
+-- par un tirage du <https://www.fdj.fr/jeux/jeux-de-tirage/loto/resultats/ Loto Français>.
+--
+-- Il peut produire @23@ bits équiprobables :
+-- @'sum' $ 'equiprobableBits' '<$>' [49\`nCk\`5, 10\`nCk\`1]@
+--
+-- @
+-- 'randomOfFrenchLoto' (1,2,3,4,5) 1 == 'replicate' (20+3) False
+-- 'randomOfFrenchLoto' (7,27,36,40,46) 8 == 'replicate' (20+3) True
+--
+-- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5) - 1) == [7,27,36,40,46]
+-- 'combinOfRank' 49 5 (2 ^ 'equiprobableBits' (49`nCk`5)) == [7,27,36,40,47]
+-- 'randomOfFrenchLoto' (7,27,36,40,46) 1 == 'replicate' 20 True ++ 'replicate' 3 False
+-- 'randomOfFrenchLoto' (7,27,36,40,47) 1 == [False,False,False]
+--
+-- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1) - 1) == [8]
+-- 'combinOfRank' 10 1 (2 ^ 'equiprobableBits' (10`nCk`1)) == [9]
+-- 'randomOfFrenchLoto' (7,27,36,40,47) 8 == [True,True,True]
+-- 'randomOfFrenchLoto' (7,27,36,40,47) 9 == []
+-- @
+randomOfFrenchLoto :: (Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
+randomOfFrenchLoto (n1,n2,n3,n4,n5) nc = randomOfCombin 49 5 [n1,n2,n3,n4,n5] ++
+ randomOfCombin 10 1 [nc]
+
+-- | @randomOfSwissLoto nums numComplementaire@ retourne les bits équiprobables donnés
+-- par un tirage du <https://jeux.loro.ch/FR/1/SwissLoto#action=game-history SwissLoto>.
+--
+-- Il peut produire @24@ bits équiprobables :
+-- @'sum' $ 'equiprobableBits' '<$>' [42\`nCk\`6, 6\`nCk\`1]@
+--
+-- @
+-- 'randomOfSwissLoto' (1,2,3,4,5,6) 1 == 'replicate' (22+2) False
+-- 'randomOfSwissLoto' (10,12,25,28,33,38) 4 == 'replicate' (22+2) True
+--
+-- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6) - 1) == [10,12,25,28,33,38]
+-- 'combinOfRank' 42 6 (2 ^ 'equiprobableBits' (42`nCk`6)) == [10,12,25,28,33,39]
+-- 'randomOfSwissLoto' (10,12,25,28,33,38) 1 == 'replicate' 22 True ++ 'replicate' 2 False
+-- 'randomOfSwissLoto' (10,12,25,28,33,39) 1 == [False,False]
+--
+-- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1) - 1) == [4]
+-- 'combinOfRank' 6 1 (2 ^ 'equiprobableBits' (6`nCk`1)) == [5]
+-- 'randomOfSwissLoto' (10,12,25,28,33,39) 4 == [True,True]
+-- 'randomOfSwissLoto' (10,12,25,28,33,39) 5 == []
+-- @
+randomOfSwissLoto :: (Integer,Integer,Integer,Integer,Integer,Integer) -> Integer -> [Bool]
+randomOfSwissLoto (n1,n2,n3,n4,n5,n6) nc = randomOfCombin 42 6 [n1,n2,n3,n4,n5,n6] ++
+ randomOfCombin 6 1 [nc]
--- /dev/null
+Tutoriel de htirage
+===================
+
+On commence par les entêtes nécessaires au compilateur :
+
+> {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+> module Htirage.Tutorial where
+> import Htirage
+> import Data.List (sort)
+
+
+2 parmi 5
+---------
+
+Pour sélectionner 2 choix parmi 5 (ordonnés lexicographiquement) :
+
+> x0 = sort ["dominique", "claude", "baya", "zhennan", "camille"]
+> n0 = length x0
+> k0 = 2
+
+Il faut au moins c0 == 3 bits équiprobables :
+
+> c0 = equiprobableBits (toInteger n0`nCk`k0)
+
+Ce tirage de lotterie en procure length b0 == 23:
+
+> b0 = randomOf6aus49 (39,2,19,41,6,30) 9
+
+Et on obtient s0 == ["baya","claude"] :
+
+> s0 = drawMany x0 k0 b0
+
+
+
+42 parmi 100
+------------
+
+Pour sélectionner 42 choix parmi 100 :
+
+> n1 = 100
+> k1 = 42
+
+Il faut au moins c1 == 94 bits équiprobables :
+
+> c1 = equiprobableBits (n1`nCk`k1)
+
+Ces quatres tirages de lotterie en procurent length b1 == 97 :
+
+> b1 = randomOf6aus49 (27,2,12,34,22,19) 1 ++
+> randomOfEuroMillions (5,14,35,16,10) (2,7) ++
+> randomOfFrenchLoto (14,8,26,3,24) 2 ++
+> randomOfSwissLoto (17,2,29,37,30,25) 5
+
+Et on obtient s1 == [1,8,9,10,11,12,17,19,20,21,25,26,28,32,35,37,46,50
+ ,51,52,54,55,57,60,61,63,65,66,67,69,70,73,74,75,78
+ ,80,83,87,89,90,92,97]
+
+> s1 = drawMany [1..n1] k1 b1
stability: experimental
synopsis: Equiprobable draw from publicly verifiable random data.
tested-with: GHC==8.0.2
-version: 1.20170719
+version: 1.20170723
source-repository head
location: git://git.autogeree.net/htirage
exposed-modules:
Htirage
Htirage.Bits
- Htirage.Combinatorics
+ Htirage.Combin
Htirage.Draw
- Htirage.Entropy
+ Htirage.Random
+ Htirage.Tutorial
default-language: Haskell2010
default-extensions:
ghc-options: -Wall -fno-warn-tabs
sourcephile / git / reloto.git / commitdiff