summaryrefslogtreecommitdiff log msg author committer range
path: root/Algebra/Ring
diff options
 context: 12345678910152025303540 space: includeignore mode: unifiedssdiff
Diffstat (limited to 'Algebra/Ring')
-rw-r--r--Algebra/Ring/Ideal.hs1
-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
6 files changed, 55 insertions, 84 deletions
 diff --git a/Algebra/Ring/Ideal.hs b/Algebra/Ring/Ideal.hsindex 8fd15de..841d277 100644--- a/Algebra/Ring/Ideal.hs+++ b/Algebra/Ring/Ideal.hs@@ -50,7 +50,6 @@ principalIdeal = Ideal . singleton mapIdeal :: (r -> r') -> Ideal r -> Ideal r' mapIdeal fun (Ideal xs) = Ideal \$ S.map fun xs {-# INLINE  mapIdeal #-}-{-# RULES "mapIdeal/id" [~1] forall x. mapIdeal id x = x #-} instance NFData r => NFData (Ideal r) where rnf (Ideal is) = rnf isdiff --git a/Algebra/Ring/Polynomial/Class.hs b/Algebra/Ring/Polynomial/Class.hsindex 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.hsindex 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.hsindex 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.hsindex 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 orderdiff --git a/Algebra/Ring/Polynomial/Univariate.hs b/Algebra/Ring/Polynomial/Univariate.hsindex 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  varUnipol #-}