{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
module Math.Algebras.LaurentPoly where
import Math.Algebra.Field.Base hiding (powers)
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
import Math.Algebras.Structures
import qualified Data.List as L
import Math.Algebras.Commutative
data LaurentMonomial = LM Int [(String,Int)] deriving (LaurentMonomial -> LaurentMonomial -> Bool
(LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> Eq LaurentMonomial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaurentMonomial -> LaurentMonomial -> Bool
$c/= :: LaurentMonomial -> LaurentMonomial -> Bool
== :: LaurentMonomial -> LaurentMonomial -> Bool
$c== :: LaurentMonomial -> LaurentMonomial -> Bool
Eq,Eq LaurentMonomial
Eq LaurentMonomial =>
(LaurentMonomial -> LaurentMonomial -> Ordering)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> LaurentMonomial)
-> (LaurentMonomial -> LaurentMonomial -> LaurentMonomial)
-> Ord LaurentMonomial
LaurentMonomial -> LaurentMonomial -> Bool
LaurentMonomial -> LaurentMonomial -> Ordering
LaurentMonomial -> LaurentMonomial -> LaurentMonomial
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
min :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
$cmin :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
max :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
$cmax :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
>= :: LaurentMonomial -> LaurentMonomial -> Bool
$c>= :: LaurentMonomial -> LaurentMonomial -> Bool
> :: LaurentMonomial -> LaurentMonomial -> Bool
$c> :: LaurentMonomial -> LaurentMonomial -> Bool
<= :: LaurentMonomial -> LaurentMonomial -> Bool
$c<= :: LaurentMonomial -> LaurentMonomial -> Bool
< :: LaurentMonomial -> LaurentMonomial -> Bool
$c< :: LaurentMonomial -> LaurentMonomial -> Bool
compare :: LaurentMonomial -> LaurentMonomial -> Ordering
$ccompare :: LaurentMonomial -> LaurentMonomial -> Ordering
$cp1Ord :: Eq LaurentMonomial
Ord)
instance Show LaurentMonomial where
show :: LaurentMonomial -> String
show (LM 0 []) = "1"
show (LM _ xis :: [(String, Int)]
xis) = ((String, Int) -> String) -> [(String, Int)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: String
x,i :: Int
i) -> if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==1 then String
x else String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) [(String, Int)]
xis
instance Mon LaurentMonomial where
munit :: LaurentMonomial
munit = Int -> [(String, Int)] -> LaurentMonomial
LM 0 []
mmult :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
mmult (LM si :: Int
si xis :: [(String, Int)]
xis) (LM sj :: Int
sj yjs :: [(String, Int)]
yjs) = Int -> [(String, Int)] -> LaurentMonomial
LM (Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sj) ([(String, Int)] -> LaurentMonomial)
-> [(String, Int)] -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a b.
(Ord a, Num b, Eq b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(String, Int)]
xis [(String, Int)]
yjs
instance (Eq k, Num k) => Algebra k LaurentMonomial where
unit :: k -> Vect k LaurentMonomial
unit 0 = Vect k LaurentMonomial
forall k b. Vect k b
zerov
unit x :: k
x = [(LaurentMonomial, k)] -> Vect k LaurentMonomial
forall k b. [(b, k)] -> Vect k b
V [(LaurentMonomial
forall m. Mon m => m
munit,k
x)]
mult :: Vect k (Tensor LaurentMonomial LaurentMonomial)
-> Vect k LaurentMonomial
mult (V ts :: [(Tensor LaurentMonomial LaurentMonomial, k)]
ts) = Vect k LaurentMonomial -> Vect k LaurentMonomial
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k LaurentMonomial -> Vect k LaurentMonomial)
-> Vect k LaurentMonomial -> Vect k LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Tensor LaurentMonomial LaurentMonomial -> LaurentMonomial)
-> Vect k (Tensor LaurentMonomial LaurentMonomial)
-> Vect k LaurentMonomial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: LaurentMonomial
a,b :: LaurentMonomial
b) -> LaurentMonomial
a LaurentMonomial -> LaurentMonomial -> LaurentMonomial
forall m. Mon m => m -> m -> m
`mmult` LaurentMonomial
b) ([(Tensor LaurentMonomial LaurentMonomial, k)]
-> Vect k (Tensor LaurentMonomial LaurentMonomial)
forall k b. [(b, k)] -> Vect k b
V [(Tensor LaurentMonomial LaurentMonomial, k)]
ts)
type LaurentPoly k = Vect k LaurentMonomial
lvar :: String -> LaurentPoly Q
lvar v :: String
v = [(LaurentMonomial, Q)] -> LaurentPoly Q
forall k b. [(b, k)] -> Vect k b
V [(Int -> [(String, Int)] -> LaurentMonomial
LM 1 [(String
v,1)], 1)] :: LaurentPoly Q
instance (Eq k, Fractional k) => Fractional (LaurentPoly k) where
recip :: LaurentPoly k -> LaurentPoly k
recip (V [(LM si :: Int
si xis :: [(String, Int)]
xis,c :: k
c)]) = [(LaurentMonomial, k)] -> LaurentPoly k
forall k b. [(b, k)] -> Vect k b
V [(Int -> [(String, Int)] -> LaurentMonomial
LM (-Int
si) ([(String, Int)] -> LaurentMonomial)
-> [(String, Int)] -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> (String, Int))
-> [(String, Int)] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: String
x,i :: Int
i)->(String
x,-Int
i)) [(String, Int)]
xis, k -> k
forall a. Fractional a => a -> a
recip k
c)]
recip _ = String -> LaurentPoly k
forall a. HasCallStack => String -> a
error "LaurentPoly.recip: only defined for single terms"
q :: LaurentPoly Q
q = String -> LaurentPoly Q
lvar "q"
q' :: LaurentPoly Q
q' = 1LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
forall a. Fractional a => a -> a -> a
/LaurentPoly Q
q