{-# LANGUAGE
CPP, BangPatterns, TypeFamilies, DataKinds, KindSignatures, ScopedTypeVariables,
FlexibleContexts
#-}
module Math.Algebra.Polynomial.Monomial.Infinite where
import Data.Maybe
import Data.List
import Data.Array.Unboxed
#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 Data.Foldable as F
import Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import Math.Algebra.Polynomial.Class
import Math.Algebra.Polynomial.Pretty
import Math.Algebra.Polynomial.Misc
newtype XInf (var :: Symbol) = XInf [Int] deriving (XInf var -> XInf var -> Bool
(XInf var -> XInf var -> Bool)
-> (XInf var -> XInf var -> Bool) -> Eq (XInf var)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (var :: Symbol). XInf var -> XInf var -> Bool
/= :: XInf var -> XInf var -> Bool
$c/= :: forall (var :: Symbol). XInf var -> XInf var -> Bool
== :: XInf var -> XInf var -> Bool
$c== :: forall (var :: Symbol). XInf var -> XInf var -> Bool
Eq,Int -> XInf var -> ShowS
[XInf var] -> ShowS
XInf var -> String
(Int -> XInf var -> ShowS)
-> (XInf var -> String) -> ([XInf var] -> ShowS) -> Show (XInf var)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (var :: Symbol). Int -> XInf var -> ShowS
forall (var :: Symbol). [XInf var] -> ShowS
forall (var :: Symbol). XInf var -> String
showList :: [XInf var] -> ShowS
$cshowList :: forall (var :: Symbol). [XInf var] -> ShowS
show :: XInf var -> String
$cshow :: forall (var :: Symbol). XInf var -> String
showsPrec :: Int -> XInf var -> ShowS
$cshowsPrec :: forall (var :: Symbol). Int -> XInf var -> ShowS
Show,Typeable)
unXInf :: XInf var -> [Int]
unXInf :: XInf var -> [Int]
unXInf (XInf [Int]
ns) = [Int]
ns
instance Ord (XInf var) where compare :: XInf var -> XInf var -> Ordering
compare (XInf [Int]
a) (XInf [Int]
b) = [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Int]
a [Int]
b
instance Semigroup (XInf var) where
<> :: XInf var -> XInf var -> XInf var
(<>) = XInf var -> XInf var -> XInf var
forall (var :: Symbol). XInf var -> XInf var -> XInf var
mulXInf
instance Monoid (XInf var) where
mempty :: XInf var
mempty = XInf var
forall (var :: Symbol). XInf var
emptyXInf
mappend :: XInf var -> XInf var -> XInf var
mappend = XInf var -> XInf var -> XInf var
forall (var :: Symbol). XInf var -> XInf var -> XInf var
mulXInf
instance KnownSymbol var => Pretty (XInf var) where
pretty :: XInf var -> String
pretty monom :: XInf var
monom@(XInf [Int]
es) =
case [ Integer -> Int -> String
showXPow Integer
i Int
e | (Integer
i,Int
e) <- [Integer] -> [Int] -> [(Integer, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Int]
es , Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 ] of
[] -> String
"(1)"
[String]
xs -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" [String]
xs
where
v :: String
v = XInf var -> String
forall (var :: Symbol). KnownSymbol var => XInf var -> String
xInfVar XInf var
monom
showXPow :: Integer -> Int -> String
showXPow !Integer
i !Int
e = case Int
e of
Int
0 -> String
"1"
Int
1 -> String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i
Int
_ -> String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i 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
xInfVar :: KnownSymbol var => XInf var -> String
xInfVar :: XInf var -> String
xInfVar = Proxy var -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy var -> String)
-> (XInf var -> Proxy var) -> XInf var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XInf var -> Proxy var
forall (var :: Symbol). XInf var -> Proxy var
varProxy where
varProxy :: XInf var -> Proxy var
varProxy :: XInf var -> Proxy var
varProxy XInf var
_ = Proxy var
forall k (t :: k). Proxy t
Proxy
emptyXInf :: XInf v
emptyXInf :: XInf v
emptyXInf = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf []
isEmptyXInf :: XInf v -> Bool
isEmptyXInf :: XInf v -> Bool
isEmptyXInf (XInf [Int]
arr) = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) [Int]
arr
mulXInf :: XInf v -> XInf v -> XInf v
mulXInf :: XInf v -> XInf v -> XInf v
mulXInf (XInf [Int]
es) (XInf [Int]
fs) = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf ([Int] -> XInf v) -> [Int] -> XInf v
forall a b. (a -> b) -> a -> b
$ (Int -> Int)
-> (Int -> Int) -> (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
longZipWith Int -> Int
forall a. a -> a
id Int -> Int
forall a. a -> a
id Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [Int]
es [Int]
fs
productXInf :: (Foldable f) => f (XInf v) -> XInf v
productXInf :: f (XInf v) -> XInf v
productXInf = (XInf v -> XInf v -> XInf v) -> XInf v -> f (XInf v) -> XInf v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' XInf v -> XInf v -> XInf v
forall (var :: Symbol). XInf var -> XInf var -> XInf var
mulXInf XInf v
forall (var :: Symbol). XInf var
emptyXInf
divXInf :: XInf v -> XInf v -> Maybe (XInf v)
divXInf :: XInf v -> XInf v -> Maybe (XInf v)
divXInf xs1 :: XInf v
xs1@(XInf [Int]
es) (XInf [Int]
fs)
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0) [Int]
gs = XInf v -> Maybe (XInf v)
forall a. a -> Maybe a
Just ([Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf [Int]
gs)
| Bool
otherwise = Maybe (XInf v)
forall a. Maybe a
Nothing
where
gs :: [Int]
gs = (Int -> Int)
-> (Int -> Int) -> (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
longZipWith Int -> Int
forall a. a -> a
id Int -> Int
forall a. Num a => a -> a
negate (-) [Int]
es [Int]
fs where
xInfFromList :: [(Index,Int)] -> XInf v
xInfFromList :: [(Index, Int)] -> XInf v
xInfFromList [(Index, Int)]
list =
case Map Index Int -> Maybe (Index, Int)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Index Int
table of
Maybe (Index, Int)
Nothing -> [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf []
Just (Index
n,Int
_) -> [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf [ Int -> Index -> Map Index Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 Index
i Map Index Int
table | Index
i<-[Int -> Index
Index Int
1 .. Index
n] ]
where
table :: Map Index Int
table = (Int -> Int -> Int) -> [(Index, Int)] -> Map Index Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [(Index, Int)]
list
xInfToList :: XInf v -> [(Index,Int)]
xInfToList :: XInf v -> [(Index, Int)]
xInfToList (XInf [Int]
arr)
= ((Index, Int) -> Bool) -> [(Index, Int)] -> [(Index, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Index, Int) -> Bool
forall a a. (Ord a, Num a) => (a, a) -> Bool
cond
([(Index, Int)] -> [(Index, Int)])
-> [(Index, Int)] -> [(Index, Int)]
forall a b. (a -> b) -> a -> b
$ [Index] -> [Int] -> [(Index, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ Int -> Index
Index Int
j | Int
j<-[Int
1..] ] [Int]
arr
where
cond :: (a, a) -> Bool
cond (a
_,a
e) = a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
xInfToMap :: XInf var -> Map Index Int
xInfToMap :: XInf var -> Map Index Int
xInfToMap = [(Index, Int)] -> Map Index Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Index, Int)] -> Map Index Int)
-> (XInf var -> [(Index, Int)]) -> XInf var -> Map Index Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XInf var -> [(Index, Int)]
forall (v :: Symbol). XInf v -> [(Index, Int)]
xInfToList
normalizeXInf :: XInf v -> XInf v
normalizeXInf :: XInf v -> XInf v
normalizeXInf (XInf [Int]
arr) = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf ([Int] -> XInf v) -> [Int] -> XInf v
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
arr
isNormalXInf :: XInf v -> Bool
isNormalXInf :: XInf v -> Bool
isNormalXInf (XInf [Int]
arr) = [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
arr)
variableXInf :: Index -> XInf v
variableXInf :: Index -> XInf v
variableXInf Index
idx = Index -> Int -> XInf v
forall (v :: Symbol). Index -> Int -> XInf v
singletonXInf Index
idx Int
1
singletonXInf :: Index -> Int -> XInf v
singletonXInf :: Index -> Int -> XInf v
singletonXInf (Index Int
j) Int
e
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> XInf v
forall a. HasCallStack => String -> a
error String
"singletonXInf: index out of bounds (smaller than 1)"
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> XInf v
forall a. HasCallStack => String -> a
error String
"singletonXInf: negative exponent"
| Bool
otherwise = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf ([Int] -> XInf v) -> [Int] -> XInf v
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
e]
powXInf :: XInf v -> Int -> XInf v
powXInf :: XInf v -> Int -> XInf v
powXInf (XInf [Int]
arr) Int
e
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> XInf v
forall a. HasCallStack => String -> a
error String
"powXInf: negative exponent"
| Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf []
| Bool
otherwise = [Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
e) [Int]
arr)
maxDegXInf :: XInf v -> Int
maxDegXInf :: XInf v -> Int
maxDegXInf (XInf [Int]
arr) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
arr
totalDegXInf :: XInf v -> Int
totalDegXInf :: XInf v -> Int
totalDegXInf (XInf [Int]
arr) = [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
arr
evalXInf :: Num c => (Index -> c) -> XInf v -> c
evalXInf :: (Index -> c) -> XInf v -> c
evalXInf Index -> c
f XInf v
xinf = (c -> c -> c) -> c -> [c] -> c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' c -> c -> c
forall a. Num a => a -> a -> a
(*) c
1 (((Index, Int) -> c) -> [(Index, Int)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (Index, Int) -> c
g ([(Index, Int)] -> [c]) -> [(Index, Int)] -> [c]
forall a b. (a -> b) -> a -> b
$ XInf v -> [(Index, Int)]
forall (v :: Symbol). XInf v -> [(Index, Int)]
xInfToList XInf v
xinf) where
g :: (Index, Int) -> c
g (!Index
j,!Int
e) = case Int
e of
Int
0 -> c
1
Int
1 -> Index -> c
f Index
j
Int
_ -> (Index -> c
f Index
j) c -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
varSubsXInf :: (Index -> Index) -> XInf v -> XInf v
varSubsXInf :: (Index -> Index) -> XInf v -> XInf v
varSubsXInf Index -> Index
f XInf v
xinf = XInf v
new where
table :: Map Index Int
table = XInf v -> Map Index Int
forall (var :: Symbol). XInf var -> Map Index Int
xInfToMap XInf v
xinf
new :: XInf v
new = [(Index, Int)] -> XInf v
forall (v :: Symbol). [(Index, Int)] -> XInf v
xInfFromList [ (Index -> Index
f Index
v , Int
e) | (Index
v,Int
e) <- Map Index Int -> [(Index, Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Index Int
table ]
termSubsXInf :: (Num c) => (Index -> Maybe c) -> (XInf v, c) -> (XInf v, c)
termSubsXInf :: (Index -> Maybe c) -> (XInf v, c) -> (XInf v, c)
termSubsXInf Index -> Maybe c
f (XInf v
xinf, c
c0) = ([(Index, Int)] -> XInf v
forall (v :: Symbol). [(Index, Int)] -> XInf v
xInfFromList [(Index, Int)]
list, c
c1) where
([(Index, Int)]
list,c
c1) = (([(Index, Int)], c) -> (Index, Int) -> ([(Index, Int)], c))
-> ([(Index, Int)], c) -> [(Index, Int)] -> ([(Index, Int)], c)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([(Index, Int)], c) -> (Index, Int) -> ([(Index, Int)], c)
g ([],c
c0) (XInf v -> [(Index, Int)]
forall (v :: Symbol). XInf v -> [(Index, Int)]
xInfToList XInf v
xinf)
g :: ([(Index, Int)], c) -> (Index, Int) -> ([(Index, Int)], c)
g ([(Index, Int)]
old,c
c) (Index
v,Int
e) = case Index -> Maybe c
f Index
v of
Just c
d -> ([(Index, Int)]
old , c
c c -> c -> c
forall a. Num a => a -> a -> a
* c
dc -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e)
Maybe c
Nothing -> ((Index
v,Int
e)(Index, Int) -> [(Index, Int)] -> [(Index, Int)]
forall a. a -> [a] -> [a]
:[(Index, Int)]
old , c
c)
diffXInf :: Num c => Index -> Int -> XInf v -> Maybe (XInf v, c)
diffXInf :: Index -> Int -> XInf v -> Maybe (XInf v, c)
diffXInf Index
_ Int
0 XInf v
xinf = (XInf v, c) -> Maybe (XInf v, c)
forall a. a -> Maybe a
Just (XInf v
xinf,c
1)
diffXInf (Index Int
j) Int
k (XInf [Int]
es) =
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m
then Maybe (XInf v, c)
forall a. Maybe a
Nothing
else (XInf v, c) -> Maybe (XInf v, c)
forall a. a -> Maybe a
Just ([Int] -> XInf v
forall (var :: Symbol). [Int] -> XInf var
XInf [Int]
es' , Integer -> c
forall a. Num a => Integer -> a
fromInteger Integer
c)
where
m :: Int
m = ([Int]
es [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0) [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
es' :: [Int]
es' = Int -> Int -> Int -> [Int] -> [Int]
forall a. a -> Int -> a -> [a] -> [a]
longReplaceListElem Int
0 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [Int]
es
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
instance (KnownSymbol v) => Monomial (XInf v) where
type VarM (XInf v) = Index
normalizeM :: XInf v -> XInf v
normalizeM = XInf v -> XInf v
forall (v :: Symbol). XInf v -> XInf v
normalizeXInf
isNormalM :: XInf v -> Bool
isNormalM = XInf v -> Bool
forall (v :: Symbol). XInf v -> Bool
isNormalXInf
fromListM :: [(VarM (XInf v), Int)] -> XInf v
fromListM = [(VarM (XInf v), Int)] -> XInf v
forall (v :: Symbol). [(Index, Int)] -> XInf v
xInfFromList
toListM :: XInf v -> [(VarM (XInf v), Int)]
toListM = XInf v -> [(VarM (XInf v), Int)]
forall (v :: Symbol). XInf v -> [(Index, Int)]
xInfToList
emptyM :: XInf v
emptyM = XInf v
forall (var :: Symbol). XInf var
emptyXInf
isEmptyM :: XInf v -> Bool
isEmptyM = XInf v -> Bool
forall (v :: Symbol). XInf v -> Bool
isEmptyXInf
variableM :: VarM (XInf v) -> XInf v
variableM = VarM (XInf v) -> XInf v
forall (v :: Symbol). Index -> XInf v
variableXInf
singletonM :: VarM (XInf v) -> Int -> XInf v
singletonM = VarM (XInf v) -> Int -> XInf v
forall (v :: Symbol). Index -> Int -> XInf v
singletonXInf
mulM :: XInf v -> XInf v -> XInf v
mulM = XInf v -> XInf v -> XInf v
forall (var :: Symbol). XInf var -> XInf var -> XInf var
mulXInf
divM :: XInf v -> XInf v -> Maybe (XInf v)
divM = XInf v -> XInf v -> Maybe (XInf v)
forall (v :: Symbol). XInf v -> XInf v -> Maybe (XInf v)
divXInf
productM :: [XInf v] -> XInf v
productM = [XInf v] -> XInf v
forall (f :: * -> *) (v :: Symbol).
Foldable f =>
f (XInf v) -> XInf v
productXInf
powM :: XInf v -> Int -> XInf v
powM = XInf v -> Int -> XInf v
forall (v :: Symbol). XInf v -> Int -> XInf v
powXInf
diffM :: VarM (XInf v) -> Int -> XInf v -> Maybe (XInf v, c)
diffM = VarM (XInf v) -> Int -> XInf v -> Maybe (XInf v, c)
forall c (v :: Symbol).
Num c =>
Index -> Int -> XInf v -> Maybe (XInf v, c)
diffXInf
maxDegM :: XInf v -> Int
maxDegM = XInf v -> Int
forall (v :: Symbol). XInf v -> Int
maxDegXInf
totalDegM :: XInf v -> Int
totalDegM = XInf v -> Int
forall (v :: Symbol). XInf v -> Int
totalDegXInf
evalM :: (VarM (XInf v) -> c) -> XInf v -> c
evalM = (VarM (XInf v) -> c) -> XInf v -> c
forall c (v :: Symbol). Num c => (Index -> c) -> XInf v -> c
evalXInf
varSubsM :: (VarM (XInf v) -> VarM (XInf v)) -> XInf v -> XInf v
varSubsM = (VarM (XInf v) -> VarM (XInf v)) -> XInf v -> XInf v
forall (v :: Symbol). (Index -> Index) -> XInf v -> XInf v
varSubsXInf
termSubsM :: (VarM (XInf v) -> Maybe c) -> (XInf v, c) -> (XInf v, c)
termSubsM = (VarM (XInf v) -> Maybe c) -> (XInf v, c) -> (XInf v, c)
forall c (v :: Symbol).
Num c =>
(Index -> Maybe c) -> (XInf v, c) -> (XInf v, c)
termSubsXInf