summaryrefslogtreecommitdiff
path: root/Algebra
diff options
context:
space:
mode:
Diffstat (limited to 'Algebra')
-rw-r--r--Algebra/Algorithms/Groebner.hs2
-rw-r--r--Algebra/Field/AlgebraicReal.hs19
-rw-r--r--Algebra/Field/Galois/Internal.hs4
-rw-r--r--Algebra/Internal.hs6
-rw-r--r--Algebra/LinkedMatrix.hs39
-rw-r--r--Algebra/Prelude/Core.hs2
-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
-rw-r--r--Algebra/Scalar.hs2
13 files changed, 67 insertions, 146 deletions
diff --git a/Algebra/Algorithms/Groebner.hs b/Algebra/Algorithms/Groebner.hs
index 8222f9f..f8287c6 100644
--- a/Algebra/Algorithms/Groebner.hs
+++ b/Algebra/Algorithms/Groebner.hs
@@ -18,7 +18,7 @@ module Algebra.Algorithms.Groebner
, NormalStrategy(..), SugarStrategy(..), GradedStrategy(..)
-- * Ideal operations
, isIdealMember, intersection, thEliminationIdeal, thEliminationIdealWith
- , unsafeThEliminationIdealWith
+ , unsafeThEliminationIdealWith, eliminatePadding
, quotIdeal, quotByPrincipalIdeal
, saturationIdeal, saturationByPrincipalIdeal
-- * Resultant
diff --git a/Algebra/Field/AlgebraicReal.hs b/Algebra/Field/AlgebraicReal.hs
index bda7c1c..940bc46 100644
--- a/Algebra/Field/AlgebraicReal.hs
+++ b/Algebra/Field/AlgebraicReal.hs
@@ -150,6 +150,8 @@ instance RightModule (Fraction Integer) Algebraic where
instance Multiplicative Algebraic where
(*) = multA
{-# INLINE (*) #-}
+ pow1p a = powA a . succ
+ {-# INLINE pow1p #-}
instance LeftModule (Scalar (Fraction Integer)) Algebraic where
(.*) = multA . Rational . runScalar
@@ -308,10 +310,6 @@ sqFreePart f = f `quot` gcd f (diff 0 f)
minusA (plusA x y) x = y
"plusminus/left" [~1] forall x (y :: Algebraic) .
plusA x (minusA y x) = y
-"plus-zero-left" [~1] forall x.
- plusA 0 x = x
-"plus-zero-right" [~1] forall x.
- plusA x 0 = x
#-}
plusA :: Algebraic -> Algebraic -> Algebraic
@@ -368,11 +366,6 @@ catcher _ _ _ _ = error "rational is impossible"
normalize :: (Eq r, Euclidean r, Division r) => Unipol r -> Unipol r
normalize = monoize . sqFreePart
-shiftP :: (Domain r, Division r, Eq r, Euclidean r)
- => Unipol r -> Unipol r
-shiftP f | isZero (coeff one f) = f `quot` var 0
- | otherwise = f
-
stabilize :: Algebraic -> Algebraic
stabilize r@Rational{} = r
stabilize ar@(Algebraic f ss int)
@@ -525,10 +518,6 @@ multA a b =
int = catcher multInt fg (stabilize a) (stabilize b)
in fromJust $ algebraic fg int
-defEqn :: Algebraic -> Unipol Rational
-defEqn (Rational a) = var 0 - injectCoeff a
-defEqn a@Algebraic{} = eqn a
-
improveNonzero :: Algebraic -> Interval Rational
improveNonzero (Algebraic _ ss int0) = go int0
where
@@ -637,10 +626,6 @@ powA r n | n < 0 = nthRoot' (abs $ fromIntegral n) r
| otherwise = r ^ P.fromIntegral n
{-# INLINE powA #-}
-iterateImprove :: Rational -> Unipol Rational -> Interval Rational -> Interval Rational
-iterateImprove eps f =
- iterateImproveStrum eps (strum f)
-
iterateImproveStrum :: Rational -> [Unipol Rational] -> Interval Rational -> Interval Rational
iterateImproveStrum eps ss int0 =
until (\int -> size int < eps) (improveWith ss) int0
diff --git a/Algebra/Field/Galois/Internal.hs b/Algebra/Field/Galois/Internal.hs
index 4389300..d64ef0c 100644
--- a/Algebra/Field/Galois/Internal.hs
+++ b/Algebra/Field/Galois/Internal.hs
@@ -6,13 +6,13 @@ module Algebra.Field.Galois.Internal
(ConwayPolynomial(..),
Conway,
buildInstance,
- parseLine) where
+ parseLine
+ ) where
import Algebra.Field.Finite
import Algebra.Prelude.Core hiding (lex, lift)
import Algebra.Ring.Polynomial.Univariate (Unipol)
import Data.Char (isDigit)
import Data.Char (digitToInt)
-import qualified Data.Map as M
import Data.Reflection
import qualified GHC.TypeLits as TL
import Language.Haskell.TH
diff --git a/Algebra/Internal.hs b/Algebra/Internal.hs
index 0464e74..2f1a358 100644
--- a/Algebra/Internal.hs
+++ b/Algebra/Internal.hs
@@ -3,7 +3,7 @@
{-# LANGUAGE MultiParamTypeClasses, PatternSynonyms, PolyKinds, RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+{-# OPTIONS_GHC -Wincomplete-patterns -Wno-orphans #-}
module Algebra.Internal
( (:~:)(..), withRefl,
module Data.Proxy,
@@ -41,6 +41,7 @@ import Data.Type.Equality ((:~:) (..))
import Data.Type.Natural.Class as Algebra.Internal
import qualified Data.Type.Ordinal as O
import qualified Data.Vector as DV
+import Data.ListLike (ListLike)
import GHC.TypeLits as Algebra.Internal
import Proof.Equational (coerce, withRefl)
import Proof.Equational as Algebra.Internal (because,
@@ -64,7 +65,8 @@ coerceLength eql = _Unwrapping Flipped.Flipped %~ coerce eql
type SNat (n :: Nat) = Sing n
-sizedLength f = (S.sLength f)
+sizedLength :: ListLike (f a) a => S.Sized f n a -> Sing n
+sizedLength f = S.sLength f
padVecs :: forall a n m. a -> Sized' n a -> Sized' m a
-> (SNat (Max n m), Sized' (Max n m) a, Sized' (Max n m) a)
diff --git a/Algebra/LinkedMatrix.hs b/Algebra/LinkedMatrix.hs
index 3e0161a..ac87ff4 100644
--- a/Algebra/LinkedMatrix.hs
+++ b/Algebra/LinkedMatrix.hs
@@ -19,7 +19,7 @@ module Algebra.LinkedMatrix (Matrix, toLists, fromLists, fromList,
scaleCol, clearRow, clearCol, index, (!),
nonZeroEntries, rankLM, splitIndependentDirs,
structuredGauss, multWithVector, solveWiedemann,
- henselLift, solveHensel, structuredGauss') where
+ henselLift, solveHensel, structuredGauss', intDet) where
import Algebra.Algorithms.ChineseRemainder
import Algebra.Field.Finite
import Algebra.Instances ()
@@ -587,31 +587,6 @@ structuredGauss' = evalState go . newGaussianState
nonZeroEntries :: Matrix a -> Vector ((Int, Int), a)
nonZeroEntries mat = V.map (view idx &&& view value) $ mat ^. coefficients
-matListView :: (Show a, Monoidal a) => Matrix a -> String
-matListView = unlines . map (('\t':).show) . toLists
-
-prettyMat :: Show a => Matrix a -> String
-prettyMat mat =
- unlines [ "row start: " <> starter Row
- , "col start: " <> starter Column
- , "[" <> (intercalate ", " $ V.toList $ V.imap (\i e -> "(#" <> show i <> ") " <> prettyEntry e) $ mat^.coefficients) <> "]"
- ]
- where
- starter dir = intercalate ", " (map (\(a,b) -> show a ++ " -> " ++ show b) (mat^.startL dir.to IM.toList))
-
-prettyEntry :: Show a => Entry a -> String
-prettyEntry ent =
- concat [ show $ ent^.value, " "
- , show $ ent^.idx
- , "->("
- ,showMaybe (ent^.nextL Row)
- , ", "
- ,showMaybe (ent^.nextL Column)
- , ")"
- ]
- where
- showMaybe = maybe "_" show
-
multWithVector :: (Multiplicative a, Monoidal a)
=> Matrix a -> Vector a -> Vector a
multWithVector mat v =
@@ -627,6 +602,7 @@ nonZeroRows = nonZeroDirs Row
nonZeroCols :: Matrix r -> [Int]
nonZeroCols = nonZeroDirs Column
+{-
testCase :: Matrix (Fraction Integer)
testCase = fromLists [[0,0,0,0,0,0,2,-3,-1,0]
,[0,0,0,2,-3,-1,0,0,0,0]
@@ -635,6 +611,7 @@ testCase = fromLists [[0,0,0,0,0,0,2,-3,-1,0]
,[2,-3,0,-1,0,0,0,0,0,0]
,[1,0,1,0,0,1,0,0,0,-1]
,[1,0,1,0,0,1,-2,0,0,0]]
+-}
newtype Square n r = Square { runSquare :: Matrix r
} deriving (Show, Eq, Additive, Multiplicative)
@@ -839,16 +816,6 @@ triangulateModular mat0 =
((l,m):mn) | i == l -> build (m : ans) (i-1) mn vecs
_ -> build (V.empty : ans) (i-1) mns vecs
-(.!) :: (a -> b) -> (t -> a) -> t -> b
-(f .! g) x = f $! g x
-
-infixr 9 .!
-
-clearDenom :: Euclidean a => Matrix (Fraction a) -> (a, Matrix a)
-clearDenom mat =
- let g = V.foldr' (lcm' . denominator . snd) one $ nonZeroEntries mat
- in (g, cmap (numerator . (* (g % one))) mat)
-
lcm' :: Euclidean r => r -> r -> r
lcm' n m = n * m `quot` gcd n m
diff --git a/Algebra/Prelude/Core.hs b/Algebra/Prelude/Core.hs
index 458d555..1887685 100644
--- a/Algebra/Prelude/Core.hs
+++ b/Algebra/Prelude/Core.hs
@@ -23,8 +23,6 @@ import Data.Type.Ordinal.Builtin (Ordinal, enumOrdinal, od)
n % m = injectCoeff (n / m)
infixl 7 %
-type Rational = Fraction Integer
-
logBase2 :: Int -> Int
logBase2 x = finiteBitSize x - 1 - countLeadingZeros x
{-# INLINE logBase2 #-}
diff --git a/Algebra/Ring/Ideal.hs b/Algebra/Ring/Ideal.hs
index 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 [1] mapIdeal #-}
-{-# RULES "mapIdeal/id" [~1] forall x. mapIdeal id x = x #-}
instance NFData r => NFData (Ideal r) where
rnf (Ideal is) = rnf is
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 #-}
diff --git a/Algebra/Scalar.hs b/Algebra/Scalar.hs
index 4e81e4a..74175ca 100644
--- a/Algebra/Scalar.hs
+++ b/Algebra/Scalar.hs
@@ -3,9 +3,7 @@
{-# LANGUAGE StandaloneDeriving #-}
module Algebra.Scalar (Scalar(..), (.*.)) where
import AlgebraicPrelude
-import qualified Data.Coerce as C
import Algebra.Normed
-import Control.Lens
import qualified Prelude as P
-- | @'Scalar' r@ provides almost the same type-instances as @r@,