{-# LANGUAGE
CPP, BangPatterns, TypeFamilies, DataKinds, KindSignatures, ScopedTypeVariables,
FlexibleContexts
#-}
module Math.Algebra.Polynomial.Monomial.Indexed 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 Math.Algebra.Polynomial.Class
import Math.Algebra.Polynomial.Pretty
import Math.Algebra.Polynomial.Misc
newtype XS (var :: Symbol) (n :: Nat) = XS (UArray Int Int) deriving (XS var n -> XS var n -> Bool
(XS var n -> XS var n -> Bool)
-> (XS var n -> XS var n -> Bool) -> Eq (XS var n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (var :: Symbol) (n :: Nat). XS var n -> XS var n -> Bool
/= :: XS var n -> XS var n -> Bool
$c/= :: forall (var :: Symbol) (n :: Nat). XS var n -> XS var n -> Bool
== :: XS var n -> XS var n -> Bool
$c== :: forall (var :: Symbol) (n :: Nat). XS var n -> XS var n -> Bool
Eq,Int -> XS var n -> ShowS
[XS var n] -> ShowS
XS var n -> String
(Int -> XS var n -> ShowS)
-> (XS var n -> String) -> ([XS var n] -> ShowS) -> Show (XS var n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (var :: Symbol) (n :: Nat). Int -> XS var n -> ShowS
forall (var :: Symbol) (n :: Nat). [XS var n] -> ShowS
forall (var :: Symbol) (n :: Nat). XS var n -> String
showList :: [XS var n] -> ShowS
$cshowList :: forall (var :: Symbol) (n :: Nat). [XS var n] -> ShowS
show :: XS var n -> String
$cshow :: forall (var :: Symbol) (n :: Nat). XS var n -> String
showsPrec :: Int -> XS var n -> ShowS
$cshowsPrec :: forall (var :: Symbol) (n :: Nat). Int -> XS var n -> ShowS
Show,Typeable)
instance Ord (XS var n) where compare :: XS var n -> XS var n -> Ordering
compare (XS UArray Int Int
a) (XS UArray Int Int
b) = UArray Int Int -> UArray Int Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare UArray Int Int
a UArray Int Int
b
instance KnownNat n => Semigroup (XS var n) where
<> :: XS var n -> XS var n -> XS var n
(<>) = XS var n -> XS var n -> XS var n
forall (n :: Nat) (var :: Symbol).
KnownNat n =>
XS var n -> XS var n -> XS var n
mulXS
instance KnownNat n => Monoid (XS var n) where
mempty :: XS var n
mempty = XS var n
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n
emptyXS
mappend :: XS var n -> XS var n -> XS var n
mappend = XS var n -> XS var n -> XS var n
forall (n :: Nat) (var :: Symbol).
KnownNat n =>
XS var n -> XS var n -> XS var n
mulXS
instance KnownSymbol var => Pretty (XS var n) where
pretty :: XS var n -> String
pretty monom :: XS var n
monom@(XS UArray Int Int
arr) =
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
es :: [Int]
es = UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr
v :: String
v = XS var n -> String
forall (var :: Symbol) (n :: Nat).
KnownSymbol var =>
XS var n -> String
xsVar XS var n
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
xsVar :: KnownSymbol var => XS var n -> String
xsVar :: XS var n -> String
xsVar = Proxy var -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy var -> String)
-> (XS var n -> Proxy var) -> XS var n -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XS var n -> Proxy var
forall (var :: Symbol) (n :: Nat). XS var n -> Proxy var
varProxy where
varProxy :: XS var n -> Proxy var
varProxy :: XS var n -> Proxy var
varProxy XS var n
_ = Proxy var
forall k (t :: k). Proxy t
Proxy
nOfXS :: KnownNat n => XS var n -> Int
nOfXS :: XS var n -> Int
nOfXS = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (XS var n -> Integer) -> XS var n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer)
-> (XS var n -> Proxy n) -> XS var n -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XS var n -> Proxy n
forall (var :: Symbol) (n :: Nat). XS var n -> Proxy n
natProxy where
natProxy :: XS var n -> Proxy n
natProxy :: XS var n -> Proxy n
natProxy XS var n
_ = Proxy n
forall k (t :: k). Proxy t
Proxy
emptyXS :: KnownNat n => XS v n
emptyXS :: XS v n
emptyXS = XS v n
forall (var :: Symbol). XS var n
xs where
xs :: XS var n
xs = UArray Int Int -> XS var n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS var n) -> UArray Int Int -> XS var n
forall a b. (a -> b) -> a -> b
$ (Int -> Any -> Int)
-> Int -> (Int, Int) -> [(Int, Any)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray Int -> Any -> Int
forall a b. a -> b -> a
const Int
0 (Int
1,Int
n) []
n :: Int
n = XS var n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS var n
xs
isEmptyXS :: XS v n -> Bool
isEmptyXS :: XS v n -> Bool
isEmptyXS (XS UArray Int 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) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr)
isNormalXS :: KnownNat n => XS v n -> Bool
isNormalXS :: XS v n -> Bool
isNormalXS xs :: XS v n
xs@(XS UArray Int Int
arr) = UArray Int Int -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Int
arr (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1,Int
n) where n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
xsFromList :: KnownNat n => [(Index,Int)] -> XS v n
xsFromList :: [(Index, Int)] -> XS v n
xsFromList [(Index, Int)]
list = XS v n
xs where
xs :: XS v n
xs = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v n) -> UArray Int Int -> XS v n
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int
1,Int
n) [(Int, Int)]
list'
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
list' :: [(Int, Int)]
list' = ((Index, Int) -> (Int, Int)) -> [(Index, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Index, Int) -> (Int, Int)
f [(Index, Int)]
list
f :: (Index, Int) -> (Int, Int)
f (Index Int
j , Int
e)
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"xsFromList: index out of bounds (too small)"
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"xsFromList: index out of bounds (too big)"
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"xsFromList: negative exponent"
| Bool
otherwise = (Int
j,Int
e)
xsToList :: XS v n -> [(Index,Int)]
xsToList :: XS v n -> [(Index, Int)]
xsToList (XS UArray Int Int
arr) = [ (Int -> Index
Index Int
j, Int
e) | (Int
j,Int
e) <- UArray Int Int -> [(Int, Int)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs UArray Int Int
arr , Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
xsFromExponents :: KnownNat n => [Int] -> XS v n
xsFromExponents :: [Int] -> XS v n
xsFromExponents [Int]
expos = XS v n
xs where
xs :: XS v n
xs = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v n) -> UArray Int Int -> XS v n
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
n) [Int]
list
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
list :: [Int]
list = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int]
expos [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
xsToExponents :: KnownNat n => XS v n -> [Int]
xsToExponents :: XS v n -> [Int]
xsToExponents (XS UArray Int Int
arr) = UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr
variableXS :: KnownNat n => Index -> XS v n
variableXS :: Index -> XS v n
variableXS Index
idx = Index -> Int -> XS v n
forall (n :: Nat) (v :: Symbol).
KnownNat n =>
Index -> Int -> XS v n
singletonXS Index
idx Int
1
singletonXS :: KnownNat n => Index -> Int -> XS v n
singletonXS :: Index -> Int -> XS v n
singletonXS (Index Int
j) Int
e
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> XS v n
forall a. HasCallStack => String -> a
error String
"singletonXS: index out of bounds (too small)"
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = String -> XS v n
forall a. HasCallStack => String -> a
error String
"singletonXS: index out of bounds (too big)"
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> XS v n
forall a. HasCallStack => String -> a
error String
"singletonXS: negative exponent"
| Bool
otherwise = XS v n
xs
where
xs :: XS v n
xs = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v n) -> UArray Int Int -> XS v n
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int
1,Int
n) [(Int
j,Int
e)]
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
mulXS :: KnownNat n => XS v n -> XS v n -> XS v n
mulXS :: XS v n -> XS v n -> XS v n
mulXS xs1 :: XS v n
xs1@(XS UArray Int Int
es) (XS UArray Int Int
fs) = XS v n
ys where
ys :: XS v n
ys = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v n) -> UArray Int Int -> XS v n
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
n) ([Int] -> UArray Int Int) -> [Int] -> UArray Int Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
es) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
fs) where
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs1
productXS :: (KnownNat n, Foldable f) => f (XS v n) -> XS v n
productXS :: f (XS v n) -> XS v n
productXS = (XS v n -> XS v n -> XS v n) -> XS v n -> f (XS v n) -> XS v n
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' XS v n -> XS v n -> XS v n
forall (n :: Nat) (var :: Symbol).
KnownNat n =>
XS var n -> XS var n -> XS var n
mulXS XS v n
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n
emptyXS
powXS :: XS v n -> Int -> XS v n
powXS :: XS v n -> Int -> XS v n
powXS (XS UArray Int Int
arr) Int
e
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> XS v n
forall a. HasCallStack => String -> a
error String
"powXS: negative exponent"
| Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS ((Int -> Int) -> UArray Int Int -> UArray Int Int
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0) UArray Int Int
arr)
| Bool
otherwise = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS ((Int -> Int) -> UArray Int Int -> UArray Int Int
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
e) UArray Int Int
arr)
divXS :: KnownNat n => XS v n -> XS v n -> Maybe (XS v n)
divXS :: XS v n -> XS v n -> Maybe (XS v n)
divXS xs1 :: XS v n
xs1@(XS UArray Int Int
es) (XS UArray Int 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 = XS v n -> Maybe (XS v n)
forall a. a -> Maybe a
Just (UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v n) -> UArray Int Int -> XS v n
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
n) [Int]
gs)
| Bool
otherwise = Maybe (XS v n)
forall a. Maybe a
Nothing
where
gs :: [Int]
gs = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
es) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
fs) where
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs1
maxDegXS :: XS v n -> Int
maxDegXS :: XS v n -> Int
maxDegXS (XS UArray Int Int
arr) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr)
totalDegXS :: XS v n -> Int
totalDegXS :: XS v n -> Int
totalDegXS (XS UArray Int Int
arr) = [Int] -> Int
forall a. Num a => [a] -> a
sum' (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr)
evalXS :: Num c => (Index -> c) -> XS v n -> c
evalXS :: (Index -> c) -> XS v n -> c
evalXS Index -> c
f xs :: XS v n
xs@(XS UArray Int Int
arr) = (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 (((Int, Int) -> c) -> [(Int, Int)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> c
g ([(Int, Int)] -> [c]) -> [(Int, Int)] -> [c]
forall a b. (a -> b) -> a -> b
$ UArray Int Int -> [(Int, Int)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs UArray Int Int
arr) where
g :: (Int, Int) -> c
g (!Int
j,!Int
e) = case Int
e of
Int
0 -> c
1
Int
1 -> Index -> c
f (Int -> Index
Index Int
j)
Int
_ -> Index -> c
f (Int -> Index
Index Int
j) c -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
varSubsXS :: KnownNat n => (Index -> Index) -> XS v n -> XS v n
varSubsXS :: (Index -> Index) -> XS v n -> XS v n
varSubsXS Index -> Index
f xs :: XS v n
xs@(XS UArray Int Int
arr) = UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS UArray Int Int
arr' where
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
arr' :: UArray Int Int
arr' = (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int
1,Int
n) [(Int, Int)]
list
list :: [(Int, Int)]
list = [ ( Index -> Int
myFromIndex (Index -> Index
f (Int -> Index
Index Int
j)) , Int
e ) | (Int
j,Int
e) <- UArray Int Int -> [(Int, Int)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs UArray Int Int
arr ]
myFromIndex :: Index -> Int
myFromIndex (Index Int
j)
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Int
j
| Bool
otherwise = String -> Int
forall a. HasCallStack => String -> a
error String
"varSubsXS: variable index out of bounds"
termSubsXS :: (KnownNat n, Num c) => (Index -> Maybe c) -> (XS v n, c) -> (XS v n, c)
termSubsXS :: (Index -> Maybe c) -> (XS v n, c) -> (XS v n, c)
termSubsXS Index -> Maybe c
f (xs :: XS v n
xs@(XS UArray Int Int
arr) , c
c0) = (UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS UArray Int Int
arr', c
c0c -> c -> c
forall a. Num a => a -> a -> a
*c
proj) where
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
xs
arr' :: UArray Int Int
arr' = (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int
1,Int
n) ([(Int, Int)] -> UArray Int Int) -> [(Int, Int)] -> UArray Int Int
forall a b. (a -> b) -> a -> b
$ [Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Int)]
mbs
(c
proj,[Maybe (Int, Int)]
mbs) = (c -> (Int, Int) -> (c, Maybe (Int, Int)))
-> c -> [(Int, Int)] -> (c, [Maybe (Int, Int)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL c -> (Int, Int) -> (c, Maybe (Int, Int))
g c
1 (UArray Int Int -> [(Int, Int)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs UArray Int Int
arr)
g :: c -> (Int, Int) -> (c, Maybe (Int, Int))
g !c
s (!Int
j,!Int
e) = case Index -> Maybe c
f (Int -> Index
Index Int
j) of
Maybe c
Nothing -> (c
s , (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
j,Int
e) )
Just c
c -> (c
s c -> c -> c
forall a. Num a => a -> a -> a
* c
cc -> Int -> c
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e , Maybe (Int, Int)
forall a. Maybe a
Nothing )
diffXS :: Num c => Index -> Int -> XS v n -> Maybe (XS v n, c)
diffXS :: Index -> Int -> XS v n -> Maybe (XS v n, c)
diffXS Index
_ Int
0 XS v n
xs = (XS v n, c) -> Maybe (XS v n, c)
forall a. a -> Maybe a
Just (XS v n
xs,c
1)
diffXS (Index Int
j) Int
k xs :: XS v n
xs@(XS UArray Int Int
arr) =
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m
then Maybe (XS v n, c)
forall a. Maybe a
Nothing
else (XS v n, c) -> Maybe (XS v n, c)
forall a. a -> Maybe a
Just (UArray Int Int -> XS v n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS UArray Int Int
arr' , Integer -> c
forall a. Num a => Integer -> a
fromInteger Integer
c)
where
m :: Int
m = UArray Int Int
arrUArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
j
arr' :: UArray Int Int
arr' = UArray Int Int
arr UArray Int Int -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(Int
j,Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)]
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 (KnownNat n, KnownSymbol v) => Monomial (XS v n) where
type VarM (XS v n) = Index
normalizeM :: XS v n -> XS v n
normalizeM = XS v n -> XS v n
forall a. a -> a
id
isNormalM :: XS v n -> Bool
isNormalM = XS v n -> Bool
forall (n :: Nat) (v :: Symbol). KnownNat n => XS v n -> Bool
isNormalXS
fromListM :: [(VarM (XS v n), Int)] -> XS v n
fromListM = [(VarM (XS v n), Int)] -> XS v n
forall (n :: Nat) (v :: Symbol).
KnownNat n =>
[(Index, Int)] -> XS v n
xsFromList
toListM :: XS v n -> [(VarM (XS v n), Int)]
toListM = XS v n -> [(VarM (XS v n), Int)]
forall (v :: Symbol) (n :: Nat). XS v n -> [(Index, Int)]
xsToList
emptyM :: XS v n
emptyM = XS v n
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n
emptyXS
isEmptyM :: XS v n -> Bool
isEmptyM = XS v n -> Bool
forall (v :: Symbol) (n :: Nat). XS v n -> Bool
isEmptyXS
variableM :: VarM (XS v n) -> XS v n
variableM = VarM (XS v n) -> XS v n
forall (n :: Nat) (v :: Symbol). KnownNat n => Index -> XS v n
variableXS
singletonM :: VarM (XS v n) -> Int -> XS v n
singletonM = VarM (XS v n) -> Int -> XS v n
forall (n :: Nat) (v :: Symbol).
KnownNat n =>
Index -> Int -> XS v n
singletonXS
mulM :: XS v n -> XS v n -> XS v n
mulM = XS v n -> XS v n -> XS v n
forall (n :: Nat) (var :: Symbol).
KnownNat n =>
XS var n -> XS var n -> XS var n
mulXS
divM :: XS v n -> XS v n -> Maybe (XS v n)
divM = XS v n -> XS v n -> Maybe (XS v n)
forall (n :: Nat) (v :: Symbol).
KnownNat n =>
XS v n -> XS v n -> Maybe (XS v n)
divXS
productM :: [XS v n] -> XS v n
productM = [XS v n] -> XS v n
forall (n :: Nat) (f :: * -> *) (v :: Symbol).
(KnownNat n, Foldable f) =>
f (XS v n) -> XS v n
productXS
powM :: XS v n -> Int -> XS v n
powM = XS v n -> Int -> XS v n
forall (v :: Symbol) (n :: Nat). XS v n -> Int -> XS v n
powXS
maxDegM :: XS v n -> Int
maxDegM = XS v n -> Int
forall (v :: Symbol) (n :: Nat). XS v n -> Int
maxDegXS
totalDegM :: XS v n -> Int
totalDegM = XS v n -> Int
forall (v :: Symbol) (n :: Nat). XS v n -> Int
totalDegXS
diffM :: VarM (XS v n) -> Int -> XS v n -> Maybe (XS v n, c)
diffM = VarM (XS v n) -> Int -> XS v n -> Maybe (XS v n, c)
forall c (v :: Symbol) (n :: Nat).
Num c =>
Index -> Int -> XS v n -> Maybe (XS v n, c)
diffXS
evalM :: (VarM (XS v n) -> c) -> XS v n -> c
evalM = (VarM (XS v n) -> c) -> XS v n -> c
forall c (v :: Symbol) (n :: Nat).
Num c =>
(Index -> c) -> XS v n -> c
evalXS
varSubsM :: (VarM (XS v n) -> VarM (XS v n)) -> XS v n -> XS v n
varSubsM = (VarM (XS v n) -> VarM (XS v n)) -> XS v n -> XS v n
forall (n :: Nat) (v :: Symbol).
KnownNat n =>
(Index -> Index) -> XS v n -> XS v n
varSubsXS
termSubsM :: (VarM (XS v n) -> Maybe c) -> (XS v n, c) -> (XS v n, c)
termSubsM = (VarM (XS v n) -> Maybe c) -> (XS v n, c) -> (XS v n, c)
forall (n :: Nat) c (v :: Symbol).
(KnownNat n, Num c) =>
(Index -> Maybe c) -> (XS v n, c) -> (XS v n, c)
termSubsXS
embedXS :: (KnownNat n, KnownNat m) => XS v n -> XS v m
embedXS :: XS v n -> XS v m
embedXS XS v n
old = XS v m
new where
n :: Int
n = XS v n -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v n
old
m :: Int
m = XS v m -> Int
forall (n :: Nat) (var :: Symbol). KnownNat n => XS var n -> Int
nOfXS XS v m
new
new :: XS v m
new = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
m Int
n of
Ordering
LT -> XS v n -> XS v m
project XS v n
old
Ordering
EQ -> XS v n -> XS v m
forall (var :: Symbol) (n :: Nat) (var :: Symbol) (n :: Nat).
XS var n -> XS var n
keep XS v n
old
Ordering
GT -> XS v n -> XS v m
extend XS v n
old
extend :: XS v n -> XS v m
extend (XS UArray Int Int
arr) = UArray Int Int -> XS v m
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v m) -> UArray Int Int -> XS v m
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
m) (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Int
0)
keep :: XS var n -> XS var n
keep (XS UArray Int Int
arr) = UArray Int Int -> XS var n
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS UArray Int Int
arr
project :: XS v n -> XS v m
project (XS UArray Int Int
arr) =
let old :: [Int]
old = UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
arr
([Int]
new,[Int]
rest) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
m [Int]
old
in if (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]
rest
then UArray Int Int -> XS v m
forall (var :: Symbol) (n :: Nat). UArray Int Int -> XS var n
XS (UArray Int Int -> XS v m) -> UArray Int Int -> XS v m
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
m) [Int]
new
else String -> XS v m
forall a. HasCallStack => String -> a
error String
"Indexed/embed: the projected variables are actually used!"