{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Math.NumberTheory.SmoothNumbers
( SmoothBasis
, unSmoothBasis
, fromList
, isSmooth
, smoothOver
, smoothOver'
) where
import Prelude hiding (div, mod, gcd, (+))
import Data.Euclidean
import Data.List (nub)
import Data.Maybe
import Data.Semiring
newtype SmoothBasis a = SmoothBasis
{ forall a. SmoothBasis a -> [a]
unSmoothBasis :: [a]
}
deriving (Int -> SmoothBasis a -> ShowS
forall a. Show a => Int -> SmoothBasis a -> ShowS
forall a. Show a => [SmoothBasis a] -> ShowS
forall a. Show a => SmoothBasis a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmoothBasis a] -> ShowS
$cshowList :: forall a. Show a => [SmoothBasis a] -> ShowS
show :: SmoothBasis a -> String
$cshow :: forall a. Show a => SmoothBasis a -> String
showsPrec :: Int -> SmoothBasis a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SmoothBasis a -> ShowS
Show)
fromList :: (Eq a, GcdDomain a) => [a] -> SmoothBasis a
fromList :: forall a. (Eq a, GcdDomain a) => [a] -> SmoothBasis a
fromList
= forall a. [a] -> SmoothBasis a
SmoothBasis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\a
x -> Bool -> Bool
not (forall a. (Eq a, Semiring a) => a -> Bool
isZero a
x) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (forall a. Semiring a => a
one forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub
smoothOver'
:: (Eq a, Num a, Ord b)
=> (a -> b)
-> SmoothBasis a
-> [a]
smoothOver' :: forall a b.
(Eq a, Num a, Ord b) =>
(a -> b) -> SmoothBasis a -> [a]
smoothOver' a -> b
norm (SmoothBasis [a]
pl) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\a
p [a]
l -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [a] -> [a]
skipHead [] forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
Prelude.* a
p))) [a]
l)
[a
1]
[a]
pl
where
skipHead :: [a] -> [a] -> [a]
skipHead [] [a]
b = [a]
b
skipHead (a
h : [a]
t) [a]
b = a
h forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
t [a]
b
merge :: [a] -> [a] -> [a]
merge [a]
a [] = [a]
a
merge [] [a]
b = [a]
b
merge a :: [a]
a@(a
ah : [a]
at) b :: [a]
b@(a
bh : [a]
bt)
| a -> b
norm a
bh forall a. Ord a => a -> a -> Bool
< a -> b
norm a
ah = a
bh forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
a [a]
bt
| a
ah forall a. Eq a => a -> a -> Bool
== a
bh = a
ah forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
at [a]
bt
| Bool
otherwise = a
ah forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
at [a]
b
smoothOver :: Integral a => SmoothBasis a -> [a]
smoothOver :: forall a. Integral a => SmoothBasis a -> [a]
smoothOver = forall a b.
(Eq a, Num a, Ord b) =>
(a -> b) -> SmoothBasis a -> [a]
smoothOver' forall a. Num a => a -> a
abs
isSmooth :: (Eq a, GcdDomain a) => SmoothBasis a -> a -> Bool
isSmooth :: forall a. (Eq a, GcdDomain a) => SmoothBasis a -> a -> Bool
isSmooth SmoothBasis a
prs a
x = Bool -> Bool
not (forall a. (Eq a, Semiring a) => a -> Bool
isZero a
x) Bool -> Bool -> Bool
&& forall a. (Eq a, GcdDomain a) => [a] -> a -> Bool
go (forall a. SmoothBasis a -> [a]
unSmoothBasis SmoothBasis a
prs) a
x
where
go :: (Eq a, GcdDomain a) => [a] -> a -> Bool
go :: forall a. (Eq a, GcdDomain a) => [a] -> a -> Bool
go [] a
n = forall a. Maybe a -> Bool
isJust (forall a. Semiring a => a
one forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
n)
go pps :: [a]
pps@(a
p:[a]
ps) a
n = case a
n forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
p of
Maybe a
Nothing -> forall a. (Eq a, GcdDomain a) => [a] -> a -> Bool
go [a]
ps a
n
Just a
q -> forall a. (Eq a, GcdDomain a) => [a] -> a -> Bool
go [a]
pps a
q Bool -> Bool -> Bool
|| forall a. (Eq a, GcdDomain a) => [a] -> a -> Bool
go [a]
ps a
n