module Numeric.Polynomial.Basis.Power
(
(:^)(Power, logPower)
, (^:)
, W(..), X(..), Y(..), Z(..)
, x
, at
, delta
, coef
) where
import Control.Applicative
import Data.Foldable
import Data.Function (on)
import Data.Proxy
import Data.Reflection
import Data.Functor.Representable.Trie
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Traversable
import Numeric.Addition
import Numeric.Algebra.Free
import Numeric.Multiplication
import Numeric.Decidable.Zero
import Numeric.Decidable.Units
import Numeric.Semiring.Class
import Numeric.Rig.Class
import Numeric.Functional.Linear
import Numeric.Natural.Internal
import Prelude hiding ((^),(+),(),(*),negate, replicate,subtract)
infixr 8 :^,^:
newtype x:^n = Power { logPower :: n } deriving (Eq,Ord)
(^:) :: x -> n -> x :^ n
_ ^: n = Power n
data W = W deriving Show; instance Reifies W W where reflect _ = W
data X = X deriving Show; instance Reifies X X where reflect _ = X
data Y = Y deriving Show; instance Reifies Y Y where reflect _ = Y
data Z = Z deriving Show; instance Reifies Z Z where reflect _ = Z
instance (Show t, Reifies x t, Show n) => Show (x:^n) where
showsPrec d p = showParen (d > 8) $
showsPrec 9 (reflect (proxyX p)) . showString "^:" . showsPrec 8 (logPower p) where
proxyX :: x:^n -> Proxy x
proxyX _ = Proxy
instance Functor ((:^) x) where
fmap f (Power n) = Power (f n)
instance Foldable ((:^) x) where
foldMap f (Power n) = f n
instance Traversable ((:^) x) where
traverse f (Power n) = Power <$> f n
instance Foldable1 ((:^) x) where
foldMap1 f (Power n) = f n
instance Traversable1 ((:^) x) where
traverse1 f (Power n) = Power <$> f n
instance HasTrie n => HasTrie (x :^ n) where
type BaseTrie (x :^ n) = BaseTrie n
embedKey = embedKey . logPower
projectKey = Power . projectKey
instance Additive n => Multiplicative (x :^ n) where
Power n * Power m = Power (n + m)
pow1p (Power n) m = Power (replicate1p m n)
instance AdditiveMonoid n => Unital (x :^ n) where
one = Power zero
pow (Power n) m = Power (replicate m n)
instance AdditiveGroup n => MultiplicativeGroup (x :^ n) where
Power n / Power m = Power (n m)
recip (Power n) = Power (negate n)
Power n \\ Power m = Power (subtract n m)
Power n ^ m = Power (times m n)
instance DecidableZero n => DecidableUnits (x :^ n) where
recipUnit (Power n) | isZero n = Just (Power n)
| otherwise = Nothing
instance Partitionable n => Factorable (x :^ n) where
factorWith f = partitionWith (f `on` Power) . logPower
instance (Semiring r, Additive n) => FreeCoalgebra r (x :^ n) where
cojoin f i j = f $ i * j
instance (Semiring r, AdditiveMonoid n) => FreeCounitalCoalgebra r (x :^ n) where
counit f = f one
instance (Semiring r, Partitionable n) => FreeAlgebra r (x :^ n) where
join f = sum1 . partitionWith (f `on` Power) . logPower
instance (Semiring r, AdditiveMonoid r, Unital r, DecidableZero n, Partitionable n) => FreeUnitalAlgebra r (x :^ n) where
unit r (Power n) | isZero n = r
| otherwise = zero
x :: Unital n => Linear r (x:^n)
x = Linear $ \k -> k $ Power one
at :: (Unital r, Whole n) => Linear r (x:^n) -> r -> r
m `at` r = m $* pow r . logPower
delta :: (Rig r, Eq a) => a -> a -> r
delta i j | i == j = one
| otherwise = zero
coef :: (Rig r, Eq n) => n -> Linear r (x:^n) -> r
coef n m = m $* delta (Power n)