{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}

module Math.Linear.GF2 where

import Data.Bits
import qualified Data.List as L
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import GHC.Exts (IsList (Item, fromList, toList))

{- |
\(GF(2)^{64}\)

bitwise xor

+---+---+---+
| + | 0 | 1 |
+---+---+---+
| 0 | 0 | 1 |
+---+---+---+
| 1 | 1 | 0 |
+---+---+---+

bitwise and

+---+---+---+
| * | 0 | 1 |
+---+---+---+
| 0 | 0 | 0 |
+---+---+---+
| 1 | 0 | 1 |
+---+---+---+
-}
newtype GF2x64 = GF2x64 {GF2x64 -> Word
getGF2x64 :: Word}
  deriving newtype (GF2x64 -> GF2x64 -> Bool
(GF2x64 -> GF2x64 -> Bool)
-> (GF2x64 -> GF2x64 -> Bool) -> Eq GF2x64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GF2x64 -> GF2x64 -> Bool
== :: GF2x64 -> GF2x64 -> Bool
$c/= :: GF2x64 -> GF2x64 -> Bool
/= :: GF2x64 -> GF2x64 -> Bool
Eq, Eq GF2x64
Eq GF2x64 =>
(GF2x64 -> GF2x64 -> Ordering)
-> (GF2x64 -> GF2x64 -> Bool)
-> (GF2x64 -> GF2x64 -> Bool)
-> (GF2x64 -> GF2x64 -> Bool)
-> (GF2x64 -> GF2x64 -> Bool)
-> (GF2x64 -> GF2x64 -> GF2x64)
-> (GF2x64 -> GF2x64 -> GF2x64)
-> Ord GF2x64
GF2x64 -> GF2x64 -> Bool
GF2x64 -> GF2x64 -> Ordering
GF2x64 -> GF2x64 -> GF2x64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GF2x64 -> GF2x64 -> Ordering
compare :: GF2x64 -> GF2x64 -> Ordering
$c< :: GF2x64 -> GF2x64 -> Bool
< :: GF2x64 -> GF2x64 -> Bool
$c<= :: GF2x64 -> GF2x64 -> Bool
<= :: GF2x64 -> GF2x64 -> Bool
$c> :: GF2x64 -> GF2x64 -> Bool
> :: GF2x64 -> GF2x64 -> Bool
$c>= :: GF2x64 -> GF2x64 -> Bool
>= :: GF2x64 -> GF2x64 -> Bool
$cmax :: GF2x64 -> GF2x64 -> GF2x64
max :: GF2x64 -> GF2x64 -> GF2x64
$cmin :: GF2x64 -> GF2x64 -> GF2x64
min :: GF2x64 -> GF2x64 -> GF2x64
Ord, Eq GF2x64
GF2x64
Eq GF2x64 =>
(GF2x64 -> GF2x64 -> GF2x64)
-> (GF2x64 -> GF2x64 -> GF2x64)
-> (GF2x64 -> GF2x64 -> GF2x64)
-> (GF2x64 -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> GF2x64
-> (Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> Bool)
-> (GF2x64 -> Maybe Int)
-> (GF2x64 -> Int)
-> (GF2x64 -> Bool)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int -> GF2x64)
-> (GF2x64 -> Int)
-> Bits GF2x64
Int -> GF2x64
GF2x64 -> Bool
GF2x64 -> Int
GF2x64 -> Maybe Int
GF2x64 -> GF2x64
GF2x64 -> Int -> Bool
GF2x64 -> Int -> GF2x64
GF2x64 -> GF2x64 -> GF2x64
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: GF2x64 -> GF2x64 -> GF2x64
.&. :: GF2x64 -> GF2x64 -> GF2x64
$c.|. :: GF2x64 -> GF2x64 -> GF2x64
.|. :: GF2x64 -> GF2x64 -> GF2x64
$cxor :: GF2x64 -> GF2x64 -> GF2x64
xor :: GF2x64 -> GF2x64 -> GF2x64
$ccomplement :: GF2x64 -> GF2x64
complement :: GF2x64 -> GF2x64
$cshift :: GF2x64 -> Int -> GF2x64
shift :: GF2x64 -> Int -> GF2x64
$crotate :: GF2x64 -> Int -> GF2x64
rotate :: GF2x64 -> Int -> GF2x64
$czeroBits :: GF2x64
zeroBits :: GF2x64
$cbit :: Int -> GF2x64
bit :: Int -> GF2x64
$csetBit :: GF2x64 -> Int -> GF2x64
setBit :: GF2x64 -> Int -> GF2x64
$cclearBit :: GF2x64 -> Int -> GF2x64
clearBit :: GF2x64 -> Int -> GF2x64
$ccomplementBit :: GF2x64 -> Int -> GF2x64
complementBit :: GF2x64 -> Int -> GF2x64
$ctestBit :: GF2x64 -> Int -> Bool
testBit :: GF2x64 -> Int -> Bool
$cbitSizeMaybe :: GF2x64 -> Maybe Int
bitSizeMaybe :: GF2x64 -> Maybe Int
$cbitSize :: GF2x64 -> Int
bitSize :: GF2x64 -> Int
$cisSigned :: GF2x64 -> Bool
isSigned :: GF2x64 -> Bool
$cshiftL :: GF2x64 -> Int -> GF2x64
shiftL :: GF2x64 -> Int -> GF2x64
$cunsafeShiftL :: GF2x64 -> Int -> GF2x64
unsafeShiftL :: GF2x64 -> Int -> GF2x64
$cshiftR :: GF2x64 -> Int -> GF2x64
shiftR :: GF2x64 -> Int -> GF2x64
$cunsafeShiftR :: GF2x64 -> Int -> GF2x64
unsafeShiftR :: GF2x64 -> Int -> GF2x64
$crotateL :: GF2x64 -> Int -> GF2x64
rotateL :: GF2x64 -> Int -> GF2x64
$crotateR :: GF2x64 -> Int -> GF2x64
rotateR :: GF2x64 -> Int -> GF2x64
$cpopCount :: GF2x64 -> Int
popCount :: GF2x64 -> Int
Bits, Bits GF2x64
Bits GF2x64 =>
(GF2x64 -> Int)
-> (GF2x64 -> Int) -> (GF2x64 -> Int) -> FiniteBits GF2x64
GF2x64 -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: GF2x64 -> Int
finiteBitSize :: GF2x64 -> Int
$ccountLeadingZeros :: GF2x64 -> Int
countLeadingZeros :: GF2x64 -> Int
$ccountTrailingZeros :: GF2x64 -> Int
countTrailingZeros :: GF2x64 -> Int
FiniteBits)

{- |
>>> show (GF2x64 10)
"0b1010"
>>> show (GF2x64 0)
"0b0"
-}
instance Show GF2x64 where
  show :: GF2x64 -> String
show (GF2x64 Word
0) = String
"0b0"
  show (GF2x64 Word
x0) = String
"0b" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
reverse ((Word -> Maybe (Char, Word)) -> Word -> String
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr Word -> Maybe (Char, Word)
next Word
x0)
    where
      next :: Word -> Maybe (Char, Word)
      next :: Word -> Maybe (Char, Word)
next Word
0 = Maybe (Char, Word)
forall a. Maybe a
Nothing
      next Word
x
        | Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word
x Int
0 = (Char, Word) -> Maybe (Char, Word)
forall a. a -> Maybe a
Just (Char
'1', Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR Word
x Int
1)
        | Bool
otherwise = (Char, Word) -> Maybe (Char, Word)
forall a. a -> Maybe a
Just (Char
'0', Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR Word
x Int
1)

instance Num GF2x64 where
  + :: GF2x64 -> GF2x64 -> GF2x64
(+) = GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
xor
  (-) = GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
xor
  * :: GF2x64 -> GF2x64 -> GF2x64
(*) = GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
(.&.)
  negate :: GF2x64 -> GF2x64
negate = GF2x64 -> GF2x64
forall a. a -> a
id
  abs :: GF2x64 -> GF2x64
abs = GF2x64 -> GF2x64
forall a. a -> a
id
  signum :: GF2x64 -> GF2x64
signum = GF2x64 -> GF2x64 -> GF2x64
forall a b. a -> b -> a
const (GF2x64 -> GF2x64
forall a. Bits a => a -> a
complement GF2x64
forall a. Bits a => a
zeroBits)
  fromInteger :: Integer -> GF2x64
fromInteger = Word -> GF2x64
GF2x64 (Word -> GF2x64) -> (Integer -> Word) -> Integer -> GF2x64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word
forall a. Num a => Integer -> a
fromInteger

-- | subspace of \(GF(2)^{64}\)
newtype GF2x64' = GF2x64' {GF2x64' -> Vector GF2x64
basisGF2x64' :: U.Vector GF2x64}
  deriving newtype (Int -> GF2x64' -> ShowS
[GF2x64'] -> ShowS
GF2x64' -> String
(Int -> GF2x64' -> ShowS)
-> (GF2x64' -> String) -> ([GF2x64'] -> ShowS) -> Show GF2x64'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GF2x64' -> ShowS
showsPrec :: Int -> GF2x64' -> ShowS
$cshow :: GF2x64' -> String
show :: GF2x64' -> String
$cshowList :: [GF2x64'] -> ShowS
showList :: [GF2x64'] -> ShowS
Show)

instance Eq GF2x64' where
  GF2x64'
xs == :: GF2x64' -> GF2x64' -> Bool
== GF2x64'
ys =
    GF2x64' -> Int
rankGF2x64' GF2x64'
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== GF2x64' -> Int
rankGF2x64' GF2x64'
ys
      Bool -> Bool -> Bool
&& (GF2x64 -> Bool) -> Vector GF2x64 -> Bool
forall a. Unbox a => (a -> Bool) -> Vector a -> Bool
U.all (GF2x64 -> GF2x64' -> Bool
`inGF2x64'` GF2x64'
xs) (GF2x64' -> Vector GF2x64
basisGF2x64' GF2x64'
ys)

instance IsList GF2x64' where
  type Item GF2x64' = GF2x64
  fromList :: [Item GF2x64'] -> GF2x64'
fromList = Vector GF2x64 -> GF2x64'
spanGF2x64' (Vector GF2x64 -> GF2x64')
-> ([GF2x64] -> Vector GF2x64) -> [GF2x64] -> GF2x64'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GF2x64] -> Vector GF2x64
forall a. Unbox a => [a] -> Vector a
U.fromList
  toList :: GF2x64' -> [Item GF2x64']
toList = Vector GF2x64 -> [GF2x64]
forall a. Unbox a => Vector a -> [a]
U.toList (Vector GF2x64 -> [GF2x64])
-> (GF2x64' -> Vector GF2x64) -> GF2x64' -> [GF2x64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GF2x64' -> Vector GF2x64
basisGF2x64'

zeroGF2x64' :: GF2x64'
zeroGF2x64' :: GF2x64'
zeroGF2x64' = Vector GF2x64 -> GF2x64'
GF2x64' Vector GF2x64
forall a. Unbox a => Vector a
U.empty

-- | /O(1)/
rankGF2x64' :: GF2x64' -> Int
rankGF2x64' :: GF2x64' -> Int
rankGF2x64' = Vector GF2x64 -> Int
forall a. Unbox a => Vector a -> Int
U.length (Vector GF2x64 -> Int)
-> (GF2x64' -> Vector GF2x64) -> GF2x64' -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GF2x64' -> Vector GF2x64
basisGF2x64'

-- | /O(d)/
inGF2x64' :: GF2x64 -> GF2x64' -> Bool
inGF2x64' :: GF2x64 -> GF2x64' -> Bool
inGF2x64' GF2x64
v (GF2x64' Vector GF2x64
bs) =
  (GF2x64 -> GF2x64 -> GF2x64) -> GF2x64 -> Vector GF2x64 -> GF2x64
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
U.foldl' (\GF2x64
x GF2x64
b -> GF2x64 -> GF2x64 -> GF2x64
forall a. Ord a => a -> a -> a
min (GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
xor GF2x64
x GF2x64
b) GF2x64
x) GF2x64
v Vector GF2x64
bs GF2x64 -> GF2x64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> GF2x64
GF2x64 Word
0

-- | /O(d)/
insertGF2x64' :: GF2x64 -> GF2x64' -> GF2x64'
insertGF2x64' :: GF2x64 -> GF2x64' -> GF2x64'
insertGF2x64' GF2x64
v (GF2x64' Vector GF2x64
bs)
  | GF2x64
v' GF2x64 -> GF2x64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> GF2x64
GF2x64 Word
0 = Vector GF2x64 -> GF2x64'
GF2x64' Vector GF2x64
bs
  | Bool
otherwise = Vector GF2x64 -> GF2x64'
GF2x64' (Vector GF2x64
bs Vector GF2x64 -> GF2x64 -> Vector GF2x64
forall a. Unbox a => Vector a -> a -> Vector a
`U.snoc` GF2x64
v')
  where
    v' :: GF2x64
v' = (GF2x64 -> GF2x64 -> GF2x64) -> GF2x64 -> Vector GF2x64 -> GF2x64
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
U.foldl' (\GF2x64
x GF2x64
b -> GF2x64 -> GF2x64 -> GF2x64
forall a. Ord a => a -> a -> a
min (GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
xor GF2x64
x GF2x64
b) GF2x64
x) GF2x64
v Vector GF2x64
bs

-- | /O(dN)/
spanGF2x64' :: U.Vector GF2x64 -> GF2x64'
spanGF2x64' :: Vector GF2x64 -> GF2x64'
spanGF2x64' = (GF2x64' -> GF2x64 -> GF2x64')
-> GF2x64' -> Vector GF2x64 -> GF2x64'
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
U.foldl' ((GF2x64 -> GF2x64' -> GF2x64') -> GF2x64' -> GF2x64 -> GF2x64'
forall a b c. (a -> b -> c) -> b -> a -> c
flip GF2x64 -> GF2x64' -> GF2x64'
insertGF2x64') GF2x64'
zeroGF2x64'

-- | /O(d)/
componentsGF2x64' :: GF2x64' -> GF2x64 -> GF2x64
componentsGF2x64' :: GF2x64' -> GF2x64 -> GF2x64
componentsGF2x64' (GF2x64' Vector GF2x64
basis) GF2x64
v0 =
  case ((GF2x64, GF2x64) -> Int -> GF2x64 -> (GF2x64, GF2x64))
-> (GF2x64, GF2x64) -> Vector GF2x64 -> (GF2x64, GF2x64)
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
U.ifoldl' (GF2x64, GF2x64) -> Int -> GF2x64 -> (GF2x64, GF2x64)
step (Word -> GF2x64
GF2x64 Word
0, GF2x64
v0) Vector GF2x64
basis of
    (GF2x64
res, GF2x64 Word
0) -> GF2x64
res
    (GF2x64
res, GF2x64
_) -> GF2x64 -> Int -> GF2x64
forall a. Bits a => a -> Int -> a
setBit GF2x64
res (Vector GF2x64 -> Int
forall a. Unbox a => Vector a -> Int
U.length Vector GF2x64
basis)
  where
    step :: (GF2x64, GF2x64) -> Int -> GF2x64 -> (GF2x64, GF2x64)
    step :: (GF2x64, GF2x64) -> Int -> GF2x64 -> (GF2x64, GF2x64)
step (!GF2x64
acc, !GF2x64
v) Int
i GF2x64
base
      | GF2x64
v' GF2x64 -> GF2x64 -> Bool
forall a. Ord a => a -> a -> Bool
< GF2x64
v = (GF2x64 -> Int -> GF2x64
forall a. Bits a => a -> Int -> a
setBit GF2x64
acc Int
i, GF2x64
v')
      | Bool
otherwise = (GF2x64
acc, GF2x64
v)
      where
        !v' :: GF2x64
v' = GF2x64 -> GF2x64 -> GF2x64
forall a. Bits a => a -> a -> a
xor GF2x64
v GF2x64
base

-- | /O(d)/
linCombGF2x64' :: GF2x64' -> GF2x64 -> GF2x64
linCombGF2x64' :: GF2x64' -> GF2x64 -> GF2x64
linCombGF2x64' (GF2x64' Vector GF2x64
basis) GF2x64
cs =
  (GF2x64 -> Int -> GF2x64 -> GF2x64)
-> GF2x64 -> Vector GF2x64 -> GF2x64
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
U.ifoldl' GF2x64 -> Int -> GF2x64 -> GF2x64
step GF2x64
0 Vector GF2x64
basis
  where
    step :: GF2x64 -> Int -> GF2x64 -> GF2x64
    step :: GF2x64 -> Int -> GF2x64 -> GF2x64
step GF2x64
v Int
i GF2x64
b
      | GF2x64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit GF2x64
cs Int
i = GF2x64
v GF2x64 -> GF2x64 -> GF2x64
forall a. Num a => a -> a -> a
+ GF2x64
b
      | Bool
otherwise = GF2x64
v

newtype instance U.MVector s GF2x64 = MV_GF2x64 (U.MVector s Word)
newtype instance U.Vector GF2x64 = V_GF2x64 (U.Vector Word)
deriving newtype instance GM.MVector U.MVector GF2x64
deriving newtype instance G.Vector U.Vector GF2x64
instance U.Unbox GF2x64