summaryrefslogtreecommitdiff
path: root/Algebra/Ring/Polynomial
diff options
context:
space:
mode:
Diffstat (limited to 'Algebra/Ring/Polynomial')
-rw-r--r--Algebra/Ring/Polynomial/Class.hs1
-rw-r--r--Algebra/Ring/Polynomial/Internal.hs43
-rw-r--r--Algebra/Ring/Polynomial/Labeled.hs19
-rw-r--r--Algebra/Ring/Polynomial/Monomial.hs56
-rw-r--r--Algebra/Ring/Polynomial/Univariate.hs19
5 files changed, 55 insertions, 83 deletions
diff --git a/Algebra/Ring/Polynomial/Class.hs b/Algebra/Ring/Polynomial/Class.hs
index d7e8073..576f388 100644
--- a/Algebra/Ring/Polynomial/Class.hs
+++ b/Algebra/Ring/Polynomial/Class.hs
@@ -201,7 +201,6 @@ class (CoeffRing (Coefficient poly), Eq poly, DecidableZero poly, KnownNat (Arit
{-# RULES
"liftMap/identity" liftMap (\ x -> x) = (P.id :: poly -> poly)
-"liftMap/identity-2" liftMap P.id = (P.id :: poly -> poly)
#-}
-- | Class to lookup ordering from its (type-level) name.
diff --git a/Algebra/Ring/Polynomial/Internal.hs b/Algebra/Ring/Polynomial/Internal.hs
index 87288b7..ef1025b 100644
--- a/Algebra/Ring/Polynomial/Internal.hs
+++ b/Algebra/Ring/Polynomial/Internal.hs
@@ -33,7 +33,6 @@ import AlgebraicPrelude
import Control.DeepSeq (NFData)
import Control.Lens hiding (assign)
import qualified Data.Coerce as C
-import qualified Data.Foldable as F
import qualified Data.HashSet as HS
import Data.Map (Map)
import qualified Data.Map.Strict as M
@@ -93,9 +92,6 @@ instance (KnownNat n, IsMonomialOrder n ord, CoeffRing r) => IsPolynomial (Order
extractPower = runMult . ifoldMap (\ o -> Mult . pow (mor o) . fromIntegral) . getMonomial
{-# INLINE liftMap #-}
-ordVec :: forall n. KnownNat n => Sized n (Ordinal n)
-ordVec = unsafeFromList' $ enumOrdinal (sing :: SNat n)
-
instance (KnownNat n, CoeffRing r, IsMonomialOrder n ord)
=> IsOrderedPolynomial (OrderedPolynomial r ord n) where
-- | coefficient for a degree.
@@ -170,7 +166,7 @@ instance (Eq r) => Eq (OrderedPolynomial r order n) where
-- -- | By Hilbert's finite basis theorem, a polynomial ring over a noetherian ring is also a noetherian ring.
instance (IsMonomialOrder n order, CoeffRing r, KnownNat n) => Ring (OrderedPolynomial r order n) where
fromInteger 0 = Polynomial M.empty
- fromInteger n = Polynomial $ M.singleton one (fromInteger' n)
+ fromInteger n = Polynomial $ M.singleton one (NA.fromInteger n)
{-# INLINE fromInteger #-}
decZero :: DecidableZero r => r -> Maybe r
@@ -239,41 +235,17 @@ instance (KnownNat n, CoeffRing r, IsMonomialOrder n order, PrettyCoeff r)
=> Show (OrderedPolynomial r order n) where
showsPrec = showsPolynomialWith $ generate sing (\i -> "X_" ++ show (fromEnum i))
-showPolynomialWithVars :: (CoeffRing a, Show a, KnownNat n, IsMonomialOrder n ordering)
- => [(Int, String)] -> OrderedPolynomial a ordering n -> String
-showPolynomialWithVars dic p0@(Polynomial d)
- | isZero p0 = "0"
- | otherwise = intercalate " + " $ mapMaybe showTerm $ M.toDescList d
- where
- showTerm (getMonomial -> deg, c)
- | isZero c = Nothing
- | otherwise =
- let cstr = if (not (isZero $ c - one) || isConstantMonomial deg)
- then show c ++ " "
- else if isZero (c - one) then ""
- else if isZero (c + one)
- then if any (not . isZero) (F.toList deg) then "-" else "-1"
- else ""
- in Just $ cstr ++ unwords (mapMaybe showDeg (zip [0..] $ F.toList deg))
- showDeg (n, p) | p == 0 = Nothing
- | p == 1 = Just $ showVar n
- | otherwise = Just $ showVar n ++ "^" ++ show p
- showVar n = fromMaybe ("X_" ++ show n) $ lookup n dic
-
-isConstantMonomial :: Monomial n -> Bool
-isConstantMonomial v = all (== 0) $ F.toList v
-
-- | We provide Num instance to use trivial injection R into R[X].
-- Do not use signum or abs.
instance (IsMonomialOrder n order, CoeffRing r, KnownNat n)
=> P.Num (OrderedPolynomial r order n) where
- (+) = (+)
+ (+) = (NA.+)
{-# INLINE (+) #-}
- (*) = (*)
+ (*) = (NA.*)
{-# INLINE (*) #-}
- fromInteger = normalize . injectCoeff . fromInteger'
+ fromInteger = NA.fromInteger
{-# INLINE fromInteger #-}
signum f = if isZero f then zero else injectCoeff one
@@ -506,6 +478,8 @@ instance (KnownNat n, IsMonomialOrder n ord, IsPolynomial poly,
=> RightModule (Scalar r) (PadPolyL n ord poly) where
PadPolyL f *. r = PadPolyL $ mapCoeff' (*. r) f
{-# INLINE (*.) #-}
+deriving instance (KnownNat n, IsMonomialOrder n ord, IsPolynomial poly)
+ => Num (PadPolyL n ord poly)
instance (KnownNat n, IsMonomialOrder n ord, IsPolynomial poly)
=> IsPolynomial (PadPolyL n ord poly) where
@@ -547,3 +521,8 @@ instance (SingI (Replicate n 1), KnownNat n, IsMonomialOrder n ord, IsOrderedPol
padLeftPoly :: (IsMonomialOrder n ord, IsPolynomial poly)
=> Sing n -> ord -> poly -> PadPolyL n ord poly
padLeftPoly n _ = withKnownNat n $ PadPolyL . injectCoeff
+
+instance (r ~ Coefficient poly, IsPolynomial poly,
+ KnownNat n, CoeffRing r, IsMonomialOrder n order, PrettyCoeff r)
+ => Show (PadPolyL n order poly) where
+ showsPrec = showsPolynomialWith $ generate sing (\i -> "X_" ++ show (fromEnum i))
diff --git a/Algebra/Ring/Polynomial/Labeled.hs b/Algebra/Ring/Polynomial/Labeled.hs
index 649e108..29e173e 100644
--- a/Algebra/Ring/Polynomial/Labeled.hs
+++ b/Algebra/Ring/Polynomial/Labeled.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP, ConstraintKinds, DataKinds, EmptyCase, FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances, GADTs, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE IncoherentInstances, KindSignatures, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels, PolyKinds, RankNTypes, ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving, TemplateHaskell, TypeFamilies, TypeInType #-}
@@ -29,6 +30,10 @@ import GHC.Exts (Constraint)
import GHC.OverloadedLabels (IsLabel (..))
import qualified Numeric.Algebra as NA
import qualified Prelude as P
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 802
+import qualified Data.Text as T
+#endif
+
type family UniqueList' (x :: Symbol) (xs :: [Symbol]) :: Constraint where
UniqueList' x '[] = ()
@@ -49,10 +54,17 @@ instance (KnownSymbol symb,
IsPolynomial poly,
Wraps vars poly,
Elem symb vars ~ 'True) => IsLabel symb (LabPolynomial poly vars) where
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 802
+ fromLabel =
+ let vs = map T.unpack $ fromSing (sing :: Sing vars)
+ v = symbolVal @symb Proxy
+ in maybe (error "impossible!") (var . toEnum) $ L.elemIndex v vs
+#else
fromLabel k =
let vs = fromSing (sing :: Sing vars)
v = symbolVal' k
in maybe (error "impossible!") (var . toEnum) $ L.elemIndex v vs
+#endif
data LabPolynomial poly (vars :: [Symbol]) where
LabelPolynomial :: (IsUniqueList vars, Length vars ~ Arity poly)
@@ -74,7 +86,12 @@ instance (PrettyCoeff (Coefficient poly), IsOrderedPolynomial poly, SingI vars)
=> Show (LabPolynomial poly vars) where
showsPrec d (LabelPolynomial f) =
let svs = sing :: Sing vars
- vs = fromSing svs
+ vs =
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 802
+ map T.unpack $
+#endif
+
+ fromSing svs
vsVec = generate sing $ \i -> vs !! fromEnum i
in showsPolynomialWith vsVec d f
diff --git a/Algebra/Ring/Polynomial/Monomial.hs b/Algebra/Ring/Polynomial/Monomial.hs
index d9508f8..75b69c8 100644
--- a/Algebra/Ring/Polynomial/Monomial.hs
+++ b/Algebra/Ring/Polynomial/Monomial.hs
@@ -24,29 +24,27 @@ module Algebra.Ring.Polynomial.Monomial
) where
import Algebra.Internal
-import AlgebraicPrelude hiding (lex)
-import Control.DeepSeq (NFData (..))
-import Control.Lens (Ixed (..), alaf, imap,
- makeLenses, makeWrapped, (%~),
- (&), (.~), _Wrapped)
-import Data.Constraint ((:=>) (..), Dict (..))
-import qualified Data.Constraint as C
+import AlgebraicPrelude hiding (lex)
+import Control.DeepSeq (NFData (..))
+import Control.Lens (Ixed (..), imap, makeLenses,
+ makeWrapped, (%~), (&), (.~),
+ _Wrapped)
+import Data.Constraint ((:=>) (..), Dict (..))
+import qualified Data.Constraint as C
import Data.Constraint.Forall
-import qualified Data.Foldable as F
-import Data.Hashable (Hashable (..))
-import Data.Kind (Type)
-import Data.Maybe (catMaybes)
-import Data.Monoid (Dual (..))
-import Data.Monoid ((<>))
-import qualified Data.MonoTraversable.Unprefixed as MT
-import Data.Ord (comparing)
-import Data.Singletons.Prelude (POrd (..), SList, Sing ())
-import Data.Singletons.Prelude (SingKind (..))
-import Data.Singletons.Prelude.List (Length, Replicate, sReplicate)
-import Data.Singletons.TypeLits (withKnownNat)
-import qualified Data.Sized.Builtin as V
-import Data.Type.Natural.Class (IsPeano (..), PeanoOrder (..))
-import Data.Type.Ordinal (Ordinal (..), ordToInt)
+import qualified Data.Foldable as F
+import Data.Hashable (Hashable (..))
+import Data.Kind (Type)
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.Ord (comparing)
+import Data.Singletons.Prelude (POrd (..), SList, Sing ())
+import Data.Singletons.Prelude (SingKind (..))
+import Data.Singletons.Prelude.List (Length, Replicate, sReplicate)
+import Data.Singletons.TypeLits (withKnownNat)
+import qualified Data.Sized.Builtin as V
+import Data.Type.Natural.Class (IsPeano (..), PeanoOrder (..))
+import Data.Type.Ordinal (Ordinal (..), ordToInt)
-- import Prelude hiding (Fractional (..),
-- Integral (..), Num (..),
-- Real (..), lex, product, sum)
@@ -134,20 +132,6 @@ instance KnownNat n => Unital (OrderedMonomial ord n) where
class IsOrder (n :: Nat) (ordering :: *) where
cmpMonomial :: Proxy ordering -> MonomialOrder n
-head' :: (0 :< n) ~ 'True => Sized' n a -> a
-head' = V.head
-{-# INLINE head' #-}
-
--- We know that Monomial ordering coincides on lex ordering
--- on univariate monomials.
-{-# RULES
-"cmpMonomial/unary" [~1]
- forall (pxy :: IsMonomialOrder 1 (o :: *) => Proxy o)
- (xs :: Sized' 1 Int)
- (ys :: Sized' 1 Int).
- cmpMonomial pxy xs ys = comparing head' xs ys
- #-}
-
-- * Names for orderings.
-- We didn't choose to define one single type for ordering names for the extensibility.
-- | Lexicographical order
diff --git a/Algebra/Ring/Polynomial/Univariate.hs b/Algebra/Ring/Polynomial/Univariate.hs
index e3e981a..0366a49 100644
--- a/Algebra/Ring/Polynomial/Univariate.hs
+++ b/Algebra/Ring/Polynomial/Univariate.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, ConstraintKinds, DataKinds, FlexibleContexts #-}
+{-# LANGUAGE BangPatterns, CPP, ConstraintKinds, DataKinds, FlexibleContexts #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables, StandaloneDeriving #-}
{-# LANGUAGE TypeApplications, TypeFamilies, UndecidableSuperClasses #-}
@@ -28,7 +28,7 @@ import qualified Data.Sized.Builtin as SV
import qualified Numeric.Algebra as NA
import Numeric.Decidable.Zero (DecidableZero (..))
import qualified Prelude as P
-import GHC.OverloadedLabels
+
-- | Univariate polynomial.
-- It uses @'IM.IntMap'@ as its internal representation;
-- so if you want to treat the power greater than @maxBound :: Int@,
@@ -42,10 +42,11 @@ instance Hashable r => Hashable (Unipol r) where
-- | By this instance, you can use @#x@ for
-- the unique variable of @'Unipol' r@.
instance Unital r => IsLabel "x" (Unipol r) where
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 802
+ fromLabel = Unipol $ IM.singleton 1 one
+#else
fromLabel _ = Unipol $ IM.singleton 1 one
-
-normaliseUP :: DecidableZero r => Unipol r -> Unipol r
-normaliseUP (Unipol r) = Unipol $ IM.filter (not . isZero) r
+#endif
divModUnipol :: (CoeffRing r, Field r) => Unipol r -> Unipol r -> (Unipol r, Unipol r)
divModUnipol f g =
@@ -143,9 +144,6 @@ instance CoeffRing r => P.Num (Unipol r) where
then zero
else one
-(%!!) :: Sized (n :: Nat) a -> SV.Ordinal (n :: Nat) -> a
-(%!!) = (SV.%!!)
-
{-# RULES
"var x^n" forall (x :: SV.Ordinal 1) n.
pow (varUnipol x) n = Unipol (IM.singleton (fromEnum n) one)
@@ -156,11 +154,6 @@ instance CoeffRing r => P.Num (Unipol r) where
NA.pow1p (varUnipol x) n = Unipol (IM.singleton (fromEnum n + 1) one)
#-}
-{-# RULES
-"x ^ n" forall (x :: SV.Ordinal 1) n.
- (varUnipol x) ^ n = Unipol (IM.singleton (fromEnum n) one)
- #-}
-
varUnipol :: Unital r => SV.Ordinal 1 -> Unipol r
varUnipol _ = Unipol $ IM.singleton 1 one
{-# NOINLINE CONLIKE [1] varUnipol #-}