    -- Copyright (c) David Amos, 2008. All rights reserved.

    module Math.Projects.KnotTheory.LaurentMPoly where

    import qualified Data.Map as M
    import Data.List as L

    import Math.Algebra.Field.Base

    -- It would be possible to refactor this and other code into common code for semigroup rings

    -- But there are enough small fiddly differences that it's easier not to

    -- LAURENT MONOMIALS

    newtype LaurentMonomial = LM (M.Map String Q) deriving (LaurentMonomial -> LaurentMonomial -> Bool
    (LaurentMonomial -> LaurentMonomial -> Bool)
    -> (LaurentMonomial -> LaurentMonomial -> Bool)
    -> Eq LaurentMonomial
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: LaurentMonomial -> LaurentMonomial -> Bool
    $c/= :: LaurentMonomial -> LaurentMonomial -> Bool
    == :: LaurentMonomial -> LaurentMonomial -> Bool
    $c== :: LaurentMonomial -> LaurentMonomial -> Bool
    Eq)
    -- We allow exponents to be rationals, because we want to support rings such as Z[q^1/2,q^-1/2] in connection with Hecke algebras

    -- the multidegree - not sure how meaningful this is if we have negative indices too

    degLM :: LaurentMonomial -> Q
    degLM (LM m :: Map String Q
    m) = [Q] -> Q
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Q] -> Q) -> [Q] -> Q
    forall a b. (a -> b) -> a -> b
    $ Map String Q -> [Q]
    forall k a. Map k a -> [a]
    M.elems Map String Q
    m

    -- Glex ordering

    instance Ord LaurentMonomial where
        compare :: LaurentMonomial -> LaurentMonomial -> Ordering
    compare a :: LaurentMonomial
    a b :: LaurentMonomial
    b = let ds :: [Q]
    ds = Map String Q -> [Q]
    forall k a. Map k a -> [a]
    M.elems Map String Q
    m where LM m :: Map String Q
    m = LaurentMonomial
    aLaurentMonomial -> LaurentMonomial -> LaurentMonomial
    forall a. Fractional a => a -> a -> a
    /LaurentMonomial
    b in
                      case Q -> Q -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([Q] -> Q
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Q]
    ds) 0 of
                      GT -> Ordering
    GT
                      LT -> Ordering
    LT
                      EQ -> if [Q] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Q]
    ds then Ordering
    EQ else
                            if [Q] -> Q
    forall a. [a] -> a
    head [Q]
    ds Q -> Q -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 then Ordering
    GT else Ordering
    LT

    instance Show LaurentMonomial where
        show :: LaurentMonomial -> String
    show (LM a :: Map String Q
    a) | Map String Q -> Bool
    forall k a. Map k a -> Bool
    M.null Map String Q
    a = "1"
                    | Bool
    otherwise = ((String, Q) -> String) -> [(String, Q)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (String, Q) -> String
    forall a. (Eq a, Num a, Show a) => (String, a) -> String
    showVar ([(String, Q)] -> String) -> [(String, Q)] -> String
    forall a b. (a -> b) -> a -> b
    $ Map String Q -> [(String, Q)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map String Q
    a
                    where showVar :: (String, a) -> String
    showVar (v :: String
    v,1) = String
    v
                          showVar (v :: String
    v,i :: a
    i) = String
    v String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "^" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    i

    instance Num LaurentMonomial where
        LM a :: Map String Q
    a * :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
    * LM b :: Map String Q
    b = Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ (Q -> Bool) -> Map String Q -> Map String Q
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (Q -> Q -> Bool
    forall a. Eq a => a -> a -> Bool
    /=0) (Map String Q -> Map String Q) -> Map String Q -> Map String Q
    forall a b. (a -> b) -> a -> b
    $ (Q -> Q -> Q) -> Map String Q -> Map String Q -> Map String Q
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith Q -> Q -> Q
    forall a. Num a => a -> a -> a
    (+) Map String Q
    a Map String Q
    b
        fromInteger :: Integer -> LaurentMonomial
    fromInteger 1 = Map String Q -> LaurentMonomial
    LM Map String Q
    forall k a. Map k a
    M.empty

    instance Fractional (LaurentMonomial) where
        recip :: LaurentMonomial -> LaurentMonomial
    recip (LM m :: Map String Q
    m) = Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ (Q -> Q) -> Map String Q -> Map String Q
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map Q -> Q
    forall a. Num a => a -> a
    negate Map String Q
    m

    -- untested

    -- numeratorLM (LM a) = LM $ M.filter (>0) a

    denominatorLM :: LaurentMonomial -> LaurentMonomial
    denominatorLM (LM a :: Map String Q
    a) = LaurentMonomial -> LaurentMonomial
    forall a. Fractional a => a -> a
    recip (LaurentMonomial -> LaurentMonomial)
    -> LaurentMonomial -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ (Q -> Bool) -> Map String Q -> Map String Q
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (Q -> Q -> Bool
    forall a. Ord a => a -> a -> Bool
    <0) Map String Q
    a

    -- not valid for arguments with negative exponents (because 0 won't trump -i)

    lcmLM :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
    lcmLM (LM a :: Map String Q
    a) (LM b :: Map String Q
    b) = Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ (Q -> Q -> Q) -> Map String Q -> Map String Q -> Map String Q
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith Q -> Q -> Q
    forall a. Ord a => a -> a -> a
    max Map String Q
    a Map String Q
    b

    -- not tested -- for arguments with non-zero denominators

    -- gcdLM (LM a) (LM b) = LM $ M.intersectionWith min a b

    divLM :: LaurentMonomial -> LaurentMonomial -> Maybe LaurentMonomial
    divLM a :: LaurentMonomial
    a b :: LaurentMonomial
    b = let LM c :: Map String Q
    c = LaurentMonomial
    aLaurentMonomial -> LaurentMonomial -> LaurentMonomial
    forall a. Fractional a => a -> a -> a
    /LaurentMonomial
    b in if (Q -> Bool) -> [Q] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Q -> Q -> Bool
    forall a. Ord a => a -> a -> Bool
    >=0) (Map String Q -> [Q]
    forall k a. Map k a -> [a]
    M.elems Map String Q
    c) then LaurentMonomial -> Maybe LaurentMonomial
    forall a. a -> Maybe a
    Just (Map String Q -> LaurentMonomial
    LM Map String Q
    c) else Maybe LaurentMonomial
    forall a. Maybe a
    Nothing

    -- LAURENT POLYNOMIALS

    newtype LaurentMPoly r = LP [(LaurentMonomial,r)] deriving (LaurentMPoly r -> LaurentMPoly r -> Bool
    (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> Eq (LaurentMPoly r)
    forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c/= :: forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
    == :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c== :: forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
    Eq,Eq (LaurentMPoly r)
    Eq (LaurentMPoly r) =>
    (LaurentMPoly r -> LaurentMPoly r -> Ordering)
    -> (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> (LaurentMPoly r -> LaurentMPoly r -> Bool)
    -> (LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r)
    -> (LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r)
    -> Ord (LaurentMPoly r)
    LaurentMPoly r -> LaurentMPoly r -> Bool
    LaurentMPoly r -> LaurentMPoly r -> Ordering
    LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    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
    forall r. Ord r => Eq (LaurentMPoly r)
    forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
    forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Ordering
    forall r.
    Ord r =>
    LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    min :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    $cmin :: forall r.
    Ord r =>
    LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    max :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    $cmax :: forall r.
    Ord r =>
    LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    >= :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c>= :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
    > :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c> :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
    <= :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c<= :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
    < :: LaurentMPoly r -> LaurentMPoly r -> Bool
    $c< :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
    compare :: LaurentMPoly r -> LaurentMPoly r -> Ordering
    $ccompare :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Ordering
    $cp1Ord :: forall r. Ord r => Eq (LaurentMPoly r)
    Ord)

    instance Show r => Show (LaurentMPoly r) where
        show :: LaurentMPoly r -> String
    show (LP []) = "0"
        show (LP ts :: [(LaurentMonomial, r)]
    ts) =
            let (c :: Char
    c:cs :: String
    cs) = ((LaurentMonomial, r) -> String)
    -> [(LaurentMonomial, r)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (LaurentMonomial, r) -> String
    forall a a. (Show a, Show a, Eq a, Num a) => (a, a) -> String
    showTerm ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a. [a] -> [a]
    reverse [(LaurentMonomial, r)]
    ts) -- we show Laurent polys with smallest terms first

            in if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '+' then String
    cs else Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    cs
            where showTerm :: (a, a) -> String
    showTerm (m :: a
    m,c :: a
    c) =
                      case a -> String
    forall a. Show a => a -> String
    show a
    c of
                      "1" -> "+" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    m
                      "-1" -> "-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    m
                      -- cs@(x:_) -> (if x == '-' then cs else '+':cs) ++ (if m == 1 then "" else show m)

                      cs :: String
    cs -> ShowS
    showCoeff String
    cs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (if a
    m a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then "" else a -> String
    forall a. Show a => a -> String
    show a
    m)
                  showCoeff :: ShowS
    showCoeff (c :: Char
    c:cs :: String
    cs) = if (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ['+','-']) String
    cs
                                     then "+(" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    cs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"
                                     else if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '-' then Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    cs else '+'Char -> ShowS
    forall a. a -> [a] -> [a]
    :Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    cs
                  -- we don't attempt sign reversal within brackets in case we have expressions like t^-1 inside the brackets

    instance (Eq r, Num r) => Num (LaurentMPoly r) where
        LP ts :: [(LaurentMonomial, r)]
    ts + :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    + LP us :: [(LaurentMonomial, r)]
    us = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP ([(LaurentMonomial, r)]
    -> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a b.
    (Ord a, Eq b, Num b) =>
    [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms [(LaurentMonomial, r)]
    ts [(LaurentMonomial, r)]
    us)
        negate :: LaurentMPoly r -> LaurentMPoly r
    negate (LP ts :: [(LaurentMonomial, r)]
    ts) = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP ([(LaurentMonomial, r)] -> LaurentMPoly r)
    -> [(LaurentMonomial, r)] -> LaurentMPoly r
    forall a b. (a -> b) -> a -> b
    $ ((LaurentMonomial, r) -> (LaurentMonomial, r))
    -> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(m :: LaurentMonomial
    m,c :: r
    c)->(LaurentMonomial
    m,-r
    c)) [(LaurentMonomial, r)]
    ts
        LP ts :: [(LaurentMonomial, r)]
    ts * :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    * LP us :: [(LaurentMonomial, r)]
    us = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP ([(LaurentMonomial, r)] -> LaurentMPoly r)
    -> [(LaurentMonomial, r)] -> LaurentMPoly r
    forall a b. (a -> b) -> a -> b
    $ [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a a. (Num a, Eq a, Eq a) => [(a, a)] -> [(a, a)]
    collect ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)])
    -> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a b. (a -> b) -> a -> b
    $ ((LaurentMonomial, r) -> (LaurentMonomial, r) -> Ordering)
    -> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (LaurentMonomial, r) -> (LaurentMonomial, r) -> Ordering
    forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
    cmpTerm ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)])
    -> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
    forall a b. (a -> b) -> a -> b
    $ [(LaurentMonomial
    gLaurentMonomial -> LaurentMonomial -> LaurentMonomial
    forall a. Num a => a -> a -> a
    *LaurentMonomial
    h,r
    cr -> r -> r
    forall a. Num a => a -> a -> a
    *r
    d) | (g :: LaurentMonomial
    g,c :: r
    c) <- [(LaurentMonomial, r)]
    ts, (h :: LaurentMonomial
    h,d :: r
    d) <- [(LaurentMonomial, r)]
    us]
        fromInteger :: Integer -> LaurentMPoly r
    fromInteger 0 = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP []
        fromInteger n :: Integer
    n = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(Integer -> LaurentMonomial
    forall a. Num a => Integer -> a
    fromInteger 1, Integer -> r
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)]

    cmpTerm :: (a, b) -> (a, b) -> Ordering
    cmpTerm (a :: a
    a,c :: b
    c) (b :: a
    b,d :: b
    d) = case a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a a
    b of EQ -> Ordering
    EQ; GT -> Ordering
    LT; LT -> Ordering
    GT
    -- we have to put largest terms first so that quotRem works

    -- inputs in descending order

    mergeTerms :: [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms (t :: (a, b)
    t@(g :: a
    g,c :: b
    c):ts :: [(a, b)]
    ts) (u :: (a, b)
    u@(h :: a
    h,d :: b
    d):us :: [(a, b)]
    us) =
        case (a, b) -> (a, b) -> Ordering
    forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
    cmpTerm (a, b)
    t (a, b)
    u of
        LT -> (a, b)
    t (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms [(a, b)]
    ts ((a, b)
    u(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :[(a, b)]
    us)
        GT -> (a, b)
    u (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms ((a, b)
    t(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :[(a, b)]
    ts) [(a, b)]
    us
        EQ -> if b
    e b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms [(a, b)]
    ts [(a, b)]
    us else (a
    g,b
    e) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)] -> [(a, b)] -> [(a, b)]
    mergeTerms [(a, b)]
    ts [(a, b)]
    us
        where e :: b
    e = b
    c b -> b -> b
    forall a. Num a => a -> a -> a
    + b
    d
    mergeTerms ts :: [(a, b)]
    ts us :: [(a, b)]
    us = [(a, b)]
    ts [(a, b)] -> [(a, b)] -> [(a, b)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, b)]
    us -- one of them is null

    collect :: [(a, a)] -> [(a, a)]
    collect (t1 :: (a, a)
    t1@(g :: a
    g,c :: a
    c):t2 :: (a, a)
    t2@(h :: a
    h,d :: a
    d):ts :: [(a, a)]
    ts)
        | a
    g a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    h = [(a, a)] -> [(a, a)]
    collect ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a
    g,a
    ca -> a -> a
    forall a. Num a => a -> a -> a
    +a
    d)(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    ts
        | a
    c a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0  = [(a, a)] -> [(a, a)]
    collect ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a, a)
    t2(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    ts
        | Bool
    otherwise = (a, a)
    t1 (a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    : [(a, a)] -> [(a, a)]
    collect ((a, a)
    t2(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    ts)
    collect ts :: [(a, a)]
    ts = [(a, a)]
    ts

    -- Fractional instance so that we can enter fractional coefficients

    -- Only lets us divide by single terms, not any other polynomials

    instance (Eq r, Fractional r) => Fractional (LaurentMPoly r) where
        recip :: LaurentMPoly r -> LaurentMPoly r
    recip (LP [(m :: LaurentMonomial
    m,c :: r
    c)]) = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(LaurentMonomial -> LaurentMonomial
    forall a. Fractional a => a -> a
    recip LaurentMonomial
    m, r -> r
    forall a. Fractional a => a -> a
    recip r
    c)]
        recip _ = String -> LaurentMPoly r
    forall a. HasCallStack => String -> a
    error "LaurentMPoly.recip: only supported for (non-zero) constants or monomials"

    lm :: LaurentMPoly r -> LaurentMonomial
    lm (LP ((m :: LaurentMonomial
    m,c :: r
    c):ts :: [(LaurentMonomial, r)]
    ts)) = LaurentMonomial
    m
    lc :: LaurentMPoly r -> r
    lc (LP ((m :: LaurentMonomial
    m,c :: r
    c):ts :: [(LaurentMonomial, r)]
    ts)) = r
    c
    lt :: LaurentMPoly r -> LaurentMPoly r
    lt (LP ((m :: LaurentMonomial
    m,c :: r
    c):ts :: [(LaurentMonomial, r)]
    ts)) = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(LaurentMonomial
    m,r
    c)]

    quotRemLP :: LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP f :: LaurentMPoly r
    f g :: LaurentMPoly r
    g
        | LaurentMPoly r
    g LaurentMPoly r -> LaurentMPoly r -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = String -> (LaurentMPoly r, LaurentMPoly r)
    forall a. HasCallStack => String -> a
    error "quotRemLP: division by zero"
        | LaurentMPoly r -> LaurentMPoly Integer
    forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
    denominatorLP LaurentMPoly r
    f LaurentMPoly Integer -> LaurentMPoly Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 1 Bool -> Bool -> Bool
    || LaurentMPoly r -> LaurentMPoly Integer
    forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
    denominatorLP LaurentMPoly r
    g LaurentMPoly Integer -> LaurentMPoly Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 1 = String -> (LaurentMPoly r, LaurentMPoly r)
    forall a. HasCallStack => String -> a
    error "quotRemLP: negative exponents"
        | Bool
    otherwise = LaurentMPoly r
    -> (LaurentMPoly r, LaurentMPoly r)
    -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP' LaurentMPoly r
    f (0,0)
        where
        quotRemLP' :: LaurentMPoly r
    -> (LaurentMPoly r, LaurentMPoly r)
    -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP' 0 (q :: LaurentMPoly r
    q,r :: LaurentMPoly r
    r) = (LaurentMPoly r
    q,LaurentMPoly r
    r)
        quotRemLP' h :: LaurentMPoly r
    h (q :: LaurentMPoly r
    q,r :: LaurentMPoly r
    r) =
            case LaurentMPoly r -> LaurentMonomial
    forall r. LaurentMPoly r -> LaurentMonomial
    lm LaurentMPoly r
    h LaurentMonomial -> LaurentMonomial -> Maybe LaurentMonomial
    `divLM` LaurentMPoly r -> LaurentMonomial
    forall r. LaurentMPoly r -> LaurentMonomial
    lm LaurentMPoly r
    g of
            Just m :: LaurentMonomial
    m -> let t :: LaurentMPoly r
    t = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(LaurentMonomial
    m, LaurentMPoly r -> r
    forall r. LaurentMPoly r -> r
    lc LaurentMPoly r
    h r -> r -> r
    forall a. Fractional a => a -> a -> a
    / LaurentMPoly r -> r
    forall r. LaurentMPoly r -> r
    lc LaurentMPoly r
    g)]
                      in LaurentMPoly r
    -> (LaurentMPoly r, LaurentMPoly r)
    -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP' (LaurentMPoly r
    hLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    -LaurentMPoly r
    tLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    *LaurentMPoly r
    g) (LaurentMPoly r
    qLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    +LaurentMPoly r
    t,LaurentMPoly r
    r)
            Nothing -> let lth :: LaurentMPoly r
    lth = LaurentMPoly r -> LaurentMPoly r
    forall r. LaurentMPoly r -> LaurentMPoly r
    lt LaurentMPoly r
    h -- can't reduce lt h, so add it to the remainder and try to reduce the remaining terms

                       in LaurentMPoly r
    -> (LaurentMPoly r, LaurentMPoly r)
    -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP' (LaurentMPoly r
    hLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    -LaurentMPoly r
    lth) (LaurentMPoly r
    q, LaurentMPoly r
    rLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    +LaurentMPoly r
    lth)

    -- g must be a binomial without negative exponents - eg i^2+1

    reduceLP :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    reduceLP f :: LaurentMPoly r
    f g :: LaurentMPoly r
    g@(LP [_,_]) =
        let fn :: LaurentMPoly r
    fn = LaurentMPoly r
    f LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    * LaurentMPoly r
    fd
            fd :: LaurentMPoly r
    fd = LaurentMPoly r -> LaurentMPoly r
    forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
    denominatorLP LaurentMPoly r
    f
            (_,rn :: LaurentMPoly r
    rn) = LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP LaurentMPoly r
    fn LaurentMPoly r
    g
            (_,rd :: LaurentMPoly r
    rd) = LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP LaurentMPoly r
    fd LaurentMPoly r
    g
        in LaurentMPoly r
    rn LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Fractional a => a -> a -> a
    / LaurentMPoly r
    rd

    var :: String -> LaurentMPoly r
    var v :: String
    v = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ String -> Q -> Map String Q
    forall k a. k -> a -> Map k a
    M.singleton String
    v 1, 1)]

    t :: LaurentMPoly Q
    t = String -> LaurentMPoly Q
    forall r. Num r => String -> LaurentMPoly r
    var "t" :: LaurentMPoly Q
    x :: LaurentMPoly Q
    x = String -> LaurentMPoly Q
    forall r. Num r => String -> LaurentMPoly r
    var "x" :: LaurentMPoly Q
    y :: LaurentMPoly Q
    y = String -> LaurentMPoly Q
    forall r. Num r => String -> LaurentMPoly r
    var "y" :: LaurentMPoly Q
    z :: LaurentMPoly Q
    z = String -> LaurentMPoly Q
    forall r. Num r => String -> LaurentMPoly r
    var "z" :: LaurentMPoly Q

    denominatorLP :: LaurentMPoly r -> LaurentMPoly r
    denominatorLP (LP ts :: [(LaurentMonomial, r)]
    ts) = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(LaurentMonomial
    m',1)] where
        m' :: LaurentMonomial
    m' = (LaurentMonomial -> LaurentMonomial -> LaurentMonomial)
    -> LaurentMonomial -> [LaurentMonomial] -> LaurentMonomial
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl LaurentMonomial -> LaurentMonomial -> LaurentMonomial
    lcmLM 1 [LaurentMonomial -> LaurentMonomial
    denominatorLM LaurentMonomial
    m | (m :: LaurentMonomial
    m,c :: r
    c) <- [(LaurentMonomial, r)]
    ts]

    {-
    -- not tested for terms with non-zero denominator
    gcdTermsLP (LP ts) = LP [(m',1)] where
        m' = foldl gcdLM 1 [m | (m,c) <- ts]
    -}

    -- injection of field elements into polynomial ring

    inject :: r -> LaurentMPoly r
    inject 0 = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP []
    inject c :: r
    c = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(Integer -> LaurentMonomial
    forall a. Num a => Integer -> a
    fromInteger 1, r
    c)]

    sqrtvar :: String -> LaurentMPoly r
    sqrtvar v :: String
    v = [(LaurentMonomial, r)] -> LaurentMPoly r
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ String -> Q -> Map String Q
    forall k a. k -> a -> Map k a
    M.singleton String
    v (1Q -> Q -> Q
    forall a. Fractional a => a -> a -> a
    /2), 1)]

    -- substitute terms for variables in an MPoly

    -- eg subst [(x,a),(y,a+b),(z,c^2)] (x*y+z) -> a*(a+b)+c^2

    subst :: [(LaurentMPoly r, LaurentMPoly r)]
    -> LaurentMPoly r -> LaurentMPoly r
    subst vts :: [(LaurentMPoly r, LaurentMPoly r)]
    vts (LP us :: [(LaurentMonomial, r)]
    us) = [LaurentMPoly r] -> LaurentMPoly r
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [r -> LaurentMPoly r
    forall r. (Eq r, Num r) => r -> LaurentMPoly r
    inject r
    c LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    forall a. Num a => a -> a -> a
    * LaurentMonomial -> LaurentMPoly r
    substM LaurentMonomial
    m | (m :: LaurentMonomial
    m,c :: r
    c) <- [(LaurentMonomial, r)]
    us] where
        substM :: LaurentMonomial -> LaurentMPoly r
    substM (LM m :: Map String Q
    m) = [LaurentMPoly r] -> LaurentMPoly r
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product [String -> LaurentMPoly r
    substV String
    v LaurentMPoly r -> Q -> LaurentMPoly r
    forall a.
    (Eq a, Fractional a, Show a) =>
    LaurentMPoly a -> Q -> LaurentMPoly a
    ^^^ Q
    i | (v :: String
    v,i :: Q
    i) <- Map String Q -> [(String, Q)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map String Q
    m]
        substV :: String -> LaurentMPoly r
    substV v :: String
    v =
            let v' :: LaurentMPoly r
    v' = String -> LaurentMPoly r
    forall r. Num r => String -> LaurentMPoly r
    var String
    v in
            case LaurentMPoly r
    -> [(LaurentMPoly r, LaurentMPoly r)] -> Maybe (LaurentMPoly r)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    L.lookup LaurentMPoly r
    v' [(LaurentMPoly r, LaurentMPoly r)]
    vts of
            Just t :: LaurentMPoly r
    t -> LaurentMPoly r
    t
            Nothing -> LaurentMPoly r
    v' -- no substitute, so keep as is

    f :: LaurentMPoly a
    f ^^^ :: LaurentMPoly a -> Q -> LaurentMPoly a
    ^^^ i :: Q
    i | Q -> Integer
    denominatorQ Q
    i Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 = LaurentMPoly a
    f LaurentMPoly a -> Integer -> LaurentMPoly a
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^ Q -> Integer
    numeratorQ Q
    i -- exponent is an integer

            | Bool
    otherwise = case LaurentMPoly a
    f of
                          LP [(LM m :: Map String Q
    m,1)] -> [(LaurentMonomial, a)] -> LaurentMPoly a
    forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
    LP [(Map String Q -> LaurentMonomial
    LM (Map String Q -> LaurentMonomial)
    -> Map String Q -> LaurentMonomial
    forall a b. (a -> b) -> a -> b
    $ (Q -> Q) -> Map String Q -> Map String Q
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map (Q -> Q -> Q
    forall a. Num a => a -> a -> a
    *Q
    i) Map String Q
    m ,1)]-- base is a monomial

                          otherwise :: LaurentMPoly a
    otherwise     -> String -> LaurentMPoly a
    forall a. HasCallStack => String -> a
    error ("(^^^): Cannot calculate " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ LaurentMPoly a -> String
    forall a. Show a => a -> String
    show LaurentMPoly a
    f String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " ^^^ " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Q -> String
    forall a. Show a => a -> String
    show Q
    i)
    {-
    -- halve all indices - useful when we really want to be working over k[t^1/2,t^-1/2]
    halfExponents (LP ts) =
        if any odd (concatMap (\(LM m,c) -> M.elems m) ts)
        then error ("halfExponents: " ++ show (LP ts))
        else LP $ map (\(LM m, c) -> (LM $ M.filter (/=0) $ M.map (`div` 2) m, c)) ts

    halfExponents' f@(LP ts) =
        let f'@(LP us) = LP $ map (\(LM m, c) -> (LM $ M.map (`div` 2) m, c)) ts
        in if any (==0) (concatMap (\(LM m,c) -> M.elems m) us)
           then Left f
           else Right f'

    quarterExponents' f@(LP ts) =
        let f'@(LP us) = LP $ map (\(LM m, c) -> (LM $ M.map (`div` 4) m, c)) ts
        in if any (==0) (concatMap (\(LM m,c) -> M.elems m) us)
           then Left f
           else Right f'
    -}