{- |
Description: Error correction codes
Copyright: Copyright (C) 2021 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Some solutions to "Problems.P51" of Ninety-Nine Haskell "Problems".
-}
module Solutions.P51 (corrupt, errorCorrectingEncode, errorCorrectingDecode) where

import           Data.List     (nub, sort)
import           System.Random

{- |
Flip a given number of boolean values in the boolean list randomly.
-}
corrupt :: RandomGen g => g -> Int -> [Bool] -> [Bool]
corrupt :: forall g. RandomGen g => g -> Int -> [Bool] -> [Bool]
corrupt g
gen Int
n [Bool]
s = Int -> [Int] -> [Bool] -> [Bool]
corrupt' Int
0 [Int]
positions [Bool]
s
  where n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
s
        positions :: [Int]
positions = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n' ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> g -> [Int]
forall g. RandomGen g => (Int, Int) -> g -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0, [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
gen

corrupt' :: Int -> [Int] -> [Bool] -> [Bool]
corrupt' :: Int -> [Int] -> [Bool] -> [Bool]
corrupt' Int
_ [Int]
_ [] = []
corrupt' Int
_ [] [Bool]
s = [Bool]
s
corrupt' Int
offset ps :: [Int]
ps@(Int
n:[Int]
ns) (Bool
c:[Bool]
cs)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset = Bool -> Bool
not Bool
c Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Bool] -> [Bool]
corrupt' (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
ns [Bool]
cs
  | Bool
otherwise   = Bool
c Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Bool] -> [Bool]
corrupt' (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
ps [Bool]
cs

{- |
Construct an error-correcting encoding of the given Boolean list.

Uses a reptition code of length 3.
-}
errorCorrectingEncode :: [Bool] -> [Bool]
errorCorrectingEncode :: [Bool] -> [Bool]
errorCorrectingEncode [] = []
errorCorrectingEncode (Bool
False : [Bool]
xs) = Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool]
errorCorrectingEncode [Bool]
xs
errorCorrectingEncode (Bool
True : [Bool]
xs) = Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool]
errorCorrectingEncode [Bool]
xs

{- |
The inverse of 'errorCorrectingEncode'.
Recover the original Boolean list from its encoding.
There could be an error in the encoding.
-}
errorCorrectingDecode :: [Bool] -> [Bool]
errorCorrectingDecode :: [Bool] -> [Bool]
errorCorrectingDecode []        = []
errorCorrectingDecode (Bool
a:Bool
b:Bool
c:[Bool]
l) = (Bool, Bool, Bool) -> Bool
vote (Bool
a,Bool
b,Bool
c) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool] -> [Bool]
errorCorrectingDecode [Bool]
l
errorCorrectingDecode [Bool
a,Bool
b]     = [(Bool, Bool, Bool) -> Bool
vote (Bool
a,Bool
b,Bool
False)]  -- arbitrarily bias to False when bit missing
errorCorrectingDecode [Bool
a]       = [Bool
a]

vote :: (Bool, Bool, Bool) -> Bool
vote :: (Bool, Bool, Bool) -> Bool
vote (Bool
a, Bool
b, Bool
c)
  | Int
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Bool
True
  | Bool
otherwise        = Bool
False
  where a' :: Int
a' = Bool -> Int
toCount Bool
a
        b' :: Int
b' = Bool -> Int
toCount Bool
b
        c' :: Int
c' = Bool -> Int
toCount Bool
c
        toCount :: Bool -> Int
toCount Bool
False = Int
0 :: Int
        toCount Bool
True  = Int
1 :: Int