{-# LANGUAGE BangPatterns, DataKinds, KindSignatures, TypeFamilies #-}
module Math.Algebra.Polynomial.Monomial.Univariate where
import Data.Array ( assocs )
import Data.List
#if MIN_VERSION_base(4,11,0)
import Data.Semigroup
import Data.Monoid
#else
import Data.Monoid
#endif
import Data.Typeable
import GHC.TypeLits
import Data.Proxy
import Math.Algebra.Polynomial.Class
import Math.Algebra.Polynomial.Pretty
import Math.Algebra.Polynomial.Misc
newtype U (var :: Symbol) = U Int deriving (Eq,Ord,Show,Typeable)
uVar :: KnownSymbol var => U var -> String
uVar = symbolVal . uproxy where
uproxy :: U var -> Proxy var
uproxy _ = Proxy
instance KnownSymbol var => Pretty (U var) where
pretty u@(U e) = case e of
0 -> "1"
1 -> uVar u
_ -> uVar u ++ "^" ++ show e
#if MIN_VERSION_base(4,11,0)
instance Semigroup (U var) where
(<>) (U e) (U f) = U (e+f)
instance Monoid (U var) where
mempty = U 0
mappend (U e) (U f) = U (e+f)
mconcat us = U $ sum' [ e | U e <- us ]
#else
instance Monoid (U var) where
mempty = U 0
mappend (U e) (U f) = U (e+f)
mconcat us = U $ sum' [ e | U e <- us ]
#endif
instance KnownSymbol var => Monomial (U var) where
type VarM (U var) = ()
normalizeM = id
isNormalM = const True
fromListM ves = U $ sum' (map snd ves)
toListM (U e) = [((),e)]
emptyM = U 0
isEmptyM (U e) = (e==0)
variableM _ = U 1
singletonM _ e = U e
mulM = mappend
productM = mconcat
divM (U e) (U f) = if e >= f then Just (U (e-f)) else Nothing
powM (U e) k = U (k*e)
maxDegM (U e) = e
totalDegM (U e) = e
diffM _ = diffU
evalM f (U e) = (f ())^e
varSubsM _ = id
termSubsM f (U e, c) = case f () of
Nothing -> (U e, c )
(Just x) -> (U 0, c * x^e)
diffU :: Num c => Int -> U v -> Maybe (U v, c)
diffU k (U m) =
if k > m
then Nothing
else Just (U (m-k) , fromInteger c)
where
c = product [ fromIntegral (m-i) | i<-[0..k-1] ] :: Integer