-- | Multivariate monomials where the variable set 
-- looks like @{x_1, x_2, ... , x_N}@ 

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

--------------------------------------------------------------------------------
-- * Monomials

-- | Monomials of the variables @x1,x2,...,xn@. The internal representation is the
-- dense array of exponents: @x1^e1*x2^e2*...*xn^en@ is represented by @[e1,e2,...,en]@.
--
-- The type is indexed by the /name/ of the variables, and then the /number/ of variables.
--
-- Note that we require here that the array has bounds @(1,n)@
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)

-- | Note: this must be a monomial ordering!
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

-- | Name of the variables
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

-- | Number of variables
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

--------------------------------------------------------------------------------
-- * emptyness

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)

--------------------------------------------------------------------------------
-- * normalization

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

--------------------------------------------------------------------------------
-- * conversion

-- | from @(variable,exponent)@ pairs
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)
  
-- | to @(variable,exponent)@ pairs
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 ]

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

-- | from exponent list
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)

-- | to exponent list
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

--------------------------------------------------------------------------------
-- * creation

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

--------------------------------------------------------------------------------
-- * multiplication

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

--------------------------------------------------------------------------------
-- * degree

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)

--------------------------------------------------------------------------------
-- * evaluation and substituion

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    )
 
--------------------------------------------------------------------------------
-- * differentiation

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

--------------------------------------------------------------------------------
-- * changing the number of variables

-- | You can always increase the number of variables; 
-- you can also decrease, if don't use the last few ones.
--
-- This will throw an error if you try to eliminate variables which are in fact used.
-- To do that, you can instead substitute 1 into them.
--
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!"

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