-- | Tirage au sort par aléa équiprobable publiquement vérifiable.
-- GPL-3, (c) 2017-07-19 Julien Moutinho \<julm+htirage@autogeree.net>
module Htirage where

import Data.Bits
import Data.List

-- * Sélection de choix

-- | @select1 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.
select1 :: [Bool] -> [a] -> a
select1 bs cs
 | given < enough = error (show (enough - given) ++ " missing bits")
 | i > iMax       = select1 (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

-- | @selectKCombN k cs ns@ retourne les 'k' choix parmi 'cs', déterminés par les bits 'bs'.
selectKCombN :: Int -> [a] -> [Bool] -> [a]
selectKCombN k cs bs = select1 bs (k`combs`cs)

-- * Dénombrement

-- ** Arrangements

-- | @nbArrs k n@ retourne le nombre d’arrangements de longueur 'k' d’une liste de longueur 'n'.
nbArrs :: Int -> Int -> Int
k `nbArrs` n = product [n-k+1 .. n]

-- ** Combinaisons

-- | @nbCombs k n@ retourne le nombre de combinaisons de longueur 'k' d’une liste de longueur 'n'.
nbCombs :: Int -> Int -> Int
k `nbCombs` n = (k `nbArrs` n) `div` product [1..k]

-- | @combs k n@ retourne les combinaisons de longueur 'k' d’une liste 'n'.
combs :: Int -> [a] -> [[a]]
combs k n = combsK n !! k

-- | @combsK n@ retourne les combinaisons de longueur inférieure ou égale à 'n' d’une liste 'n'.
-- 
-- 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

-- * Manipulation de bits

-- | @nbBits n@ retourne le nombre de bits servant à encoder 'n'.
nbBits :: Int -> Int
nbBits n = finiteBitSize n - countLeadingZeros n

-- | @intOfBits bs@ retourne le nombre encodé par les bits 'bs'.
intOfBits :: [Bool] -> Int
intOfBits bs = foldr (.|.) 0 (zipWith (\i b -> if b then bit i else 0) [0..] bs)

-- | @bitsOfInt m n@ retourne les 'm' premiers bits de poids faible encodant le nombre 'n'.
bitsOfInt :: Int -> Int -> [Bool]
bitsOfInt m n = [testBit n i | i <- [0..m-1]]

-- * Extraction d’entropie publique

-- | @equiProbableBitsKCombN k n c@ retourne les bits équiprobables donnés
-- par la combinaison 'c' obtenue par tirage équiprobable
-- d’une combinaison de 'k' éléments parmi 'n'.
-- 
-- Pour que les bits retournés aient chacun
-- la même probabilité d’être à 'True' ou à 'False',
-- seulement 2 puissance 'equiProbableBits'
-- de ces combinaisons sont considérées comme valides ;
-- les autres donnant des doublons quand on ne considère
-- que les 'equiProbableBits' bits de poids faible
-- de leur position dans la liste des combinaisons retournée par 'combs'.
--
-- Dans le cas où survient une combinaison invalide,
-- aucun bit n’est extrait du tirage 'c'.
equiProbableBitsKCombN :: Int -> Int -> [Int] -> [Bool]
equiProbableBitsKCombN k n c =
	case elemIndex (sort c) (k`combs`[1..n]) of
	 Just i | nbBits i <= equiProbableBits -> equiProbableBits `bitsOfInt` i
	 _ -> []
	where equiProbableBits = nbBits (k`nbCombs`n) - 1

-- | @equiProbableBitsLOTO 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>.
equiProbableBitsLOTO :: (Int,Int,Int,Int,Int) -> Int -> [Bool]
equiProbableBitsLOTO (n1,n2,n3,n4,n5) nc =
	equiProbableBitsKCombN 5 49 [n1,n2,n3,n4,n5] ++
	equiProbableBitsKCombN 1 10 [nc]

-- | @equiProbableBitsSwissLOTO nums numComplementaire@ retourne les bits équiprobables donnés
-- par un tirage du <https://jeux.loro.ch/FR/1/SwissLoto#action=game-history SwissLOTO>.
equiProbableBitsSwissLOTO :: (Int,Int,Int,Int,Int,Int) -> Int -> [Bool]
equiProbableBitsSwissLOTO (n1,n2,n3,n4,n5,n6) nc =
	equiProbableBitsKCombN 6 42 [n1,n2,n3,n4,n5,n6] ++
	equiProbableBitsKCombN 1 6 [nc]

-- | @equiProbableBitsSwissLOTO nums numComplementaires@ retourne les bits équiprobables donnés
-- par un tirage de l’<https://www.fdj.fr/jeux/jeux-de-tirage/euromillions/resultats EuroMillions>.
equiProbableBitsEuroMillions :: (Int,Int,Int,Int,Int) -> (Int,Int) -> [Bool]
equiProbableBitsEuroMillions (n1,n2,n3,n4,n5) (nc1,nc2) =
	equiProbableBitsKCombN 5 50 [n1,n2,n3,n4,n5] ++
	equiProbableBitsKCombN 2 11 [nc1,nc2]

-- | @equiProbableBits6aus49 nums numComplementaire@ retourne les bits équiprobables donnés
-- par un tirage du <https://www.lotto.de/de/ergebnisse/lotto-6aus49/archiv.html 6aus49>.
equiProbableBits6aus49 :: (Int,Int,Int,Int,Int,Int) -> Int -> [Bool]
equiProbableBits6aus49 (n1,n2,n3,n4,n5,n6) nc =
	equiProbableBitsKCombN 6 49 [n1,n2,n3,n4,n5,n6] ++
	equiProbableBitsKCombN 1 10 [nc]