-- |
-- Module:      Math.NumberTheory.Euclidean.Coprimes
-- Copyright:   (c) 2017-2018 Andrew Lelechenko
-- Licence:     MIT
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Container for pairwise coprime numbers.

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Math.NumberTheory.Euclidean.Coprimes
  ( splitIntoCoprimes
  , Coprimes
  , unCoprimes
  , singleton
  , insert
  ) where

import Prelude hiding (gcd, quot, rem)
import Data.Coerce
import Data.Euclidean
import Data.List (tails)
import Data.Maybe
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup
#endif
import Data.Semiring (Semiring(..), isZero)
import Data.Traversable

-- | A list of pairwise coprime numbers
-- with their multiplicities.
newtype Coprimes a b = Coprimes {
  Coprimes a b -> [(a, b)]
unCoprimes :: [(a, b)] -- ^ Unwrap.
  }
  deriving (Coprimes a b -> Coprimes a b -> Bool
(Coprimes a b -> Coprimes a b -> Bool)
-> (Coprimes a b -> Coprimes a b -> Bool) -> Eq (Coprimes a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Coprimes a b -> Coprimes a b -> Bool
/= :: Coprimes a b -> Coprimes a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Coprimes a b -> Coprimes a b -> Bool
== :: Coprimes a b -> Coprimes a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Coprimes a b -> Coprimes a b -> Bool
Eq, Int -> Coprimes a b -> ShowS
[Coprimes a b] -> ShowS
Coprimes a b -> String
(Int -> Coprimes a b -> ShowS)
-> (Coprimes a b -> String)
-> ([Coprimes a b] -> ShowS)
-> Show (Coprimes a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Coprimes a b -> ShowS
forall a b. (Show a, Show b) => [Coprimes a b] -> ShowS
forall a b. (Show a, Show b) => Coprimes a b -> String
showList :: [Coprimes a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Coprimes a b] -> ShowS
show :: Coprimes a b -> String
$cshow :: forall a b. (Show a, Show b) => Coprimes a b -> String
showsPrec :: Int -> Coprimes a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Coprimes a b -> ShowS
Show)

unsafeDivide :: GcdDomain a => a -> a -> a
unsafeDivide :: a -> a -> a
unsafeDivide a
x a
y = case a
x a -> a -> Maybe a
forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
y of
  Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error String
"violated prerequisite of unsafeDivide"
  Just a
z  -> a
z

-- | Check whether an element is a unit of the ring.
isUnit :: (Eq a, GcdDomain a) => a -> Bool
isUnit :: a -> Bool
isUnit a
x = Bool -> Bool
not (a -> Bool
forall a. (Eq a, Semiring a) => a -> Bool
isZero a
x) Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (a
forall a. Semiring a => a
one a -> a -> Maybe a
forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
x)

doPair :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> a -> b -> (a, a, [(a, b)])
doPair :: a -> b -> a -> b -> (a, a, [(a, b)])
doPair a
x b
xm a
y b
ym
  | a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
g  = (a
x, a
y, [])
  | Bool
otherwise = (a
x', a
y', [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, b)]]
rests)
    where
      g :: a
g = a -> a -> a
forall a. GcdDomain a => a -> a -> a
gcd a
x a
y

      (a
x', a
g', [(a, b)]
xgs) = a -> b -> a -> b -> (a, a, [(a, b)])
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> a -> b -> (a, a, [(a, b)])
doPair (a
x a -> a -> a
forall a. GcdDomain a => a -> a -> a
`unsafeDivide` a
g) b
xm a
g (b
xm b -> b -> b
forall a. Num a => a -> a -> a
+ b
ym)
      xgs' :: [(a, b)]
xgs' = if a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
g' then [(a, b)]
xgs else (a
g', b
xm b -> b -> b
forall a. Num a => a -> a -> a
+ b
ym) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
xgs

      (a
y', [[(a, b)]]
rests) = (a -> (a, b) -> (a, [(a, b)])) -> a -> [(a, b)] -> (a, [[(a, b)]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL a -> (a, b) -> (a, [(a, b)])
forall a. (GcdDomain a, Eq a) => a -> (a, b) -> (a, [(a, b)])
go (a
y a -> a -> a
forall a. GcdDomain a => a -> a -> a
`unsafeDivide` a
g) [(a, b)]
xgs'
      go :: a -> (a, b) -> (a, [(a, b)])
go a
w (a
t, b
tm) = (a
w', if a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
t' Bool -> Bool -> Bool
|| b
tm b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0 then [(a, b)]
acc else (a
t', b
tm) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc)
        where
          (a
w', a
t', [(a, b)]
acc) = a -> b -> a -> b -> (a, a, [(a, b)])
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> a -> b -> (a, a, [(a, b)])
doPair a
w b
ym a
t b
tm

_propDoPair :: (Eq a, Num a, GcdDomain a, Integral b) => a -> b -> a -> b -> Bool
_propDoPair :: a -> b -> a -> b -> Bool
_propDoPair a
x b
xm a
y b
ym
  =  Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (a
x a -> a -> Maybe a
forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
x')
  Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (a
y a -> a -> Maybe a
forall a. GcdDomain a => a -> a -> Maybe a
`divide` a
y')
  Bool -> Bool -> Bool
&& a -> a -> Bool
forall a. GcdDomain a => a -> a -> Bool
coprime a
x' a
y'
  Bool -> Bool -> Bool
&& ((a, b) -> Bool) -> [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. GcdDomain a => a -> a -> Bool
coprime a
x' (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
rest
  Bool -> Bool -> Bool
&& ((a, b) -> Bool) -> [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. GcdDomain a => a -> a -> Bool
coprime a
y' (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
rest
  Bool -> Bool -> Bool
&& Bool -> Bool
not (((a, b) -> Bool) -> [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
rest)
  Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ a -> a -> Bool
forall a. GcdDomain a => a -> a -> Bool
coprime a
s a
t | (a
s, b
_) : [(a, b)]
ts <- [(a, b)] -> [[(a, b)]]
forall a. [a] -> [[a]]
tails [(a, b)]
rest, (a
t, b
_) <- [(a, b)]
ts ]
  Bool -> Bool -> Bool
&& a -> a
forall a. Num a => a -> a
abs ((a
x a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
xm) a -> a -> a
forall a. Num a => a -> a -> a
* (a
y a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
ym)) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Num a => a -> a
abs ((a
x' a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
xm) a -> a -> a
forall a. Num a => a -> a -> a
* (a
y' a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
ym) a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> a) -> (a, b) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
(^)) [(a, b)]
rest))
  where
    (a
x', a
y', [(a, b)]
rest) = a -> b -> a -> b -> (a, a, [(a, b)])
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> a -> b -> (a, a, [(a, b)])
doPair a
x b
xm a
y b
ym

insertInternal
  :: forall a b.
     (Eq a, GcdDomain a, Eq b, Num b)
  => a
  -> b
  -> Coprimes a b
  -> (Coprimes a b, Coprimes a b)
insertInternal :: a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)
insertInternal a
xx b
xm
  | a -> Bool
forall a. (Eq a, Semiring a) => a -> Bool
isZero a
xx Bool -> Bool -> Bool
&& b
xm b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0 = (, [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes [])
  | a -> Bool
forall a. (Eq a, Semiring a) => a -> Bool
isZero a
xx            = (Coprimes a b, Coprimes a b)
-> Coprimes a b -> (Coprimes a b, Coprimes a b)
forall a b. a -> b -> a
const ([(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes [(a
forall a. Semiring a => a
zero, b
1)], [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes [])
  | Bool
otherwise            = ([(a, b)] -> ([(a, b)], [(a, b)]))
-> Coprimes a b -> (Coprimes a b, Coprimes a b)
coerce (([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])
go ([], []) a
xx)
  where
    go :: ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])
    go :: ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])
go ([(a, b)]
old, [(a, b)]
new) a
x [(a, b)]
rest
      | a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
x = ([(a, b)]
rest [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
old, [(a, b)]
new)
    go ([(a, b)]
old, [(a, b)]
new) a
x [] = ([(a, b)]
old, (a
x, b
xm) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
new)
    go ([(a, b)], [(a, b)])
_ a
_ ((a
x, b
_) : [(a, b)]
_)
      | a -> Bool
forall a. (Eq a, Semiring a) => a -> Bool
isZero a
x = ([(a
forall a. Semiring a => a
zero, b
1)], [])
    go ([(a, b)]
old, [(a, b)]
new) a
x ((a
y, b
ym) : [(a, b)]
rest)
      | a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
y' = ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])
go ([(a, b)]
old, [(a, b)]
xys [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
new) a
x' [(a, b)]
rest
      | Bool
otherwise = ([(a, b)], [(a, b)]) -> a -> [(a, b)] -> ([(a, b)], [(a, b)])
go ((a
y', b
ym) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
old, [(a, b)]
xys [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
new) a
x' [(a, b)]
rest
      where
        (a
x', a
y', [(a, b)]
xys) = a -> b -> a -> b -> (a, a, [(a, b)])
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> a -> b -> (a, a, [(a, b)])
doPair a
x b
xm a
y b
ym

-- | Wrap a non-zero number with its multiplicity into 'Coprimes'.
--
-- >>> singleton 210 1
-- Coprimes {unCoprimes = [(210,1)]}
singleton :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b
singleton :: a -> b -> Coprimes a b
singleton a
a b
b
  | a -> Bool
forall a. (Eq a, Semiring a) => a -> Bool
isZero a
a Bool -> Bool -> Bool
&& b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0 = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes []
  | a -> Bool
forall a. (Eq a, GcdDomain a) => a -> Bool
isUnit a
a           = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes []
  | Bool
otherwise          = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes [(a
a, b
b)]

-- | Add a non-zero number with its multiplicity to 'Coprimes'.
--
-- >>> insert 360 1 (singleton 210 1)
-- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]}
-- >>> insert 2 4 (insert 7 1 (insert 5 2 (singleton 4 3)))
-- Coprimes {unCoprimes = [(7,1),(5,2),(2,10)]}
insert :: (Eq a, GcdDomain a, Eq b, Num b) => a -> b -> Coprimes a b -> Coprimes a b
insert :: a -> b -> Coprimes a b -> Coprimes a b
insert a
x b
xm Coprimes a b
ys = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes ([(a, b)] -> Coprimes a b) -> [(a, b)] -> Coprimes a b
forall a b. (a -> b) -> a -> b
$ Coprimes a b -> [(a, b)]
forall a b. Coprimes a b -> [(a, b)]
unCoprimes Coprimes a b
zs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. Semigroup a => a -> a -> a
<> Coprimes a b -> [(a, b)]
forall a b. Coprimes a b -> [(a, b)]
unCoprimes Coprimes a b
ws
  where
    (Coprimes a b
zs, Coprimes a b
ws) = a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)
insertInternal a
x b
xm Coprimes a b
ys

instance (Eq a, GcdDomain a, Eq b, Num b) => Semigroup (Coprimes a b) where
  (Coprimes [(a, b)]
xs) <> :: Coprimes a b -> Coprimes a b -> Coprimes a b
<> Coprimes a b
ys = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes ([(a, b)] -> Coprimes a b) -> [(a, b)] -> Coprimes a b
forall a b. (a -> b) -> a -> b
$ Coprimes a b -> [(a, b)]
forall a b. Coprimes a b -> [(a, b)]
unCoprimes Coprimes a b
zs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. Semigroup a => a -> a -> a
<> (Coprimes a b -> [(a, b)]) -> [Coprimes a b] -> [(a, b)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Coprimes a b -> [(a, b)]
forall a b. Coprimes a b -> [(a, b)]
unCoprimes [Coprimes a b]
wss
    where
      (Coprimes a b
zs, [Coprimes a b]
wss) = (Coprimes a b -> (a, b) -> (Coprimes a b, Coprimes a b))
-> Coprimes a b -> [(a, b)] -> (Coprimes a b, [Coprimes a b])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Coprimes a b
vs (a
x, b
xm) -> a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> Coprimes a b -> (Coprimes a b, Coprimes a b)
insertInternal a
x b
xm Coprimes a b
vs) Coprimes a b
ys [(a, b)]
xs

instance (Eq a, GcdDomain a, Eq b, Num b) => Monoid (Coprimes a b) where
  mempty :: Coprimes a b
mempty  = [(a, b)] -> Coprimes a b
forall a b. [(a, b)] -> Coprimes a b
Coprimes []
  mappend :: Coprimes a b -> Coprimes a b -> Coprimes a b
mappend = Coprimes a b -> Coprimes a b -> Coprimes a b
forall a. Semigroup a => a -> a -> a
(<>)

-- | The input list is assumed to be a factorisation of some number
-- into a list of powers of (possibly, composite) non-zero factors. The output
-- list is a factorisation of the same number such that all factors
-- are coprime. Such transformation is crucial to continue factorisation
-- (lazily, in parallel or concurrent fashion) without
-- having to merge multiplicities of primes, which occurs more than in one
-- composite factor.
--
-- >>> splitIntoCoprimes [(140, 1), (165, 1)]
-- Coprimes {unCoprimes = [(28,1),(33,1),(5,2)]}
-- >>> splitIntoCoprimes [(360, 1), (210, 1)]
-- Coprimes {unCoprimes = [(7,1),(5,2),(3,3),(2,4)]}
splitIntoCoprimes :: (Eq a, GcdDomain a, Eq b, Num b) => [(a, b)] -> Coprimes a b
splitIntoCoprimes :: [(a, b)] -> Coprimes a b
splitIntoCoprimes = (Coprimes a b -> (a, b) -> Coprimes a b)
-> Coprimes a b -> [(a, b)] -> Coprimes a b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Coprimes a b
acc (a
x, b
xm) -> a -> b -> Coprimes a b -> Coprimes a b
forall a b.
(Eq a, GcdDomain a, Eq b, Num b) =>
a -> b -> Coprimes a b -> Coprimes a b
insert a
x b
xm Coprimes a b
acc) Coprimes a b
forall a. Monoid a => a
mempty