    -- |
    -- 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 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
    import Data.Semiring (Semiring(..), isZero)
    import Data.Traversable

    -- | A list of pairwise coprime numbers
    -- with their multiplicities.
    newtype Coprimes a b = Coprimes {
      forall a b. 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
    $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
    /= :: 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
    $cshowsPrec :: forall a b. (Show a, Show b) => Int -> Coprimes a b -> ShowS
    showsPrec :: Int -> Coprimes a b -> ShowS
    $cshow :: forall a b. (Show a, Show b) => Coprimes a b -> String
    show :: Coprimes a b -> String
    $cshowList :: forall a b. (Show a, Show b) => [Coprimes a b] -> ShowS
    showList :: [Coprimes a b] -> ShowS
    Show)

    unsafeDivide :: GcdDomain a => a -> a -> a
    unsafeDivide :: forall a. GcdDomain a => 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 :: forall a. (Eq a, GcdDomain a) => 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 :: 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
      | 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 :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    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 :: forall a b.
    (Eq a, Num a, GcdDomain a, Integral b) =>
    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 a. Num 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 :: forall a b.
    (Eq a, GcdDomain a, Eq b, Num b) =>
    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)
    forall a b. Coercible a b => 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 :: forall a b.
    (Eq a, GcdDomain a, Eq b, Num b) =>
    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 :: 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
    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 m a. Monoid m => (a -> m) -> [a] -> m
    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 :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    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 :: forall a b.
    (Eq a, GcdDomain a, Eq b, Num b) =>
    [(a, b)] -> Coprimes a b
    splitIntoCoprimes = (Coprimes a b -> (a, b) -> Coprimes a b)
    -> Coprimes a b -> [(a, b)] -> Coprimes a b
    forall b a. (b -> a -> b) -> b -> [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