module Factory.Data.Polynomial(
Polynomial,
zero,
one,
evaluate,
getDegree,
getLeadingTerm,
lift,
mod',
normalise,
raiseModulo,
realCoefficientsToFrac,
terms,
mkConstant,
mkLinear,
mkPolynomial,
(*=),
areCongruentModulo,
inAscendingOrder,
inDescendingOrder,
isMonic,
isMonomial,
isNormalised,
isPolynomial,
isZero
) where
import Control.Arrow((&&&))
import qualified Control.Arrow
import qualified Data.List
import Factory.Data.Monomial((<*>), (</>), (<=>), (=~))
import qualified Factory.Data.Monomial as Data.Monomial
import qualified Factory.Data.QuotientRing as Data.QuotientRing
import Factory.Data.Ring((=*=), (=+=), (=-=))
import qualified Factory.Data.Ring as Data.Ring
#if MIN_VERSION_base(4,8,0)
import Prelude hiding ((<*>))
#endif
infixl 7 *=
type MonomialList coefficient exponent = [Data.Monomial.Monomial coefficient exponent]
newtype Polynomial coefficient exponent = MkPolynomial {
getMonomialList :: MonomialList coefficient exponent
} deriving (Eq, Show)
instance (
Eq c,
Num c,
Num e,
Ord e
) => Data.Ring.Ring (Polynomial c e) where
MkPolynomial [] =*= _ = zero
_ =*= MkPolynomial [] = zero
polynomialL =*= polynomialR
| terms polynomialL > terms polynomialR = polynomialL `times` polynomialR
| otherwise = polynomialR `times` polynomialL
where
l `times` r = Data.Ring.sum' (recip 2) 10 . map (l *=) $ getMonomialList r
MkPolynomial [] =+= p = p
p =+= MkPolynomial [] = p
MkPolynomial listL =+= MkPolynomial listR = MkPolynomial $ merge listL listR where
merge [] r = r
merge l [] = l
merge l@(lh : ls) r@(rh : rs) = case lh <=> rh of
GT -> lh : merge ls r
LT -> rh : merge l rs
_ -> case lh `Data.Monomial.shiftCoefficient` Data.Monomial.getCoefficient rh of
(0, _) -> merge ls rs
monomial -> monomial : merge ls rs
additiveInverse = lift (Data.Monomial.negateCoefficient `map`)
multiplicativeIdentity = one
additiveIdentity = zero
square (MkPolynomial []) = zero
square p = Data.Ring.sum' (recip 2) 10 $ diagonal : corners where
diagonal = map Data.Monomial.square `lift` p
corners = uncurry (
zipWith (*=)
) $ map MkPolynomial . init . Data.List.tails . tail &&& map Data.Monomial.double $ getMonomialList p
instance (
Eq c,
Fractional c,
Num e,
Ord e
) => Data.QuotientRing.QuotientRing (Polynomial c e) where
_ `quotRem'` MkPolynomial [] = error "Factory.Data.Polynomial.quotRem':\tzero denominator."
polynomialN `quotRem'` polynomialD = longDivide polynomialN where
longDivide (MkPolynomial []) = (zero, zero)
longDivide numerator
| Data.Monomial.getExponent quotient < 0 = (zero, numerator)
| otherwise = Control.Arrow.first (lift (quotient :)) $ longDivide (numerator =-= polynomialD *= quotient )
where
quotient = getLeadingTerm numerator </> getLeadingTerm polynomialD
lift :: (MonomialList c1 e1 -> MonomialList c2 e2) -> Polynomial c1 e1 -> Polynomial c2 e2
lift transform = MkPolynomial . transform . getMonomialList
terms :: Polynomial c e -> Int
terms (MkPolynomial l) = length l
getLeadingTerm :: Polynomial c e -> Data.Monomial.Monomial c e
getLeadingTerm (MkPolynomial []) = error "Factory.Data.Polynomial.getLeadingTerm:\tzero polynomial has no leading term."
getLeadingTerm (MkPolynomial (m : _)) = m
pruneCoefficients :: (Eq c, Num c) => Polynomial c e -> Polynomial c e
pruneCoefficients (MkPolynomial []) = zero
pruneCoefficients p = filter ((/= 0) . Data.Monomial.getCoefficient) `lift` p
normalise :: (Eq c, Num c, Ord e) => Polynomial c e -> Polynomial c e
normalise = pruneCoefficients . lift (
map (
foldr ((+) . Data.Monomial.getCoefficient) 0 &&& Data.Monomial.getExponent . head
) . Data.List.groupBy (=~) . Data.List.sortBy (flip (<=>))
)
mkConstant :: (Eq c, Num c, Num e) => c -> Polynomial c e
mkConstant 0 = zero
mkConstant c = MkPolynomial [(c, 0)]
mkLinear :: (Eq c, Num c, Num e)
=> c
-> c
-> Polynomial c e
mkLinear m c = pruneCoefficients $ MkPolynomial [(m, 1), (c, 0)]
mkPolynomial :: (Eq c, Num c, Ord e) => MonomialList c e -> Polynomial c e
mkPolynomial [] = zero
mkPolynomial l = normalise $ MkPolynomial l
zero :: Polynomial c e
zero = MkPolynomial []
one :: (Eq c, Num c, Num e) => Polynomial c e
one = mkConstant 1
inOrder :: (e -> e -> Bool) -> Polynomial c e -> Bool
inOrder comparator p
| any ($ p) [isZero, isMonomial] = True
| otherwise = and . uncurry (zipWith comparator) . (init &&& tail) . map Data.Monomial.getExponent $ getMonomialList p
inAscendingOrder :: Ord e => Polynomial c e -> Bool
inAscendingOrder = inOrder (<=)
inDescendingOrder :: Ord e => Polynomial c e -> Bool
inDescendingOrder = inOrder (>=)
isReduced :: (Eq c, Num c) => Polynomial c e -> Bool
isReduced = all ((/= 0) . Data.Monomial.getCoefficient) . getMonomialList
isNormalised :: (Eq c, Num c, Ord e) => Polynomial c e -> Bool
isNormalised polynomial = all ($ polynomial) [isReduced, inDescendingOrder]
isMonic :: (Eq c, Num c) => Polynomial c e -> Bool
isMonic (MkPolynomial []) = False
isMonic p = (== 1) . Data.Monomial.getCoefficient $ getLeadingTerm p
isZero :: Polynomial c e -> Bool
isZero (MkPolynomial []) = True
isZero _ = False
isMonomial :: Polynomial c e -> Bool
isMonomial (MkPolynomial []) = True
isMonomial _ = False
isPolynomial :: Integral e => Polynomial c e -> Bool
isPolynomial = all Data.Monomial.isMonomial . getMonomialList
areCongruentModulo :: (Integral c, Num e, Ord e)
=> Polynomial c e
-> Polynomial c e
-> c
-> Bool
areCongruentModulo _ _ 0 = error "Factory.Data.Polynomial.areCongruentModulo:\tzero modulus."
areCongruentModulo _ _ 1 = True
areCongruentModulo l r modulus
| l == r = True
| otherwise = all ((== 0) . (`mod` modulus) . Data.Monomial.getCoefficient) . getMonomialList $ l =-= r
getDegree :: Num e => Polynomial c e -> e
getDegree (MkPolynomial []) = 1
getDegree p = Data.Monomial.getExponent $ getLeadingTerm p
(*=) :: (Eq c, Num c, Num e) => Polynomial c e -> Data.Monomial.Monomial c e -> Polynomial c e
polynomial *= monomial
| Data.Monomial.getCoefficient monomial == 1 = map (`Data.Monomial.shiftExponent` Data.Monomial.getExponent monomial) `lift` polynomial
| otherwise = map (monomial <*>) `lift` polynomial
raiseModulo :: (Integral c, Integral power, Num e, Ord e, Show power)
=> Polynomial c e
-> power
-> c
-> Polynomial c e
raiseModulo _ _ 0 = error "Factory.Data.Polynomial.raiseModulo:\tzero modulus."
raiseModulo _ _ 1 = zero
raiseModulo _ 0 modulus = mkConstant $ 1 `mod` modulus
raiseModulo polynomial power modulus
| power < 0 = error $ "Factory.Data.Polynomial.raiseModulo:\tthe result isn't guaranteed to be a polynomial, for power=" ++ show power
| first `elem` [zero, one] = first
| otherwise = slave power
where
first = polynomial `mod'` modulus
slave 1 = first
slave n = (`mod'` modulus) . (if r == 0 then id else (polynomial =*=)) . Data.Ring.square $ slave q where
(q, r) = n `quotRem` 2
mod' :: Integral c
=> Polynomial c e
-> c
-> Polynomial c e
mod' p modulus = pruneCoefficients $ map (`Data.Monomial.mod'` modulus) `lift` p
evaluate :: (Num n, Integral e, Show e)
=> n
-> Polynomial n e
-> n
evaluate x = foldr ((+) . raise) 0 . getMonomialList where
powers = iterate (* x) 1
raise monomial
| exponent' < 0 = error $ "Factory.Data.Polynomial.evaluate.raise:\tnegative exponent; " ++ show exponent'
| otherwise = Data.Monomial.getCoefficient monomial * Data.List.genericIndex powers exponent'
where
exponent' = Data.Monomial.getExponent monomial
realCoefficientsToFrac :: (Real r, Fractional f) => Polynomial r e -> Polynomial f e
realCoefficientsToFrac = lift (Data.Monomial.realCoefficientToFrac `map`)