]> Git — Sourcephile - reloto.git/blob - Htirage/Bits.hs
stack: bump to lts-12.25
[reloto.git] / Htirage / Bits.hs
1 -- | Manipulation de bits.
2 module Htirage.Bits where
3
4 import Data.Bool
5 import Data.Eq (Eq(..))
6 import Data.Int (Int)
7 import Data.List ((++), foldr, length, splitAt, tail)
8 import Data.Ord (Ord(..))
9 import Prelude (Integer, Integral(..), Num(..), error, undefined)
10 import Text.Show (Show(..))
11
12 -- | @bitSize n@ retourne le nombre de bits servant à encoder 'n'.
13 bitSize :: Integer -> Int
14 bitSize n | 0<=n = go n
15 | otherwise = undefined
16 where go 0 = 0
17 go i = 1 + go (i`div`2)
18
19 -- | @integerOfBits bs@ retourne le nombre encodé par les bits 'bs'.
20 integerOfBits :: [Bool] -> Integer
21 integerOfBits [] = 0
22 integerOfBits (b:bs) = integerOfBits bs * 2 + (if b then 1 else 0)
23
24 -- | @bitsOfInteger m n@ retourne les 'm' premiers bits de poids faible
25 -- encodant le nombre 'n'.
26 bitsOfInteger :: Int -> Integer -> [Bool]
27 bitsOfInteger m n | 0<=m,0<=n = go m n
28 | otherwise = undefined
29 where go 0 _ = []
30 go i j = (r==1) : go (i-1) q
31 where (q,r) = j`divMod`2
32
33 -- | @interleaveBits bs@ retourne les bits de @bs@
34 -- en consommant un bit de chaque liste à chaque passe.
35 interleaveBits :: [[Bool]] -> [Bool]
36 interleaveBits [] = []
37 interleaveBits bss =
38 let (hs,ts) = unzip bss in
39 hs ++ interleaveBits ts
40 where
41 unzip = foldr (\bits ~(hs,ts) ->
42 case bits of
43 [] -> (hs,ts)
44 b:bs -> (b:hs,bs:ts)
45 ) ([], [])
46
47 -- | @randomIntOfBits n bs@ retourne le premier entier 'i' formé par les bits 'bs'
48 -- qui a le potentiel d’atteindre un entier dans @[0..n-1]@,
49 -- ou recommence en ignorant le premier bit si @n <= i@.
50 randomIntegerOfBits :: Integer -> [Bool] -> Integer
51 randomIntegerOfBits n bs | given < enough = error (show (enough - given) ++ " bits missing")
52 | n <= i = randomIntegerOfBits n (tail bits ++ bs')
53 | otherwise = i
54 where (bits, bs') = splitAt enough bs
55 i = integerOfBits bits
56 given = length bits
57 enough = bitSize (n - 1)