{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Basic.NumberTheory (
fermatFactors,
uniquePrimeFactors,
primeFactors,
multiplicativeGenerator,
Order (Order, getOrder),
PrimitiveRoot(primitiveRootCandidates, maximumOrderOfPrimitiveRootsOfUnity),
primitiveRootsOfUnity,
lcmMulti,
primitiveRootsOfUnityFullOrbit,
primitiveRootsOfOrbit,
hasPrimitiveRootOfUnityNaive,
ordersOfPrimitiveRootsOfUnityTest,
orderOfOrbit,
hasPrimitiveRootOfUnityInteger,
ordersOfPrimitiveRootsOfUnityInteger,
ordersOfRootsOfUnityInteger,
ordersOfRootsOfUnityIntegerCondensed,
rootsOfUnityPower,
ringsWithPrimitiveRootOfUnityAndUnit,
ringsWithPrimitiveRootsOfUnityAndUnitsNaive,
ringWithPrimitiveRootsOfUnityAndUnits,
ringWithPrimitiveRootsOfUnity,
is3Smooth,
is5Smooth,
numbers3Smooth,
numbers5Smooth,
ceilingPowerOfTwo,
ceilingPower,
ceilingLog,
powerOfTwoFactors,
divideByMaximumPower,
ceiling3Smooth,
ceiling5Smooth,
isPrime,
raderWorstCases,
fastFourierRing,
multiplicativeGeneratorSet,
multiplicativeGeneratorDivisors,
primitiveRootsOfUnityPower,
primitiveRootsOfUnityNaive,
primitiveRootsOfUnityFullOrbitTest,
maximumOrderOfPrimitiveRootsOfUnityNaive,
maximumOrderOfPrimitiveRootsOfUnityInteger,
divideByMaximumPowerRecursive,
numbers3SmoothCorec,
numbers3SmoothFoldr,
numbers3SmoothSet,
numbers5SmoothCorec,
numbers5SmoothFoldr,
numbers5SmoothSet,
ceiling3SmoothScan,
ceiling5SmoothScan,
ceiling3SmoothNaive,
ceiling5SmoothNaive,
ceiling3SmoothTrace,
ceiling5SmoothTrace,
) where
import qualified Synthesizer.State.Signal as SigS
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Algebra.Ring as Ring
import qualified Algebra.Units as Units
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified Number.ResidueClass.Check as RC
import Number.ResidueClass.Check ((/:), )
import qualified Number.FixedPoint as FP
import Data.Bits (Bits, (.&.), (.|.), shiftR, )
import qualified Data.List.HT as ListHT
import Data.List (unfoldr, mapAccumL, genericDrop, genericSplitAt, )
import Data.Tuple.HT (mapFst, mapSnd, mapPair, swap, )
import Data.Maybe.HT (toMaybe, )
import Test.QuickCheck (Arbitrary(arbitrary), )
import NumericPrelude.Numeric
import NumericPrelude.Base
powerOfTwoFactors ::
(Bits a, Integral.C a) => a -> (a, a)
powerOfTwoFactors :: forall a. (Bits a, C a) => a -> (a, a)
powerOfTwoFactors a
n =
let powerOfTwo :: a
powerOfTwo = a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. (-a
n)
in (a
powerOfTwo, a -> a -> a
forall a. C a => a -> a -> a
div a
n a
powerOfTwo)
fermatFactors :: Integer -> [(Integer,Integer)]
fermatFactors :: Integer -> [(Integer, Integer)]
fermatFactors Integer
n =
let root :: Integer
root = Integer -> Integer -> Integer
FP.sqrt Integer
1 Integer
n
in ((Integer, Integer) -> (Integer, Integer))
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
a,Integer
b) -> (Integer
bInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
a,Integer
bInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
a)) ([(Integer, Integer)] -> [(Integer, Integer)])
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> a -> b
$
[(Integer, Integer)]
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter
([Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> Integer -> Integer)
-> Integer -> [Integer] -> [Integer]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Integer -> Integer -> Integer
forall a. C a => a -> a -> a
(+) Integer
n [Integer
1,Integer
3..]) [Integer
0 .. Integer -> Integer -> Integer
forall a. C a => a -> a -> a
div (Integer
nInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1) Integer
2])
([Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> Integer -> Integer)
-> Integer -> [Integer] -> [Integer]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Integer -> Integer -> Integer
forall a. C a => a -> a -> a
(+) (Integer
rootInteger -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
root) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+) (Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
rootInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
1)) [Integer
root..])
mergeAndFilter :: (Ord a) => [(a,b)] -> [(a,c)] -> [(b,c)]
mergeAndFilter :: forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter ((a
a0,b
b):[(a, b)]
a0s) ((a
a1,c
c):[(a, c)]
a1s) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a0 a
a1 of
Ordering
LT -> [(a, b)] -> [(a, c)] -> [(b, c)]
forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter [(a, b)]
a0s ((a
a1,c
c)(a, c) -> [(a, c)] -> [(a, c)]
forall a. a -> [a] -> [a]
:[(a, c)]
a1s)
Ordering
GT -> [(a, b)] -> [(a, c)] -> [(b, c)]
forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter ((a
a0,b
b)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
a0s) [(a, c)]
a1s
Ordering
EQ -> (b
b,c
c) (b, c) -> [(b, c)] -> [(b, c)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, c)] -> [(b, c)]
forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter [(a, b)]
a0s [(a, c)]
a1s
mergeAndFilter [(a, b)]
_ [(a, c)]
_ = []
multiplicativeGenerator :: Integer -> Integer
multiplicativeGenerator :: Integer -> Integer
multiplicativeGenerator = Integer -> Integer
multiplicativeGeneratorDivisors
multiplicativeGeneratorSet :: Integer -> Integer
multiplicativeGeneratorSet :: Integer -> Integer
multiplicativeGeneratorSet Integer
p =
let search :: Set Integer -> Integer
search Set Integer
candidates =
case Set Integer -> Maybe (Integer, Set Integer)
forall a. Set a -> Maybe (a, Set a)
Set.minView Set Integer
candidates of
Maybe (Integer, Set Integer)
Nothing -> [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not a prime"
Just (Integer
x,Set Integer
rest) ->
case T Integer -> Set Integer
forall a. Ord a => T a -> Set a
orbitSet (T Integer -> Set Integer) -> T Integer -> Set Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> T Integer
forall a. C a => a -> a -> T a
orbit Integer
p Integer
x of
Set Integer
new ->
if Set Integer
new Set Integer -> Set Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer] -> Set Integer
forall a. Ord a => [a] -> Set a
Set.fromList [Integer
1..Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1]
then Integer
x
else Set Integer -> Integer
search (Set Integer -> Set Integer -> Set Integer
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Integer
rest Set Integer
new)
in Set Integer -> Integer
search (Set Integer -> Integer) -> Set Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Set Integer
forall a. Ord a => [a] -> Set a
Set.fromList [Integer
1..Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1]
multiplicativeGeneratorDivisors :: Integer -> Integer
multiplicativeGeneratorDivisors :: Integer -> Integer
multiplicativeGeneratorDivisors Integer
p =
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Order -> [Integer]
forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnity Integer
p (Integer -> Order
Order (Integer -> Order) -> Integer -> Order
forall a b. (a -> b) -> a -> b
$ Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1)
newtype Order = Order {Order -> Integer
getOrder :: Integer}
deriving (Int -> Order -> [Char] -> [Char]
[Order] -> [Char] -> [Char]
Order -> [Char]
(Int -> Order -> [Char] -> [Char])
-> (Order -> [Char]) -> ([Order] -> [Char] -> [Char]) -> Show Order
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Order -> [Char] -> [Char]
showsPrec :: Int -> Order -> [Char] -> [Char]
$cshow :: Order -> [Char]
show :: Order -> [Char]
$cshowList :: [Order] -> [Char] -> [Char]
showList :: [Order] -> [Char] -> [Char]
Show, Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
/= :: Order -> Order -> Bool
Eq, Eq Order
Eq Order =>
(Order -> Order -> Ordering)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Bool)
-> (Order -> Order -> Order)
-> (Order -> Order -> Order)
-> Ord Order
Order -> Order -> Bool
Order -> Order -> Ordering
Order -> Order -> Order
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 :: Order -> Order -> Ordering
compare :: Order -> Order -> Ordering
$c< :: Order -> Order -> Bool
< :: Order -> Order -> Bool
$c<= :: Order -> Order -> Bool
<= :: Order -> Order -> Bool
$c> :: Order -> Order -> Bool
> :: Order -> Order -> Bool
$c>= :: Order -> Order -> Bool
>= :: Order -> Order -> Bool
$cmax :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
min :: Order -> Order -> Order
Ord)
instance Arbitrary Order where
arbitrary :: Gen Order
arbitrary = (Integer -> Order) -> Gen Integer -> Gen Order
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Order
Order (Integer -> Order) -> (Integer -> Integer) -> Integer -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+) (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. C a => a -> a
abs) Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
instance Enum Order where
succ :: Order -> Order
succ (Order Integer
n) = Integer -> Order
Order (Integer
nInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
1)
pred :: Order -> Order
pred (Order Integer
n) = Integer -> Order
Order (Integer
nInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1)
fromEnum :: Order -> Int
fromEnum (Order Integer
n) = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
n
toEnum :: Int -> Order
toEnum Int
n = Integer -> Order
Order (Int -> Integer
forall a. Enum a => Int -> a
toEnum Int
n)
enumFrom :: Order -> [Order]
enumFrom (Order Integer
from) =
(Integer -> Order) -> [Integer] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order ([Integer] -> [Order]) -> [Integer] -> [Order]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom Integer
from
enumFromThen :: Order -> Order -> [Order]
enumFromThen (Order Integer
from) (Order Integer
thn) =
(Integer -> Order) -> [Integer] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order ([Integer] -> [Order]) -> [Integer] -> [Order]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen Integer
from Integer
thn
enumFromTo :: Order -> Order -> [Order]
enumFromTo (Order Integer
from) (Order Integer
to) =
(Integer -> Order) -> [Integer] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order ([Integer] -> [Order]) -> [Integer] -> [Order]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
from Integer
to
enumFromThenTo :: Order -> Order -> Order -> [Order]
enumFromThenTo (Order Integer
from) (Order Integer
thn) (Order Integer
to) =
(Integer -> Order) -> [Integer] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order ([Integer] -> [Order]) -> [Integer] -> [Order]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
from Integer
thn Integer
to
countOrder :: [a] -> Order
countOrder :: forall a. [a] -> Order
countOrder = (Order -> a -> Order) -> Order -> [a] -> Order
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Order
o a
_ -> Order -> Order
forall a. Enum a => a -> a
succ Order
o) (Integer -> Order
Order Integer
0)
dividesOrder :: Order -> Order -> Bool
dividesOrder :: Order -> Order -> Bool
dividesOrder (Order Integer
k) (Order Integer
n) =
Integer -> Integer -> Bool
forall a. (C a, C a) => a -> a -> Bool
divides Integer
k Integer
n
class PID.C a => PrimitiveRoot a where
primitiveRootCandidates :: a -> [a]
maximumOrderOfPrimitiveRootsOfUnity :: a -> Order
instance PrimitiveRoot Integer where
primitiveRootCandidates :: Integer -> [Integer]
primitiveRootCandidates Integer
modu = [Integer
1 .. Integer
moduInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1]
maximumOrderOfPrimitiveRootsOfUnity :: Integer -> Order
maximumOrderOfPrimitiveRootsOfUnity =
Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger
primitiveRootsOfUnity ::
(PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnity :: forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnity =
a -> Order -> [a]
forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityPower
primitiveRootsOfUnityPower ::
(PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityPower :: forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityPower a
modu (Order Integer
order) =
let greatDivisors :: [Integer]
greatDivisors = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. C a => a -> a -> a
div Integer
order) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. (C a, Bits a, C a, Ord a) => a -> [a]
uniquePrimeFactors Integer
order
in (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
let pow :: Integer -> a
pow Integer
y = T a -> a
forall a. T a -> a
RC.representative (T a -> a) -> T a -> a
forall a b. (a -> b) -> a -> b
$ (a
n a -> a -> T a
forall a. C a => a -> a -> T a
/: a
modu) T a -> Integer -> T a
forall a. C a => a -> Integer -> a
^ Integer
y
in a -> a -> Bool
forall a. C a => a -> a -> Bool
PID.coprime a
n a
modu
Bool -> Bool -> Bool
&&
Integer -> a
pow Integer
order a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
one
Bool -> Bool -> Bool
&&
(Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Integer
y -> Integer -> a
pow Integer
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. C a => a
one) [Integer]
greatDivisors) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
primitiveRootsOfUnityNaive ::
(PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityNaive :: forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityNaive a
_ (Order Integer
0) = []
primitiveRootsOfUnityNaive a
modu (Order Integer
expo) =
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
let ([a]
prefix,a
end:[a]
_) =
Integer -> [a] -> ([a], [a])
forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt (Integer
expoInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1) ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ T a -> [a]
forall y. T y -> [y]
SigS.toList (T a -> [a]) -> T a -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a -> T a
forall a. C a => a -> a -> T a
orbit a
modu a
n
in (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) [a]
prefix Bool -> Bool -> Bool
&& a
enda -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
1) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
orbitSet :: Ord a => SigS.T a -> Set.Set a
orbitSet :: forall a. Ord a => T a -> Set a
orbitSet T a
list =
(a -> (Set a -> Set a) -> Set a -> Set a)
-> (Set a -> Set a) -> T a -> Set a -> Set a
forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR
(\a
new Set a -> Set a
cont Set a
seen ->
if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
new Set a
seen
then Set a
seen
else Set a -> Set a
cont (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
new Set a
seen))
Set a -> Set a
forall a. a -> a
id T a
list Set a
forall a. Set a
Set.empty
orbit :: (Integral.C a) => a -> a -> SigS.T a
orbit :: forall a. C a => a -> a -> T a
orbit a
p a
x = (a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
SigS.iterate (\a
y -> a -> a -> a
forall a. C a => a -> a -> a
mod (a
xa -> a -> a
forall a. C a => a -> a -> a
*a
y) a
p) a
x
primitiveRootsOfUnityFullOrbit ::
(PrimitiveRoot a, Ord a) => a -> Order -> [a]
primitiveRootsOfUnityFullOrbit :: forall a. (PrimitiveRoot a, Ord a) => a -> Order -> [a]
primitiveRootsOfUnityFullOrbit a
modu Order
expo =
let search :: Set a -> Maybe ([a], Set a)
search Set a
candidates =
(((a, Set a) -> ([a], Set a))
-> Maybe (a, Set a) -> Maybe ([a], Set a))
-> Maybe (a, Set a)
-> ((a, Set a) -> ([a], Set a))
-> Maybe ([a], Set a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a, Set a) -> ([a], Set a))
-> Maybe (a, Set a) -> Maybe ([a], Set a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) (((a, Set a) -> ([a], Set a)) -> Maybe ([a], Set a))
-> ((a, Set a) -> ([a], Set a)) -> Maybe ([a], Set a)
forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
([a] -> Set a) -> ([a], [a]) -> ([a], Set a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest (Set a -> Set a) -> ([a] -> Set a) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList) (([a], [a]) -> ([a], Set a)) -> ([a], [a]) -> ([a], Set a)
forall a b. (a -> b) -> a -> b
$
a -> Order -> a -> ([a], [a])
forall a. (PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit a
modu Order
expo a
x
in [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ (Set a -> Maybe ([a], Set a)) -> Set a -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ([a], Set a)
search (Set a -> [[a]]) -> Set a -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. C a => a -> a -> Bool
PID.coprime a
modu) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
primitiveRootsOfUnityFullOrbitTest ::
(PrimitiveRoot a, Ord a) => a -> Order -> [(a,[a])]
primitiveRootsOfUnityFullOrbitTest :: forall a. (PrimitiveRoot a, Ord a) => a -> Order -> [(a, [a])]
primitiveRootsOfUnityFullOrbitTest a
modu Order
expo =
let search :: Set a -> Maybe ((a, [a]), Set a)
search Set a
candidates =
(((a, Set a) -> ((a, [a]), Set a))
-> Maybe (a, Set a) -> Maybe ((a, [a]), Set a))
-> Maybe (a, Set a)
-> ((a, Set a) -> ((a, [a]), Set a))
-> Maybe ((a, [a]), Set a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a, Set a) -> ((a, [a]), Set a))
-> Maybe (a, Set a) -> Maybe ((a, [a]), Set a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) (((a, Set a) -> ((a, [a]), Set a)) -> Maybe ((a, [a]), Set a))
-> ((a, Set a) -> ((a, [a]), Set a)) -> Maybe ((a, [a]), Set a)
forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
([a] -> (a, [a]), [a] -> Set a) -> ([a], [a]) -> ((a, [a]), Set a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((,) a
x,
Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest (Set a -> Set a) -> ([a] -> Set a) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList) (([a], [a]) -> ((a, [a]), Set a))
-> ([a], [a]) -> ((a, [a]), Set a)
forall a b. (a -> b) -> a -> b
$
a -> Order -> a -> ([a], [a])
forall a. (PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit a
modu Order
expo a
x
in (Set a -> Maybe ((a, [a]), Set a)) -> Set a -> [(a, [a])]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ((a, [a]), Set a)
search (Set a -> [(a, [a])]) -> Set a -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. C a => a -> a -> Bool
PID.coprime a
modu) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
primitiveRootsOfOrbit ::
(PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit :: forall a. (PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit a
modu (Order Integer
expo) a
x =
let orb :: [a]
orb = (a
1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a
1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (\a
y -> a -> a -> a
forall a. C a => a -> a -> a
mod (a
xa -> a -> a
forall a. C a => a -> a -> a
*a
y) a
modu) a
x
(Order Integer
orbitSize) = [a] -> Order
forall a. [a] -> Order
countOrder [a]
orb
in (if Integer
expoInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0
then []
else
case Integer -> Integer -> (Integer, Integer)
forall a. C a => a -> a -> (a, a)
divMod Integer
orbitSize Integer
expo of
(Integer
s,Integer
0) ->
((Integer, a) -> a) -> [(Integer, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, a) -> a
forall a b. (a, b) -> b
snd ([(Integer, a)] -> [a]) -> [(Integer, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ ((Integer, a) -> Bool) -> [(Integer, a)] -> [(Integer, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. C a => a -> a -> Bool
PID.coprime Integer
expo (Integer -> Bool)
-> ((Integer, a) -> Integer) -> (Integer, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, a) -> Integer
forall a b. (a, b) -> a
fst) ([(Integer, a)] -> [(Integer, a)])
-> [(Integer, a)] -> [(Integer, a)]
forall a b. (a -> b) -> a -> b
$
[Integer] -> [a] -> [(Integer, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
[Integer
0 .. Integer
expoInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1]
(([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. HasCallStack => [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Integer
s) [a]
orb)
(Integer, Integer)
_ -> [],
[a]
orb)
hasPrimitiveRootOfUnityNaive ::
(PrimitiveRoot a, Ord a) => a -> Order -> Bool
hasPrimitiveRootOfUnityNaive :: forall a. (PrimitiveRoot a, Ord a) => a -> Order -> Bool
hasPrimitiveRootOfUnityNaive a
modu Order
expo =
((a, Order) -> Bool) -> [(a, Order)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Order -> Order -> Bool
dividesOrder Order
expo (Order -> Bool) -> ((a, Order) -> Order) -> (a, Order) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Order) -> Order
forall a b. (a, b) -> b
snd) ([(a, Order)] -> Bool) -> [(a, Order)] -> Bool
forall a b. (a -> b) -> a -> b
$
a -> [(a, Order)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(a, Order)]
ordersOfPrimitiveRootsOfUnityTest a
modu
maximumOrderOfPrimitiveRootsOfUnityNaive ::
(PrimitiveRoot a, Ord a) => a -> Order
maximumOrderOfPrimitiveRootsOfUnityNaive :: forall a. (PrimitiveRoot a, Ord a) => a -> Order
maximumOrderOfPrimitiveRootsOfUnityNaive =
(Order -> Order -> Order) -> Order -> [Order] -> Order
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Order -> Order -> Order
forall a. Ord a => a -> a -> a
max (Integer -> Order
Order Integer
1) ([Order] -> Order) -> (a -> [Order]) -> a -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Order) -> Order) -> [(a, Order)] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map (a, Order) -> Order
forall a b. (a, b) -> b
snd ([(a, Order)] -> [Order]) -> (a -> [(a, Order)]) -> a -> [Order]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, Order)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(a, Order)]
ordersOfPrimitiveRootsOfUnityTest
ordersOfPrimitiveRootsOfUnityTest ::
(PrimitiveRoot a, Ord a) => a -> [(a, Order)]
ordersOfPrimitiveRootsOfUnityTest :: forall a. (PrimitiveRoot a, Ord a) => a -> [(a, Order)]
ordersOfPrimitiveRootsOfUnityTest a
modu =
let search :: Set a -> Maybe ((a, Order), Set a)
search Set a
candidates =
(((a, Set a) -> ((a, Order), Set a))
-> Maybe (a, Set a) -> Maybe ((a, Order), Set a))
-> Maybe (a, Set a)
-> ((a, Set a) -> ((a, Order), Set a))
-> Maybe ((a, Order), Set a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a, Set a) -> ((a, Order), Set a))
-> Maybe (a, Set a) -> Maybe ((a, Order), Set a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) (((a, Set a) -> ((a, Order), Set a)) -> Maybe ((a, Order), Set a))
-> ((a, Set a) -> ((a, Order), Set a)) -> Maybe ((a, Order), Set a)
forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
(Order -> (a, Order), [a] -> Set a)
-> (Order, [a]) -> ((a, Order), Set a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((,) a
x,
Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest (Set a -> Set a) -> ([a] -> Set a) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList) ((Order, [a]) -> ((a, Order), Set a))
-> (Order, [a]) -> ((a, Order), Set a)
forall a b. (a -> b) -> a -> b
$
a -> a -> (Order, [a])
forall a. (PrimitiveRoot a, Ord a) => a -> a -> (Order, [a])
orderOfOrbit a
modu a
x
in (Set a -> Maybe ((a, Order), Set a)) -> Set a -> [(a, Order)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ((a, Order), Set a)
search (Set a -> [(a, Order)]) -> Set a -> [(a, Order)]
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. C a => a -> a -> Bool
PID.coprime a
modu) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
orderOfOrbit ::
(PrimitiveRoot a, Ord a) => a -> a -> (Order, [a])
orderOfOrbit :: forall a. (PrimitiveRoot a, Ord a) => a -> a -> (Order, [a])
orderOfOrbit a
modu a
x =
let cyc :: [a]
cyc = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a
forall a. C a => a
onea -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ T a -> [a]
forall y. T y -> [y]
SigS.toList (T a -> [a]) -> T a -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a -> T a
forall a. C a => a -> a -> T a
orbit a
modu a
x
in (Order -> Order
forall a. Enum a => a -> a
succ (Order -> Order) -> Order -> Order
forall a b. (a -> b) -> a -> b
$ [a] -> Order
forall a. [a] -> Order
countOrder [a]
cyc, [a]
cyc)
hasPrimitiveRootOfUnityInteger ::
Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger :: Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger Integer
modu Order
expo =
Order -> Order -> Bool
dividesOrder Order
expo (Order -> Bool) -> Order -> Bool
forall a b. (a -> b) -> a -> b
$
Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger Integer
modu
maximumOrderOfPrimitiveRootsOfUnityInteger ::
Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger :: Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger =
Integer -> Order
Order (Integer -> Order) -> (Integer -> Integer) -> Integer -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Integer] -> Integer
forall a. C a => [a] -> a
lcmMulti ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Integer, Integer) -> Integer)
-> [(Integer, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Integer
e,Integer
p) ->
if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2
then Integer
pInteger -> Integer -> Integer
forall a. C a => a -> Integer -> a
^(Integer
eInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
2)
else Integer
pInteger -> Integer -> Integer
forall a. C a => a -> Integer -> a
^(Integer
eInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1) Integer -> Integer -> Integer
forall a. C a => a -> a -> a
* (Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1)) ([(Integer, Integer)] -> [Integer])
-> (Integer -> [(Integer, Integer)]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Int, Integer) -> (Integer, Integer))
-> [(Int, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Integer) -> (Int, Integer) -> (Integer, Integer)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral) ([(Int, Integer)] -> [(Integer, Integer)])
-> (Integer -> [(Int, Integer)]) -> Integer -> [(Integer, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> [(Int, Integer)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors
ordersOfPrimitiveRootsOfUnityInteger :: [[Int]]
ordersOfPrimitiveRootsOfUnityInteger :: [[Int]]
ordersOfPrimitiveRootsOfUnityInteger =
((Integer -> [Int]) -> [Integer] -> [[Int]])
-> [Integer] -> (Integer -> [Int]) -> [[Int]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> [Int]) -> [Integer] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] ((Integer -> [Int]) -> [[Int]]) -> (Integer -> [Int]) -> [[Int]]
forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
let maxOrder :: Order
maxOrder = Integer -> Order
forall a. PrimitiveRoot a => a -> Order
maximumOrderOfPrimitiveRootsOfUnity (Integer
modu::Integer)
in (Order -> Int) -> [Order] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int) -> (Order -> [Integer]) -> Order -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Order -> [Integer]
forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityPower Integer
modu) ([Order] -> [Int]) -> [Order] -> [Int]
forall a b. (a -> b) -> a -> b
$
[Integer -> Order
Order Integer
1 .. Order
maxOrder]
ordersOfRootsOfUnityInteger :: [[Int]]
ordersOfRootsOfUnityInteger :: [[Int]]
ordersOfRootsOfUnityInteger =
((Integer -> [Int]) -> [Integer] -> [[Int]])
-> [Integer] -> (Integer -> [Int]) -> [[Int]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> [Int]) -> [Integer] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] ((Integer -> [Int]) -> [[Int]]) -> (Integer -> [Int]) -> [[Int]]
forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
(Order -> Int) -> [Order] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int) -> (Order -> [Integer]) -> Order -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Order -> [Integer]
forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower (Integer
modu::Integer)) ([Order] -> [Int]) -> [Order] -> [Int]
forall a b. (a -> b) -> a -> b
$
[Integer -> Order
Order Integer
1 ..]
ordersOfRootsOfUnityIntegerCondensed :: [[Int]]
ordersOfRootsOfUnityIntegerCondensed :: [[Int]]
ordersOfRootsOfUnityIntegerCondensed =
((Integer -> [Int]) -> [Integer] -> [[Int]])
-> [Integer] -> (Integer -> [Int]) -> [[Int]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> [Int]) -> [Integer] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] ((Integer -> [Int]) -> [[Int]]) -> (Integer -> [Int]) -> [[Int]]
forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
let maxOrder :: Order
maxOrder = Integer -> Order
forall a. PrimitiveRoot a => a -> Order
maximumOrderOfPrimitiveRootsOfUnity (Integer
modu::Integer)
in (Order -> Int) -> [Order] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int) -> (Order -> [Integer]) -> Order -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Order -> [Integer]
forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower Integer
modu) ([Order] -> [Int]) -> [Order] -> [Int]
forall a b. (a -> b) -> a -> b
$
[Integer -> Order
Order Integer
1 .. Order
maxOrder]
rootsOfUnityPower ::
(PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower :: forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower a
modu (Order Integer
expo) =
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
a -> a -> Bool
forall a. C a => a -> a -> Bool
PID.coprime a
n a
modu
Bool -> Bool -> Bool
&&
T a -> a
forall a. T a -> a
RC.representative ((a
n a -> a -> T a
forall a. C a => a -> a -> T a
/: a
modu) T a -> Integer -> T a
forall a. C a => a -> Integer -> a
^ Integer
expo) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
one) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
ringsWithPrimitiveRootOfUnityAndUnit :: Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit :: Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit order :: Order
order@(Order Integer
k) =
(Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Order -> Bool) -> Order -> Integer -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger Order
order) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
(Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
kInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+) Integer
1
ringsWithPrimitiveRootsOfUnityAndUnitsNaive :: [Order] -> [Integer] -> [Integer]
ringsWithPrimitiveRootsOfUnityAndUnitsNaive :: [Order] -> [Integer] -> [Integer]
ringsWithPrimitiveRootsOfUnityAndUnitsNaive [Order]
rootOrders [Integer]
units =
(Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\Integer
n ->
(Order -> Bool) -> [Order] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger Integer
n) [Order]
rootOrders Bool -> Bool -> Bool
&&
(Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Integer -> Bool
forall a. C a => a -> a -> Bool
PID.coprime Integer
n) [Integer]
units)
[Integer
1..]
ringWithPrimitiveRootsOfUnityAndUnits :: [Order] -> [Integer] -> Integer
ringWithPrimitiveRootsOfUnityAndUnits :: [Order] -> [Integer] -> Integer
ringWithPrimitiveRootsOfUnityAndUnits [Order]
rootOrders [Integer]
units =
let p :: Integer
p = [Integer] -> Integer
forall a. C a => [a] -> a
lcmMulti [Integer]
units
in [Integer] -> Integer
forall a. C a => [a] -> a
lcmMulti ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$
(Order -> Integer) -> [Order] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> (Order -> [Integer]) -> Order -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. C a => a -> a -> Bool
PID.coprime Integer
p) ([Integer] -> [Integer])
-> (Order -> [Integer]) -> Order -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit) ([Order] -> [Integer]) -> [Order] -> [Integer]
forall a b. (a -> b) -> a -> b
$
[Order]
rootOrders
ringWithPrimitiveRootsOfUnity :: Order -> Integer
ringWithPrimitiveRootsOfUnity :: Order -> Integer
ringWithPrimitiveRootsOfUnity (Order Integer
n) =
case Integer
n of
Integer
0 -> Integer
2
Integer
_ ->
[Integer] -> Integer
forall a. C a => [a] -> a
product ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ ((Int, Integer) -> Integer) -> [(Int, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Integer -> Integer) -> (Int, Integer) -> Integer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Integer -> Integer
forall a b. (C a, C b) => b -> a -> a
ringPower) ([(Int, Integer)] -> [Integer]) -> [(Int, Integer)] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Map Integer Int, [(Int, Integer)]) -> [(Int, Integer)]
forall a b. (a, b) -> b
snd ((Map Integer Int, [(Int, Integer)]) -> [(Int, Integer)])
-> (Map Integer Int, [(Int, Integer)]) -> [(Int, Integer)]
forall a b. (a -> b) -> a -> b
$
(Map Integer Int
-> (Int, Integer) -> (Map Integer Int, (Int, Integer)))
-> Map Integer Int
-> [(Int, Integer)]
-> (Map Integer Int, [(Int, Integer)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
(\Map Integer Int
factors (Int
e,Integer
p) ->
if Int -> Integer -> Map Integer Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 Integer
p Map Integer Int
factors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e
then (Map Integer Int
factors, (Int
0,Integer
p))
else
if Integer
pInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
2
then
(Map Integer Int
factors,
case Int
e of
Int
0 -> (Int
0,Integer
2)
Int
1 -> (Int
1,Integer
3)
Int
2 -> (Int
1,Integer
5)
Int
_ -> (Int
eInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
2, Integer
2))
else
((Int -> Int -> Int)
-> Map Integer Int -> Map Integer Int -> Map Integer Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Map Integer Int
factors (Map Integer Int -> Map Integer Int)
-> Map Integer Int -> Map Integer Int
forall a b. (a -> b) -> a -> b
$
[(Integer, Int)] -> Map Integer Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Integer, Int)] -> Map Integer Int)
-> [(Integer, Int)] -> Map Integer Int
forall a b. (a -> b) -> a -> b
$ ((Int, Integer) -> (Integer, Int))
-> [(Int, Integer)] -> [(Integer, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Integer) -> (Integer, Int)
forall a b. (a, b) -> (b, a)
swap ([(Int, Integer)] -> [(Integer, Int)])
-> [(Int, Integer)] -> [(Integer, Int)]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Integer)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors (Integer -> [(Int, Integer)]) -> Integer -> [(Int, Integer)]
forall a b. (a -> b) -> a -> b
$ Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1,
(Int
eInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1, Integer
p)))
Map Integer Int
forall k a. Map k a
Map.empty ([(Int, Integer)] -> (Map Integer Int, [(Int, Integer)]))
-> [(Int, Integer)] -> (Map Integer Int, [(Int, Integer)])
forall a b. (a -> b) -> a -> b
$
[(Int, Integer)] -> [(Int, Integer)]
forall a. [a] -> [a]
reverse ([(Int, Integer)] -> [(Int, Integer)])
-> [(Int, Integer)] -> [(Int, Integer)]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Integer)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors (Integer -> [(Int, Integer)]) -> Integer -> [(Int, Integer)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. C a => [a] -> a
lcmMulti ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$
Integer
n Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. C a => a -> a -> a
subtract Integer
1) (Integer -> [Integer]
partialPrimes Integer
n)
lcmMulti :: (PID.C a) => [a] -> a
lcmMulti :: forall a. C a => [a] -> a
lcmMulti = (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
lcm a
forall a. C a => a
one
numbers3Smooth :: [Integer]
numbers3Smooth :: [Integer]
numbers3Smooth = [Integer]
numbers3SmoothCorec
numbers3SmoothCorec :: [Integer]
numbers3SmoothCorec :: [Integer]
numbers3SmoothCorec = Integer -> [Integer] -> [Integer]
forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
3 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*) Integer
1
mergePowers :: (Ord a, Ring.C a) => a -> [a] -> [a]
mergePowers :: forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers a
_ [] = []
mergePowers a
p (a
x:[a]
xs) =
let ys :: [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [a]
xs ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
pa -> a -> a
forall a. C a => a -> a -> a
*) [a]
ys)
in [a]
ys
numbers3SmoothFoldr :: [Integer]
numbers3SmoothFoldr :: [Integer]
numbers3SmoothFoldr =
([Integer] -> [Integer] -> [Integer])
-> [Integer] -> [[Integer]] -> [Integer]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Integer
x0:Integer
x1:[Integer]
xs) [Integer]
ys -> Integer
x0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
x1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> Bool) -> [Integer] -> [Integer] -> [Integer]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [Integer]
xs [Integer]
ys)
([Char] -> [Integer]
forall a. HasCallStack => [Char] -> a
error [Char]
"numbers3SmoothFoldr: infinite list should not have an end") ([[Integer]] -> [Integer]) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> a -> b
$
([Integer] -> [Integer]) -> [Integer] -> [[Integer]]
forall a. (a -> a) -> a -> [a]
iterate ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
3Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*)) ([Integer] -> [[Integer]]) -> [Integer] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$
(Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*) Integer
1
numbers3SmoothSet :: [Integer]
numbers3SmoothSet :: [Integer]
numbers3SmoothSet =
(Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer -> [Integer]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(((Integer, Set Integer) -> (Integer, Set Integer))
-> Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
m,Set Integer
rest) -> (Integer
m, Set Integer -> Set Integer -> Set Integer
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Integer
rest (Set Integer -> Set Integer) -> Set Integer -> Set Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Set Integer
forall a. Eq a => [a] -> Set a
Set.fromAscList [Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
m,Integer
3Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
m])) (Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer))
-> (Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer
-> Maybe (Integer, Set Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Set Integer -> Maybe (Integer, Set Integer)
forall a. Set a -> Maybe (a, Set a)
Set.minView) (Set Integer -> [Integer]) -> Set Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer -> Set Integer
forall a. a -> Set a
Set.singleton Integer
1
numbers5Smooth :: [Integer]
numbers5Smooth :: [Integer]
numbers5Smooth = [Integer]
numbers5SmoothCorec
numbers5SmoothCorec :: [Integer]
numbers5SmoothCorec :: [Integer]
numbers5SmoothCorec =
if Bool
False
then
Integer -> [Integer] -> [Integer]
forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
5 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ [Integer]
numbers3SmoothCorec
else Integer -> [Integer] -> [Integer]
forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
5 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer] -> [Integer]
forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
3 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*) Integer
1
numbers5SmoothFoldr :: [Integer]
numbers5SmoothFoldr :: [Integer]
numbers5SmoothFoldr =
([Integer] -> [Integer] -> [Integer])
-> [Integer] -> [[Integer]] -> [Integer]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Integer
x0:Integer
x1:Integer
x2:[Integer]
xs) [Integer]
ys -> Integer
x0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
x1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
x2 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> Bool) -> [Integer] -> [Integer] -> [Integer]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [Integer]
xs [Integer]
ys)
([Char] -> [Integer]
forall a. HasCallStack => [Char] -> a
error [Char]
"numbers5SmoothFoldr: infinite list should not have an end") ([[Integer]] -> [Integer]) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> a -> b
$
([Integer] -> [Integer]) -> [Integer] -> [[Integer]]
forall a. (a -> a) -> a -> [a]
iterate ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
5Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*)) ([Integer] -> [[Integer]]) -> [Integer] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$
[Integer]
numbers3SmoothFoldr
numbers5SmoothSet :: [Integer]
numbers5SmoothSet :: [Integer]
numbers5SmoothSet =
(Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer -> [Integer]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(((Integer, Set Integer) -> (Integer, Set Integer))
-> Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
m,Set Integer
rest) -> (Integer
m, Set Integer -> Set Integer -> Set Integer
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Integer
rest (Set Integer -> Set Integer) -> Set Integer -> Set Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Set Integer
forall a. Eq a => [a] -> Set a
Set.fromAscList [Integer
2Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
m,Integer
3Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
m,Integer
5Integer -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
m])) (Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer))
-> (Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer
-> Maybe (Integer, Set Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Set Integer -> Maybe (Integer, Set Integer)
forall a. Set a -> Maybe (a, Set a)
Set.minView) (Set Integer -> [Integer]) -> Set Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer -> Set Integer
forall a. a -> Set a
Set.singleton Integer
1
ceilingPowerOfTwo :: (Ring.C a, Bits a) => a -> a
ceilingPowerOfTwo :: forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo a
0 = a
1
ceilingPowerOfTwo a
n =
(a
1a -> a -> a
forall a. C a => a -> a -> a
+) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> (a, a)
forall a. HasCallStack => [a] -> a
head ([(a, a)] -> (a, a)) -> [(a, a)] -> (a, a)
forall a b. (a -> b) -> a -> b
$
((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$
(a -> a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent (,) ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$
(a -> Int -> a) -> a -> [Int] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
m Int
d -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
m Int
d a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
m) (a
na -> a -> a
forall a. C a => a -> a -> a
-a
1) ([Int] -> [a]) -> [Int] -> [a]
forall a b. (a -> b) -> a -> b
$
(Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*) Int
1
ceilingPower :: (Integral.C a, Ord a) => a -> a -> a
ceilingPower :: forall a. (C a, Ord a) => a -> a -> a
ceilingPower a
base a
n = a
base a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral (a -> a -> Int
forall a. (C a, Ord a) => a -> a -> Int
ceilingLog a
base a
n)
ceilingLog :: (Integral.C a, Ord a) => a -> a -> Int
ceilingLog :: forall a. (C a, Ord a) => a -> a -> Int
ceilingLog a
base =
[a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (a -> [a]) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0) ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. C a => a -> a -> a
div a
base) (a -> [a]) -> (a -> a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. C a => a -> a -> a
subtract a
1
divideByMaximumPower ::
(Integral.C a, ZeroTestable.C a) => a -> a -> a
divideByMaximumPower :: forall a. (C a, C a) => a -> a -> a
divideByMaximumPower a
b a
n =
[a] -> a
forall a. HasCallStack => [a] -> a
last ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Maybe (a, a)) -> a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\a
m -> case a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
m a
b of (a
q,a
r) -> Bool -> (a, a) -> Maybe (a, a)
forall a. Bool -> a -> Maybe a
toMaybe (a -> Bool
forall a. C a => a -> Bool
isZero a
r) (a
q,a
q)) a
n
divideByMaximumPowerRecursive ::
(Integral.C a, Eq a, ZeroTestable.C a) => a -> a -> a
divideByMaximumPowerRecursive :: forall a. (C a, Eq a, C a) => a -> a -> a
divideByMaximumPowerRecursive a
b =
let recourse :: a -> a
recourse a
n =
case a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
n a
b of
(a
q,a
0) -> a -> a
recourse a
q
(a, a)
_ -> a
n
in a -> a
recourse
getMaximumExponent ::
(Integral.C a, ZeroTestable.C a) =>
a -> a -> (Int,a)
getMaximumExponent :: forall a. (C a, C a) => a -> a -> (Int, a)
getMaximumExponent a
b a
n =
[(Int, a)] -> (Int, a)
forall a. HasCallStack => [a] -> a
last ([(Int, a)] -> (Int, a)) -> [(Int, a)] -> (Int, a)
forall a b. (a -> b) -> a -> b
$ (Int
0,a
n) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:
((Int, a) -> Maybe ((Int, a), (Int, a))) -> (Int, a) -> [(Int, a)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(\(Int
e,a
m) ->
let (a
q,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
m a
b
eq :: (Int, a)
eq = (Int
eInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1,a
q)
in Bool -> ((Int, a), (Int, a)) -> Maybe ((Int, a), (Int, a))
forall a. Bool -> a -> Maybe a
toMaybe (a -> Bool
forall a. C a => a -> Bool
isZero a
r) ((Int, a)
eq,(Int, a)
eq))
(Int
0,a
n)
is3Smooth :: Integer -> Bool
is3Smooth :: Integer -> Bool
is3Smooth =
(Integer
1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==) (Integer -> Bool) -> (Integer -> Integer) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
3 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
2
is5Smooth :: Integer -> Bool
is5Smooth :: Integer -> Bool
is5Smooth =
(Integer
1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==) (Integer -> Bool) -> (Integer -> Integer) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
5 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
3 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Integer -> Integer
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
2
ceiling3Smooth :: Integer -> Integer
ceiling3Smooth :: Integer -> Integer
ceiling3Smooth = Integer -> Integer
ceiling3SmoothTrace
ceiling5Smooth :: Integer -> Integer
ceiling5Smooth :: Integer -> Integer
ceiling5Smooth = Integer -> Integer
ceiling5SmoothTrace
ceiling3SmoothScan :: Integer -> Integer
ceiling3SmoothScan :: Integer -> Integer
ceiling3SmoothScan Integer
n =
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
n) [Integer]
numbers3Smooth
ceiling5SmoothScan :: Integer -> Integer
ceiling5SmoothScan :: Integer -> Integer
ceiling5SmoothScan Integer
n =
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
n) [Integer]
numbers5Smooth
ceiling3SmoothNaive :: Integer -> Integer
ceiling3SmoothNaive :: Integer -> Integer
ceiling3SmoothNaive =
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Integer -> Bool) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
is3Smooth) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
1Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+)
ceiling5SmoothNaive :: Integer -> Integer
ceiling5SmoothNaive :: Integer -> Integer
ceiling5SmoothNaive =
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Integer -> Bool) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
is5Smooth) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
1Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+)
ceiling3SmoothTrace :: Integer -> Integer
ceiling3SmoothTrace :: Integer -> Integer
ceiling3SmoothTrace Integer
n =
[Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo Integer
n
_ceiling5SmoothTraceWrong :: Integer -> Integer
_ceiling5SmoothTraceWrong :: Integer -> Integer
_ceiling5SmoothTraceWrong Integer
n =
[Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
3 Integer
5 Integer
n) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo Integer
n
ceiling5SmoothTrace :: Integer -> Integer
ceiling5SmoothTrace :: Integer -> Integer
ceiling5SmoothTrace Integer
n =
[Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
5 Integer
n) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo Integer
n
ceilingSmoothsTrace :: Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace :: Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
a Integer
b Integer
n =
let divMany :: Integer -> Integer
divMany Integer
k =
case Integer -> Integer -> (Integer, Integer)
forall a. C a => a -> a -> (a, a)
divMod Integer
k Integer
a of
(Integer
q,Integer
r) -> if Integer
rInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0 Bool -> Bool -> Bool
&& Integer
qInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=Integer
n then Integer -> Integer
divMany Integer
q else Integer
k
go :: Integer -> [Integer]
go Integer
m = Integer
m Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: if Integer -> Integer -> Integer
forall a. C a => a -> a -> a
mod Integer
m Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer -> [Integer]
go (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
divMany (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
mInteger -> Integer -> Integer
forall a. C a => a -> a -> a
*Integer
b else []
in Integer -> [Integer]
go
partialPrimes :: Integer -> [Integer]
partialPrimes :: Integer -> [Integer]
partialPrimes =
let primeFactorSet :: Integer -> Set Integer
primeFactorSet = [Integer] -> Set Integer
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Integer] -> Set Integer)
-> (Integer -> [Integer]) -> Integer -> Set Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. (C a, Bits a, C a, Ord a) => a -> [a]
uniquePrimeFactors
in (Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer -> [Integer]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(((Integer, Set Integer) -> (Integer, Set Integer))
-> Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(Integer
p,Set Integer
set) ->
(Integer
p, Set Integer -> Set Integer -> Set Integer
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Integer -> Set Integer
primeFactorSet (Integer
pInteger -> Integer -> Integer
forall a. C a => a -> a -> a
-Integer
1)) Set Integer
set)) (Maybe (Integer, Set Integer) -> Maybe (Integer, Set Integer))
-> (Set Integer -> Maybe (Integer, Set Integer))
-> Set Integer
-> Maybe (Integer, Set Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Set Integer -> Maybe (Integer, Set Integer)
forall a. Set a -> Maybe (a, Set a)
Set.maxView)
(Set Integer -> [Integer])
-> (Integer -> Set Integer) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Integer -> Set Integer
primeFactorSet
uniquePrimeFactors ::
(Integral.C a, Bits a, ZeroTestable.C a, Ord a) =>
a -> [a]
uniquePrimeFactors :: forall a. (C a, Bits a, C a, Ord a) => a -> [a]
uniquePrimeFactors a
n =
let oddFactors :: a -> [a]
oddFactors =
(a -> (a -> [a]) -> a -> [a]) -> (a -> [a]) -> [a] -> a -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\a
p a -> [a]
go a
m ->
let (a
q,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
m a
p
in if a
ra -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0
then a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a -> a -> a
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower a
p a
q)
else
if a
q a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
p
then a -> [a]
go a
m
else if a
ma -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
1 then [] else a
m a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [])
([Char] -> a -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"uniquePrimeFactors: end of infinite list")
((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
+) a
3)
in case a -> (a, a)
forall a. (Bits a, C a) => a -> (a, a)
powerOfTwoFactors a
n of
(a
1,a
m) -> a -> [a]
oddFactors a
m
(a
_,a
m) -> a
2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
oddFactors a
m
primeFactors ::
(PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors :: forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors a
n =
let oddFactors :: a -> [(Int, a)]
oddFactors =
(a -> (a -> [(Int, a)]) -> a -> [(Int, a)])
-> (a -> [(Int, a)]) -> [a] -> a -> [(Int, a)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\a
p a -> [(Int, a)]
go a
m ->
let (a
q0,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
m a
p
in if a
ra -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0
then
case a -> a -> (Int, a)
forall a. (C a, C a) => a -> a -> (Int, a)
getMaximumExponent a
p a
q0 of
(Int
e,a
q1) -> (Int
eInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1,a
p) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: a -> [(Int, a)]
go a
q1
else
if a
q0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
p
then a -> [(Int, a)]
go a
m
else if a
ma -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
1 then [] else (Int
1,a
m) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [])
([(Int, a)] -> a -> [(Int, a)]
forall a b. a -> b -> a
const [])
((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. C a => a -> Bool
Units.isUnit) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
a -> [a]
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
n)
in case a -> a -> (Int, a)
forall a. (C a, C a) => a -> a -> (Int, a)
getMaximumExponent a
2 a
n of
(Int
0,a
m) -> a -> [(Int, a)]
oddFactors a
m
(Int
e,a
m) -> (Int
e,a
2) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: a -> [(Int, a)]
oddFactors a
m
isPrime :: Integer -> Bool
isPrime :: Integer -> Bool
isPrime Integer
n =
case Integer -> [(Int, Integer)]
forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors Integer
n of
[] -> Bool
False
(Int
e,Integer
m):[(Int, Integer)]
_ -> Int
eInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
&& Integer
mInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
n
raderWorstCases :: Integer -> [Integer]
raderWorstCases :: Integer -> [Integer]
raderWorstCases =
(Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate
(\Integer
n ->
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Integer -> Bool) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
isPrime) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
[Integer] -> [Integer]
forall a. HasCallStack => [a] -> [a]
tail ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
nInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+) Integer
1)
_fastFourierRingAlt :: Int -> Integer
_fastFourierRingAlt :: Int -> Integer
_fastFourierRingAlt Int
n =
case Int
n of
Int
0 -> Integer
2
Int
1 -> Integer
2
Int
_ ->
let ni :: Integer
ni = Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral Int
n
ps :: [Integer]
ps = (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
1) ((Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. C a => a -> a -> a
subtract Integer
1) (Integer -> [Integer]
partialPrimes Integer
ni))
in [Order] -> [Integer] -> Integer
ringWithPrimitiveRootsOfUnityAndUnits ((Integer -> Order) -> [Integer] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order ([Integer] -> [Order]) -> [Integer] -> [Order]
forall a b. (a -> b) -> a -> b
$ Integer
ni Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ps) [Integer]
ps
fastFourierRing :: Int -> Integer
fastFourierRing :: Int -> Integer
fastFourierRing Int
n =
case Int
n of
Int
0 -> Integer
2
Int
1 -> Integer
2
Int
_ ->
let ni :: Integer
ni = Int -> Integer
forall a b. (C a, C b) => a -> b
fromIntegral Int
n
in
[Integer] -> Integer
forall a. HasCallStack => [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter Integer -> Bool
isPrime ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
(\Integer
order -> (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer
order Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+) Integer
1) (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$
[Integer] -> Integer
forall a. C a => [a] -> a
lcmMulti ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$
Integer
ni Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. C a => a -> a -> a
subtract Integer
1) (Integer -> [Integer]
partialPrimes Integer
ni)