-- | Univariate \"monomials\" (basically the natural numbers)

{-# 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

--------------------------------------------------------------------------------
-- * Univariate monomials

-- | A monomial in a univariate polynomial, indexed by its name, eg @U "x"@
newtype U (var :: Symbol) = U Int deriving (U var -> U var -> Bool
(U var -> U var -> Bool) -> (U var -> U var -> Bool) -> Eq (U var)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (var :: Symbol). U var -> U var -> Bool
/= :: U var -> U var -> Bool
$c/= :: forall (var :: Symbol). U var -> U var -> Bool
== :: U var -> U var -> Bool
$c== :: forall (var :: Symbol). U var -> U var -> Bool
Eq,Eq (U var)
Eq (U var)
-> (U var -> U var -> Ordering)
-> (U var -> U var -> Bool)
-> (U var -> U var -> Bool)
-> (U var -> U var -> Bool)
-> (U var -> U var -> Bool)
-> (U var -> U var -> U var)
-> (U var -> U var -> U var)
-> Ord (U var)
U var -> U var -> Bool
U var -> U var -> Ordering
U var -> U var -> U var
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (var :: Symbol). Eq (U var)
forall (var :: Symbol). U var -> U var -> Bool
forall (var :: Symbol). U var -> U var -> Ordering
forall (var :: Symbol). U var -> U var -> U var
min :: U var -> U var -> U var
$cmin :: forall (var :: Symbol). U var -> U var -> U var
max :: U var -> U var -> U var
$cmax :: forall (var :: Symbol). U var -> U var -> U var
>= :: U var -> U var -> Bool
$c>= :: forall (var :: Symbol). U var -> U var -> Bool
> :: U var -> U var -> Bool
$c> :: forall (var :: Symbol). U var -> U var -> Bool
<= :: U var -> U var -> Bool
$c<= :: forall (var :: Symbol). U var -> U var -> Bool
< :: U var -> U var -> Bool
$c< :: forall (var :: Symbol). U var -> U var -> Bool
compare :: U var -> U var -> Ordering
$ccompare :: forall (var :: Symbol). U var -> U var -> Ordering
$cp1Ord :: forall (var :: Symbol). Eq (U var)
Ord,Int -> U var -> ShowS
[U var] -> ShowS
U var -> String
(Int -> U var -> ShowS)
-> (U var -> String) -> ([U var] -> ShowS) -> Show (U var)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (var :: Symbol). Int -> U var -> ShowS
forall (var :: Symbol). [U var] -> ShowS
forall (var :: Symbol). U var -> String
showList :: [U var] -> ShowS
$cshowList :: forall (var :: Symbol). [U var] -> ShowS
show :: U var -> String
$cshow :: forall (var :: Symbol). U var -> String
showsPrec :: Int -> U var -> ShowS
$cshowsPrec :: forall (var :: Symbol). Int -> U var -> ShowS
Show,Typeable)

-- | Name of the variable
uVar :: KnownSymbol var => U var -> String
uVar :: U var -> String
uVar = Proxy var -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy var -> String) -> (U var -> Proxy var) -> U var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U var -> Proxy var
forall (var :: Symbol). U var -> Proxy var
uproxy where
  uproxy :: U var -> Proxy var
  uproxy :: U var -> Proxy var
uproxy U var
_ = Proxy var
forall k (t :: k). Proxy t
Proxy

instance KnownSymbol var => Pretty (U var) where
  pretty :: U var -> String
pretty u :: U var
u@(U Int
e) = case Int
e of
    Int
0 -> String
"1"
    Int
1 -> U var -> String
forall (var :: Symbol). KnownSymbol var => U var -> String
uVar U var
u
    Int
_ -> U var -> String
forall (var :: Symbol). KnownSymbol var => U var -> String
uVar U var
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
e

--------------------------------------------------------------------------------

#if MIN_VERSION_base(4,11,0)        

instance Semigroup (U var) where
  <> :: U var -> U var -> U var
(<>) (U Int
e) (U Int
f) = Int -> U var
forall (var :: Symbol). Int -> U var
U (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f)

instance Monoid (U var) where
  mempty :: U var
mempty = Int -> U var
forall (var :: Symbol). Int -> U var
U Int
0
  mappend :: U var -> U var -> U var
mappend (U Int
e) (U Int
f) = Int -> U var
forall (var :: Symbol). Int -> U var
U (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f)
  mconcat :: [U var] -> U var
mconcat [U var]
us = Int -> U var
forall (var :: Symbol). Int -> U var
U (Int -> U var) -> Int -> U var
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
sum' [ Int
e | U Int
e <- [U var]
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
  -- | the type of variables
  type VarM (U var) = ()
  
  -- checking the invariant
  normalizeM :: U var -> U var
normalizeM  = U var -> U var
forall a. a -> a
id
  isNormalM :: U var -> Bool
isNormalM   = Bool -> U var -> Bool
forall a b. a -> b -> a
const Bool
True

  -- construction and deconstruction
  fromListM :: [(VarM (U var), Int)] -> U var
fromListM   [(VarM (U var), Int)]
ves = Int -> U var
forall (var :: Symbol). Int -> U var
U (Int -> U var) -> Int -> U var
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
sum' ((((), Int) -> Int) -> [((), Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((), Int) -> Int
forall a b. (a, b) -> b
snd [((), Int)]
[(VarM (U var), Int)]
ves)
  toListM :: U var -> [(VarM (U var), Int)]
toListM     (U Int
e) = [((),Int
e)]

  -- simple monomials
  emptyM :: U var
emptyM      = Int -> U var
forall (var :: Symbol). Int -> U var
U Int
0
  isEmptyM :: U var -> Bool
isEmptyM    (U Int
e) = (Int
eInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)
  variableM :: VarM (U var) -> U var
variableM   VarM (U var)
_   = Int -> U var
forall (var :: Symbol). Int -> U var
U Int
1
  singletonM :: VarM (U var) -> Int -> U var
singletonM  VarM (U var)
_ Int
e = Int -> U var
forall (var :: Symbol). Int -> U var
U Int
e

  -- algebra
  mulM :: U var -> U var -> U var
mulM         = U var -> U var -> U var
forall a. Monoid a => a -> a -> a
mappend
  productM :: [U var] -> U var
productM     = [U var] -> U var
forall a. Monoid a => [a] -> a
mconcat
  divM :: U var -> U var -> Maybe (U var)
divM (U Int
e) (U Int
f) = if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
f then U var -> Maybe (U var)
forall a. a -> Maybe a
Just (Int -> U var
forall (var :: Symbol). Int -> U var
U (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
f)) else Maybe (U var)
forall a. Maybe a
Nothing
  powM :: U var -> Int -> U var
powM (U Int
e) Int
k = Int -> U var
forall (var :: Symbol). Int -> U var
U (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
e)

  -- degrees
  maxDegM :: U var -> Int
maxDegM     (U Int
e) = Int
e
  totalDegM :: U var -> Int
totalDegM   (U Int
e) = Int
e

  -- calculus
  diffM :: VarM (U var) -> Int -> U var -> Maybe (U var, c)
diffM VarM (U var)
_ = Int -> U var -> Maybe (U var, c)
forall c (v :: Symbol). Num c => Int -> U v -> Maybe (U v, c)
diffU

  -- substitution and evaluation
  evalM :: (VarM (U var) -> c) -> U var -> c
evalM       VarM (U var) -> c
f (U Int
e) = (VarM (U var) -> c
f ())c -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e
  varSubsM :: (VarM (U var) -> VarM (U var)) -> U var -> U var
varSubsM    VarM (U var) -> VarM (U var)
_ = U var -> U var
forall a. a -> a
id
  termSubsM :: (VarM (U var) -> Maybe c) -> (U var, c) -> (U var, c)
termSubsM   VarM (U var) -> Maybe c
f (U Int
e, c
c) = case VarM (U var) -> Maybe c
f () of  
                Maybe c
Nothing  -> (Int -> U var
forall (var :: Symbol). Int -> U var
U Int
e, c
c      )
                (Just c
x) -> (Int -> U var
forall (var :: Symbol). Int -> U var
U Int
0, c
c c -> c -> c
forall a. Num a => a -> a -> a
* c
xc -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e)

--------------------------------------------------------------------------------
-- * differentiation

diffU :: Num c => Int -> U v -> Maybe (U v, c)
diffU :: Int -> U v -> Maybe (U v, c)
diffU Int
k (U Int
m) =
  if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m 
    then Maybe (U v, c)
forall a. Maybe a
Nothing
    else (U v, c) -> Maybe (U v, c)
forall a. a -> Maybe a
Just (Int -> U v
forall (var :: Symbol). Int -> U var
U (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) , Integer -> c
forall a. Num a => Integer -> a
fromInteger Integer
c) 
  where
    c :: Integer
c = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
i<-[Int
0..Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ] :: Integer

--------------------------------------------------------------------------------