{-# 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 forall a. Bits a => a -> a -> a
.&. (-a
n)
in (a
powerOfTwo, 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 forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
a,Integer
b) -> (Integer
bforall a. C a => a -> a -> a
-Integer
a,Integer
bforall a. C a => a -> a -> a
+Integer
a)) forall a b. (a -> b) -> a -> b
$
forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter
(forall a b. [a] -> [b] -> [(a, b)]
zip (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. C a => a -> a -> a
(+) Integer
n [Integer
1,Integer
3..]) [Integer
0 .. forall a. C a => a -> a -> a
div (Integer
nforall a. C a => a -> a -> a
-Integer
1) Integer
2])
(forall a b. [a] -> [b] -> [(a, b)]
zip (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. C a => a -> a -> a
(+) (Integer
rootforall a. C a => a -> a -> a
*Integer
root) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Integer
2forall a. C a => a -> a -> a
+) (Integer
2forall a. C a => a -> a -> a
*Integer
rootforall 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 forall a. Ord a => a -> a -> Ordering
compare a
a0 a
a1 of
Ordering
LT -> forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter [(a, b)]
a0s ((a
a1,c
c)forall a. a -> [a] -> [a]
:[(a, c)]
a1s)
Ordering
GT -> forall a b c. Ord a => [(a, b)] -> [(a, c)] -> [(b, c)]
mergeAndFilter ((a
a0,b
b)forall a. a -> [a] -> [a]
:[(a, b)]
a0s) [(a, c)]
a1s
Ordering
EQ -> (b
b,c
c) forall a. a -> [a] -> [a]
: 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 forall a. Set a -> Maybe (a, Set a)
Set.minView Set Integer
candidates of
Maybe (Integer, Set Integer)
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
p forall a. [a] -> [a] -> [a]
++ [Char]
" is not a prime"
Just (Integer
x,Set Integer
rest) ->
case forall a. Ord a => T a -> Set a
orbitSet forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> T a
orbit Integer
p Integer
x of
Set Integer
new ->
if Set Integer
new forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> Set a
Set.fromList [Integer
1..Integer
pforall a. C a => a -> a -> a
-Integer
1]
then Integer
x
else Set Integer -> Integer
search (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Integer
rest Set Integer
new)
in Set Integer -> Integer
search forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Integer
1..Integer
pforall a. C a => a -> a -> a
-Integer
1]
multiplicativeGeneratorDivisors :: Integer -> Integer
multiplicativeGeneratorDivisors :: Integer -> Integer
multiplicativeGeneratorDivisors Integer
p =
forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnity Integer
p (Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ Integer
pforall a. C a => a -> a -> a
-Integer
1)
newtype Order = Order {Order -> Integer
getOrder :: Integer}
deriving (Int -> Order -> ShowS
[Order] -> ShowS
Order -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> [Char]
$cshow :: Order -> [Char]
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Eq 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
min :: Order -> Order -> Order
$cmin :: Order -> Order -> Order
max :: Order -> Order -> Order
$cmax :: Order -> Order -> Order
>= :: Order -> Order -> Bool
$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
compare :: Order -> Order -> Ordering
$ccompare :: Order -> Order -> Ordering
Ord)
instance Arbitrary Order where
arbitrary :: Gen Order
arbitrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Order
Order forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1forall a. C a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a
abs) forall a. Arbitrary a => Gen a
arbitrary
instance Enum Order where
succ :: Order -> Order
succ (Order Integer
n) = Integer -> Order
Order (Integer
nforall a. C a => a -> a -> a
+Integer
1)
pred :: Order -> Order
pred (Order Integer
n) = Integer -> Order
Order (Integer
nforall a. C a => a -> a -> a
-Integer
1)
fromEnum :: Order -> Int
fromEnum (Order Integer
n) = forall a. Enum a => a -> Int
fromEnum Integer
n
toEnum :: Int -> Order
toEnum Int
n = Integer -> Order
Order (forall a. Enum a => Int -> a
toEnum Int
n)
enumFrom :: Order -> [Order]
enumFrom (Order Integer
from) =
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> [a]
enumFrom Integer
from
enumFromThen :: Order -> Order -> [Order]
enumFromThen (Order Integer
from) (Order Integer
thn) =
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
enumFromThen Integer
from Integer
thn
enumFromTo :: Order -> Order -> [Order]
enumFromTo (Order Integer
from) (Order Integer
to) =
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ 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) =
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
from Integer
thn Integer
to
countOrder :: [a] -> Order
countOrder :: forall a. [a] -> Order
countOrder = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Order
o a
_ -> 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) =
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
moduforall 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 =
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. C a => a -> a -> a
div Integer
order) forall a b. (a -> b) -> a -> b
$ forall a. (C a, Bits a, C a, Ord a) => a -> [a]
uniquePrimeFactors Integer
order
in forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
let pow :: Integer -> a
pow Integer
y = forall a. T a -> a
RC.representative forall a b. (a -> b) -> a -> b
$ (a
n forall a. C a => a -> a -> T a
/: a
modu) forall a. C a => a -> Integer -> a
^ Integer
y
in forall a. C a => a -> a -> Bool
PID.coprime a
n a
modu
Bool -> Bool -> Bool
&&
Integer -> a
pow Integer
order forall a. Eq a => a -> a -> Bool
== forall a. C a => a
one
Bool -> Bool -> Bool
&&
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Integer
y -> Integer -> a
pow Integer
y forall a. Eq a => a -> a -> Bool
/= forall a. C a => a
one) [Integer]
greatDivisors) forall a b. (a -> b) -> a -> b
$
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) =
forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
let ([a]
prefix,a
end:[a]
_) =
forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt (Integer
expoforall a. C a => a -> a -> a
-Integer
1) forall a b. (a -> b) -> a -> b
$ forall y. T y -> [y]
SigS.toList forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> T a
orbit a
modu a
n
in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
1forall a. Eq a => a -> a -> Bool
/=) [a]
prefix Bool -> Bool -> Bool
&& a
endforall a. Eq a => a -> a -> Bool
==a
1) forall a b. (a -> b) -> a -> b
$
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 =
forall x acc. (x -> acc -> acc) -> acc -> T x -> acc
SigS.foldR
(\a
new Set a -> Set a
cont Set a
seen ->
if 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 (forall a. Ord a => a -> Set a -> Set a
Set.insert a
new Set a
seen))
forall a. a -> a
id T a
list 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 = forall a. (a -> a) -> a -> T a
SigS.iterate (\a
y -> forall a. C a => a -> a -> a
mod (a
xforall 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 =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList) forall a b. (a -> b) -> a -> b
$
forall a. (PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit a
modu Order
expo a
x
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ([a], Set a)
search forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. C a => a -> a -> Bool
PID.coprime a
modu) forall a b. (a -> b) -> a -> b
$
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 =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((,) a
x,
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList) forall a b. (a -> b) -> a -> b
$
forall a. (PrimitiveRoot a, Ord a) => a -> Order -> a -> ([a], [a])
primitiveRootsOfOrbit a
modu Order
expo a
x
in forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ((a, [a]), Set a)
search forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. C a => a -> a -> Bool
PID.coprime a
modu) forall a b. (a -> b) -> a -> b
$
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
1forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a
1forall a. Eq a => a -> a -> Bool
/=) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (\a
y -> forall a. C a => a -> a -> a
mod (a
xforall a. C a => a -> a -> a
*a
y) a
modu) a
x
(Order Integer
orbitSize) = forall a. [a] -> Order
countOrder [a]
orb
in (if Integer
expoforall a. Eq a => a -> a -> Bool
==Integer
0
then []
else
case forall a. C a => a -> a -> (a, a)
divMod Integer
orbitSize Integer
expo of
(Integer
s,Integer
0) ->
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. C a => a -> a -> Bool
PID.coprime Integer
expo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip
[Integer
0 .. Integer
expoforall a. C a => a -> a -> a
-Integer
1]
(forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (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 =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Order -> Order -> Bool
dividesOrder Order
expo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
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 =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max (Integer -> Order
Order Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Set a -> Maybe (a, Set a)
Set.minView Set a
candidates) forall a b. (a -> b) -> a -> b
$ \(a
x,Set a
rest) ->
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((,) a
x,
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
rest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList) forall a b. (a -> b) -> a -> b
$
forall a. (PrimitiveRoot a, Ord a) => a -> a -> (Order, [a])
orderOfOrbit a
modu a
x
in forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Set a -> Maybe ((a, Order), Set a)
search forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. C a => a -> a -> Bool
PID.coprime a
modu) forall a b. (a -> b) -> a -> b
$
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 = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. C a => a
oneforall a. Eq a => a -> a -> Bool
/=) forall a b. (a -> b) -> a -> b
$ forall y. T y -> [y]
SigS.toList forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> T a
orbit a
modu a
x
in (forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$
Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger Integer
modu
maximumOrderOfPrimitiveRootsOfUnityInteger ::
Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger :: Integer -> Order
maximumOrderOfPrimitiveRootsOfUnityInteger =
Integer -> Order
Order forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. C a => [a] -> a
lcmMulti forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map
(\(Integer
e,Integer
p) ->
if Integer
p forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Integer
e forall a. Ord a => a -> a -> Bool
> Integer
2
then Integer
pforall a. C a => a -> Integer -> a
^(Integer
eforall a. C a => a -> a -> a
-Integer
2)
else Integer
pforall a. C a => a -> Integer -> a
^(Integer
eforall a. C a => a -> a -> a
-Integer
1) forall a. C a => a -> a -> a
* (Integer
pforall a. C a => a -> a -> a
-Integer
1)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall a b. (C a, C b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors
ordersOfPrimitiveRootsOfUnityInteger :: [[Int]]
ordersOfPrimitiveRootsOfUnityInteger :: [[Int]]
ordersOfPrimitiveRootsOfUnityInteger =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
let maxOrder :: Order
maxOrder = forall a. PrimitiveRoot a => a -> Order
maximumOrderOfPrimitiveRootsOfUnity (Integer
modu::Integer)
in forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
primitiveRootsOfUnityPower Integer
modu) forall a b. (a -> b) -> a -> b
$
[Integer -> Order
Order Integer
1 .. Order
maxOrder]
ordersOfRootsOfUnityInteger :: [[Int]]
ordersOfRootsOfUnityInteger :: [[Int]]
ordersOfRootsOfUnityInteger =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower (Integer
modu::Integer)) forall a b. (a -> b) -> a -> b
$
[Integer -> Order
Order Integer
1 ..]
ordersOfRootsOfUnityIntegerCondensed :: [[Int]]
ordersOfRootsOfUnityIntegerCondensed :: [[Int]]
ordersOfRootsOfUnityIntegerCondensed =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Integer
1..] forall a b. (a -> b) -> a -> b
$ \Integer
modu ->
let maxOrder :: Order
maxOrder = forall a. PrimitiveRoot a => a -> Order
maximumOrderOfPrimitiveRootsOfUnity (Integer
modu::Integer)
in forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (PrimitiveRoot a, Eq a) => a -> Order -> [a]
rootsOfUnityPower Integer
modu) 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) =
forall a. (a -> Bool) -> [a] -> [a]
filter
(\a
n ->
forall a. C a => a -> a -> Bool
PID.coprime a
n a
modu
Bool -> Bool -> Bool
&&
forall a. T a -> a
RC.representative ((a
n forall a. C a => a -> a -> T a
/: a
modu) forall a. C a => a -> Integer -> a
^ Integer
expo) forall a. Eq a => a -> a -> Bool
== forall a. C a => a
one) forall a b. (a -> b) -> a -> b
$
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
modu
ringsWithPrimitiveRootOfUnityAndUnit :: Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit :: Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit order :: Order
order@(Order Integer
k) =
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger Order
order) forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (Integer
kforall a. C a => a -> a -> a
+) Integer
1
ringsWithPrimitiveRootsOfUnityAndUnitsNaive :: [Order] -> [Integer] -> [Integer]
ringsWithPrimitiveRootsOfUnityAndUnitsNaive :: [Order] -> [Integer] -> [Integer]
ringsWithPrimitiveRootsOfUnityAndUnitsNaive [Order]
rootOrders [Integer]
units =
forall a. (a -> Bool) -> [a] -> [a]
filter
(\Integer
n ->
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Order -> Bool
hasPrimitiveRootOfUnityInteger Integer
n) [Order]
rootOrders Bool -> Bool -> Bool
&&
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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 = forall a. C a => [a] -> a
lcmMulti [Integer]
units
in forall a. C a => [a] -> a
lcmMulti forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. C a => a -> a -> Bool
PID.coprime Integer
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Order -> [Integer]
ringsWithPrimitiveRootOfUnityAndUnit) 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
_ ->
forall a. C a => [a] -> a
product forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (C a, C b) => b -> a -> a
ringPower) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
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 forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 Integer
p Map Integer Int
factors forall a. Ord a => a -> a -> Bool
>= Int
e
then (Map Integer Int
factors, (Int
0,Integer
p))
else
if Integer
pforall 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
eforall a. C a => a -> a -> a
+Int
2, Integer
2))
else
(forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Ord a => a -> a -> a
max Map Integer Int
factors forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors forall a b. (a -> b) -> a -> b
$ Integer
pforall a. C a => a -> a -> a
-Integer
1,
(Int
eforall a. C a => a -> a -> a
+Int
1, Integer
p)))
forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors forall a b. (a -> b) -> a -> b
$ forall a. C a => [a] -> a
lcmMulti forall a b. (a -> b) -> a -> b
$
Integer
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. C a => a -> a -> a
lcm forall a. C a => a
one
numbers3Smooth :: [Integer]
numbers3Smooth :: [Integer]
numbers3Smooth = [Integer]
numbers3SmoothCorec
numbers3SmoothCorec :: [Integer]
numbers3SmoothCorec :: [Integer]
numbers3SmoothCorec = forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
3 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Integer
2forall 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 forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy forall a. Ord a => a -> a -> Bool
(<=) [a]
xs (forall a b. (a -> b) -> [a] -> [b]
map (a
pforall a. C a => a -> a -> a
*) [a]
ys)
in [a]
ys
numbers3SmoothFoldr :: [Integer]
numbers3SmoothFoldr :: [Integer]
numbers3SmoothFoldr =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Integer
x0:Integer
x1:[Integer]
xs) [Integer]
ys -> Integer
x0 forall a. a -> [a] -> [a]
: Integer
x1 forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy forall a. Ord a => a -> a -> Bool
(<=) [Integer]
xs [Integer]
ys)
(forall a. HasCallStack => [Char] -> a
error [Char]
"numbers3SmoothFoldr: infinite list should not have an end") forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (forall a b. (a -> b) -> [a] -> [b]
map (Integer
3forall a. C a => a -> a -> a
*)) forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (Integer
2forall a. C a => a -> a -> a
*) Integer
1
numbers3SmoothSet :: [Integer]
numbers3SmoothSet :: [Integer]
numbers3SmoothSet =
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
m,Set Integer
rest) -> (Integer
m, forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Integer
rest forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> Set a
Set.fromAscList [Integer
2forall a. C a => a -> a -> a
*Integer
m,Integer
3forall a. C a => a -> a -> a
*Integer
m])) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Set a -> Maybe (a, Set a)
Set.minView) forall a b. (a -> b) -> a -> b
$
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
forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
5 forall a b. (a -> b) -> a -> b
$ [Integer]
numbers3SmoothCorec
else forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
5 forall a b. (a -> b) -> a -> b
$ forall a. (Ord a, C a) => a -> [a] -> [a]
mergePowers Integer
3 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Integer
2forall a. C a => a -> a -> a
*) Integer
1
numbers5SmoothFoldr :: [Integer]
numbers5SmoothFoldr :: [Integer]
numbers5SmoothFoldr =
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 forall a. a -> [a] -> [a]
: Integer
x1 forall a. a -> [a] -> [a]
: Integer
x2 forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
ListHT.mergeBy forall a. Ord a => a -> a -> Bool
(<=) [Integer]
xs [Integer]
ys)
(forall a. HasCallStack => [Char] -> a
error [Char]
"numbers5SmoothFoldr: infinite list should not have an end") forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (forall a b. (a -> b) -> [a] -> [b]
map (Integer
5forall a. C a => a -> a -> a
*)) forall a b. (a -> b) -> a -> b
$
[Integer]
numbers3SmoothFoldr
numbers5SmoothSet :: [Integer]
numbers5SmoothSet :: [Integer]
numbers5SmoothSet =
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
m,Set Integer
rest) -> (Integer
m, forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Integer
rest forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> Set a
Set.fromAscList [Integer
2forall a. C a => a -> a -> a
*Integer
m,Integer
3forall a. C a => a -> a -> a
*Integer
m,Integer
5forall a. C a => a -> a -> a
*Integer
m])) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Set a -> Maybe (a, Set a)
Set.minView) forall a b. (a -> b) -> a -> b
$
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
1forall a. C a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(/=)) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent (,) forall a b. (a -> b) -> a -> b
$
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
m Int
d -> forall a. Bits a => a -> Int -> a
shiftR a
m Int
d forall a. Bits a => a -> a -> a
.|. a
m) (a
nforall a. C a => a -> a -> a
-a
1) forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (Int
2forall 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 forall a. C a => a -> Integer -> a
^ forall a b. (C a, C b) => a -> b
fromIntegral (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 =
forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
>a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. C a => a -> a -> a
div a
base) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$
a
n forall a. a -> [a] -> [a]
: forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\a
m -> case forall a. C a => a -> a -> (a, a)
divMod a
m a
b of (a
q,a
r) -> forall a. Bool -> a -> Maybe a
toMaybe (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 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 =
forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ (Int
0,a
n) forall a. a -> [a] -> [a]
:
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(\(Int
e,a
m) ->
let (a
q,a
r) = forall a. C a => a -> a -> (a, a)
divMod a
m a
b
eq :: (Int, a)
eq = (Int
eforall a. C a => a -> a -> a
+Int
1,a
q)
in forall a. Bool -> a -> Maybe a
toMaybe (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
1forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
2
is5Smooth :: Integer -> Bool
is5Smooth :: Integer -> Bool
is5Smooth =
(Integer
1forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (C a, C a) => a -> a -> a
divideByMaximumPower Integer
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 =
forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<Integer
n) [Integer]
numbers3Smooth
ceiling5SmoothScan :: Integer -> Integer
ceiling5SmoothScan :: Integer -> Integer
ceiling5SmoothScan Integer
n =
forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<Integer
n) [Integer]
numbers5Smooth
ceiling3SmoothNaive :: Integer -> Integer
ceiling3SmoothNaive :: Integer -> Integer
ceiling3SmoothNaive =
forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
is3Smooth) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (Integer
1forall a. C a => a -> a -> a
+)
ceiling5SmoothNaive :: Integer -> Integer
ceiling5SmoothNaive :: Integer -> Integer
ceiling5SmoothNaive =
forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
is5Smooth) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (Integer
1forall a. C a => a -> a -> a
+)
ceiling3SmoothTrace :: Integer -> Integer
ceiling3SmoothTrace :: Integer -> Integer
ceiling3SmoothTrace Integer
n =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n forall a b. (a -> b) -> a -> b
$ forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo Integer
n
_ceiling5SmoothTraceWrong :: Integer -> Integer
_ceiling5SmoothTraceWrong :: Integer -> Integer
_ceiling5SmoothTraceWrong Integer
n =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
3 Integer
5 Integer
n) forall a b. (a -> b) -> a -> b
$
Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n forall a b. (a -> b) -> a -> b
$ forall a. (C a, Bits a) => a -> a
ceilingPowerOfTwo Integer
n
ceiling5SmoothTrace :: Integer -> Integer
ceiling5SmoothTrace :: Integer -> Integer
ceiling5SmoothTrace Integer
n =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
5 Integer
n) forall a b. (a -> b) -> a -> b
$
Integer -> Integer -> Integer -> Integer -> [Integer]
ceilingSmoothsTrace Integer
2 Integer
3 Integer
n forall a b. (a -> b) -> a -> b
$ 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 forall a. C a => a -> a -> (a, a)
divMod Integer
k Integer
a of
(Integer
q,Integer
r) -> if Integer
rforall a. Eq a => a -> a -> Bool
==Integer
0 Bool -> Bool -> Bool
&& Integer
qforall 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 forall a. a -> [a] -> [a]
: if forall a. C a => a -> a -> a
mod Integer
m Integer
a forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer -> [Integer]
go forall a b. (a -> b) -> a -> b
$ Integer -> Integer
divMany forall a b. (a -> b) -> a -> b
$ Integer
mforall 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 = forall a. Eq a => [a] -> Set a
Set.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (C a, Bits a, C a, Ord a) => a -> [a]
uniquePrimeFactors
in forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(Integer
p,Set Integer
set) ->
(Integer
p, forall a. Ord a => Set a -> Set a -> Set a
Set.union (Integer -> Set Integer
primeFactorSet (Integer
pforall a. C a => a -> a -> a
-Integer
1)) Set Integer
set)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Set a -> Maybe (a, Set a)
Set.maxView)
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 =
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) = forall a. C a => a -> a -> (a, a)
divMod a
m a
p
in if a
rforall a. Eq a => a -> a -> Bool
==a
0
then a
p forall a. a -> [a] -> [a]
: a -> [a]
go (forall a. (C a, C a) => a -> a -> a
divideByMaximumPower a
p a
q)
else
if a
q forall a. Ord a => a -> a -> Bool
>= a
p
then a -> [a]
go a
m
else if a
mforall a. Eq a => a -> a -> Bool
==a
1 then [] else a
m forall a. a -> [a] -> [a]
: [])
(forall a. HasCallStack => [Char] -> a
error [Char]
"uniquePrimeFactors: end of infinite list")
(forall a. (a -> a) -> a -> [a]
iterate (a
2forall a. C a => a -> a -> a
+) a
3)
in case 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 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 =
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) = forall a. C a => a -> a -> (a, a)
divMod a
m a
p
in if a
rforall a. Eq a => a -> a -> Bool
==a
0
then
case forall a. (C a, C a) => a -> a -> (Int, a)
getMaximumExponent a
p a
q0 of
(Int
e,a
q1) -> (Int
eforall a. C a => a -> a -> a
+Int
1,a
p) forall a. a -> [a] -> [a]
: a -> [(Int, a)]
go a
q1
else
if a
q0 forall a. Ord a => a -> a -> Bool
>= a
p
then a -> [(Int, a)]
go a
m
else if a
mforall a. Eq a => a -> a -> Bool
==a
1 then [] else (Int
1,a
m) forall a. a -> [a] -> [a]
: [])
(forall a b. a -> b -> a
const [])
(forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> Bool
Units.isUnit) forall a b. (a -> b) -> a -> b
$
forall a. PrimitiveRoot a => a -> [a]
primitiveRootCandidates a
n)
in case 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) forall a. a -> [a] -> [a]
: a -> [(Int, a)]
oddFactors a
m
isPrime :: Integer -> Bool
isPrime :: Integer -> Bool
isPrime Integer
n =
case forall a. (PrimitiveRoot a, Ord a) => a -> [(Int, a)]
primeFactors Integer
n of
[] -> Bool
False
(Int
e,Integer
m):[(Int, Integer)]
_ -> Int
eforall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
&& Integer
mforall a. Eq a => a -> a -> Bool
==Integer
n
raderWorstCases :: Integer -> [Integer]
raderWorstCases :: Integer -> [Integer]
raderWorstCases =
forall a. (a -> a) -> a -> [a]
iterate
(\Integer
n ->
forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
isPrime) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (Integer
nforall 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 = forall a b. (C a, C b) => a -> b
fromIntegral Int
n
ps :: [Integer]
ps = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>Integer
1) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. C a => a -> a -> a
subtract Integer
1) (Integer -> [Integer]
partialPrimes Integer
ni))
in [Order] -> [Integer] -> Integer
ringWithPrimitiveRootsOfUnityAndUnits (forall a b. (a -> b) -> [a] -> [b]
map Integer -> Order
Order forall a b. (a -> b) -> a -> b
$ Integer
ni 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 = forall a b. (C a, C b) => a -> b
fromIntegral Int
n
in
forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Integer -> Bool
isPrime forall a b. (a -> b) -> a -> b
$
(\Integer
order -> forall a. (a -> a) -> a -> [a]
iterate (Integer
order forall a. C a => a -> a -> a
+) Integer
1) forall a b. (a -> b) -> a -> b
$
forall a. C a => [a] -> a
lcmMulti forall a b. (a -> b) -> a -> b
$
Integer
ni forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. C a => a -> a -> a
subtract Integer
1) (Integer -> [Integer]
partialPrimes Integer
ni)