{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Math.NumberTheory.Moduli.Jacobi
( JacobiSymbol(..)
, jacobi
) where
import Data.Bits
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup
#endif
import Numeric.Natural
import Math.NumberTheory.Utils
data JacobiSymbol = MinusOne | Zero | One
deriving (Eq, Ord, Show)
instance Semigroup JacobiSymbol where
(<>) = \case
MinusOne -> negJS
Zero -> const Zero
One -> id
instance Monoid JacobiSymbol where
mempty = One
mappend = (<>)
negJS :: JacobiSymbol -> JacobiSymbol
negJS = \case
MinusOne -> One
Zero -> Zero
One -> MinusOne
{-# SPECIALISE jacobi :: Integer -> Integer -> JacobiSymbol,
Natural -> Natural -> JacobiSymbol,
Int -> Int -> JacobiSymbol,
Word -> Word -> JacobiSymbol
#-}
jacobi :: (Integral a, Bits a) => a -> a -> JacobiSymbol
jacobi _ 1 = One
jacobi a b
| b < 0 = error "Math.NumberTheory.Moduli.jacobi: negative denominator"
| evenI b = error "Math.NumberTheory.Moduli.jacobi: even denominator"
| otherwise = jacobi' a b
jacobi' :: (Integral a, Bits a) => a -> a -> JacobiSymbol
jacobi' 0 _ = Zero
jacobi' 1 _ = One
jacobi' a b
| a < 0 = let n = if rem4is3 b then MinusOne else One
(z, o) = shiftToOddCount (negate a)
s = if evenI z || rem8is1or7 b then n else negJS n
in s <> jacobi' o b
| a >= b = case a `rem` b of
0 -> Zero
r -> jacPS One r b
| evenI a = case shiftToOddCount a of
(z, o) -> let r = if rem4is3 o && rem4is3 b then MinusOne else One
s = if evenI z || rem8is1or7 b then r else negJS r
in jacOL s b o
| otherwise = jacOL (if rem4is3 a && rem4is3 b then MinusOne else One) b a
jacPS :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol
jacPS !acc a b
| evenI a = case shiftToOddCount a of
(z, o)
| evenI z || rem8is1or7 b -> jacOL (if rem4is3 o && rem4is3 b then negJS acc else acc) b o
| otherwise -> jacOL (if rem4is3 o && rem4is3 b then acc else negJS acc) b o
| otherwise = jacOL (if rem4is3 a && rem4is3 b then negJS acc else acc) b a
jacOL :: (Integral a, Bits a) => JacobiSymbol -> a -> a -> JacobiSymbol
jacOL !acc _ 1 = acc
jacOL !acc a b = case a `rem` b of
0 -> Zero
r -> jacPS acc r b
evenI :: Bits a => a -> Bool
evenI n = not (n `testBit` 0)
rem4is3 :: Bits a => a -> Bool
rem4is3 n = n `testBit` 1
rem8is1or7 :: Bits a => a -> Bool
rem8is1or7 n = n `testBit` 1 == n `testBit` 2