-- | Tensor product (that is, pairs) of monomials

{-# LANGUAGE CPP, BangPatterns, TypeFamilies, UnicodeSyntax, KindSignatures, DataKinds #-}
module Math.Algebra.Polynomial.Monomial.Tensor where

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

import Data.Typeable
import Data.Either

import Data.Proxy
import GHC.TypeLits

#if MIN_VERSION_base(4,11,0)        
import Data.Semigroup
import Data.Monoid
#else
import Data.Monoid
#endif

import Math.Algebra.Polynomial.Class
import Math.Algebra.Polynomial.Pretty

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

-- | Elementary tensors (basically pairs). The phantom type parameter
-- @symbol@ is used to render an infix symbol when pretty-printing
data Tensor (symbol :: Symbol) (a :: *) (b :: *) = Tensor !a !b deriving (Tensor symbol a b -> Tensor symbol a b -> Bool
(Tensor symbol a b -> Tensor symbol a b -> Bool)
-> (Tensor symbol a b -> Tensor symbol a b -> Bool)
-> Eq (Tensor symbol a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (symbol :: Symbol) a b.
(Eq a, Eq b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
/= :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c/= :: forall (symbol :: Symbol) a b.
(Eq a, Eq b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
== :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c== :: forall (symbol :: Symbol) a b.
(Eq a, Eq b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
Eq,Eq (Tensor symbol a b)
Eq (Tensor symbol a b)
-> (Tensor symbol a b -> Tensor symbol a b -> Ordering)
-> (Tensor symbol a b -> Tensor symbol a b -> Bool)
-> (Tensor symbol a b -> Tensor symbol a b -> Bool)
-> (Tensor symbol a b -> Tensor symbol a b -> Bool)
-> (Tensor symbol a b -> Tensor symbol a b -> Bool)
-> (Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b)
-> (Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b)
-> Ord (Tensor symbol a b)
Tensor symbol a b -> Tensor symbol a b -> Bool
Tensor symbol a b -> Tensor symbol a b -> Ordering
Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
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 (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Eq (Tensor symbol a b)
forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Ordering
forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
min :: Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
$cmin :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
max :: Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
$cmax :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Tensor symbol a b
>= :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c>= :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
> :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c> :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
<= :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c<= :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
< :: Tensor symbol a b -> Tensor symbol a b -> Bool
$c< :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Bool
compare :: Tensor symbol a b -> Tensor symbol a b -> Ordering
$ccompare :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Tensor symbol a b -> Tensor symbol a b -> Ordering
$cp1Ord :: forall (symbol :: Symbol) a b.
(Ord a, Ord b) =>
Eq (Tensor symbol a b)
Ord,Int -> Tensor symbol a b -> ShowS
[Tensor symbol a b] -> ShowS
Tensor symbol a b -> String
(Int -> Tensor symbol a b -> ShowS)
-> (Tensor symbol a b -> String)
-> ([Tensor symbol a b] -> ShowS)
-> Show (Tensor symbol a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (symbol :: Symbol) a b.
(Show a, Show b) =>
Int -> Tensor symbol a b -> ShowS
forall (symbol :: Symbol) a b.
(Show a, Show b) =>
[Tensor symbol a b] -> ShowS
forall (symbol :: Symbol) a b.
(Show a, Show b) =>
Tensor symbol a b -> String
showList :: [Tensor symbol a b] -> ShowS
$cshowList :: forall (symbol :: Symbol) a b.
(Show a, Show b) =>
[Tensor symbol a b] -> ShowS
show :: Tensor symbol a b -> String
$cshow :: forall (symbol :: Symbol) a b.
(Show a, Show b) =>
Tensor symbol a b -> String
showsPrec :: Int -> Tensor symbol a b -> ShowS
$cshowsPrec :: forall (symbol :: Symbol) a b.
(Show a, Show b) =>
Int -> Tensor symbol a b -> ShowS
Show,Typeable)

instance (Semigroup a, Semigroup b) => Semigroup (Tensor sym a b) where
  <> :: Tensor sym a b -> Tensor sym a b -> Tensor sym a b
(<>) (Tensor a
x1 b
y1) (Tensor a
x2 b
y2) = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (a
x1a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
x2) (b
y1b -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
y2)
  
instance (Monoid a, Monoid b) => Monoid (Tensor sym a b) where
  mempty :: Tensor sym a b
mempty = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
forall a. Monoid a => a
mempty b
forall a. Monoid a => a
mempty
  mappend :: Tensor sym a b -> Tensor sym a b -> Tensor sym a b
mappend (Tensor a
x1 b
y1) (Tensor a
x2 b
y2) = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (a
x1 a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x2) (b
y1 b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` b
y2)

instance (KnownSymbol sym, Pretty a, Pretty b) => Pretty (Tensor sym a b) where
  pretty :: Tensor sym a b -> String
pretty t :: Tensor sym a b
t@(Tensor a
a b
b) = a -> String
forall a. Pretty a => a -> String
pretty a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tensor sym a b -> String
forall (sym :: Symbol) a b.
KnownSymbol sym =>
Tensor sym a b -> String
tensorSymbol Tensor sym a b
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pretty b
b
  
tensorSymbol :: KnownSymbol sym => Tensor sym a b -> String
tensorSymbol :: Tensor sym a b -> String
tensorSymbol = Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> String)
-> (Tensor sym a b -> Proxy sym) -> Tensor sym a b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tensor sym a b -> Proxy sym
forall (sym :: Symbol) a b. Tensor sym a b -> Proxy sym
symProxy where
  symProxy :: Tensor sym a b -> Proxy sym
  symProxy :: Tensor sym a b -> Proxy sym
symProxy Tensor sym a b
_ = Proxy sym
forall k (t :: k). Proxy t
Proxy

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

flip :: Tensor sym a b -> Tensor sym b a
flip :: Tensor sym a b -> Tensor sym b a
flip (Tensor a
x b
y) = b -> a -> Tensor sym b a
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor b
y a
x

--------------------------------------------------------------------------------
-- * Injections

injLeft :: Monoid b => a -> Tensor sym a b
injLeft :: a -> Tensor sym a b
injLeft a
x = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
x b
forall a. Monoid a => a
mempty

injRight :: Monoid a => b -> Tensor sym a b
injRight :: b -> Tensor sym a b
injRight b
x = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
forall a. Monoid a => a
mempty b
x

--------------------------------------------------------------------------------
-- * Projections

projLeft :: Tensor sym a b -> a
projLeft :: Tensor sym a b -> a
projLeft (Tensor a
x b
_) = a
x

projRight :: Tensor sym a b -> b
projRight :: Tensor sym a b -> b
projRight (Tensor a
_ b
y) = b
y

--------------------------------------------------------------------------------
-- * differentiation
 
diffTensor :: (Monomial a, Monomial b, Num c) => Either (VarM a) (VarM b) -> Int -> Tensor sym a b -> Maybe (Tensor sym a b, c)
diffTensor :: Either (VarM a) (VarM b)
-> Int -> Tensor sym a b -> Maybe (Tensor sym a b, c)
diffTensor Either (VarM a) (VarM b)
ei Int
k (Tensor a
left b
right) = case Either (VarM a) (VarM b)
ei of
  Left VarM a
v  -> case VarM a -> Int -> a -> Maybe (a, c)
forall m c.
(Monomial m, Num c) =>
VarM m -> Int -> m -> Maybe (m, c)
diffM VarM a
v Int
k a
left of
    Just (a
left' ,c
c) -> (Tensor sym a b, c) -> Maybe (Tensor sym a b, c)
forall a. a -> Maybe a
Just (a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
left' b
right , c
c)
    Maybe (a, c)
Nothing         -> Maybe (Tensor sym a b, c)
forall a. Maybe a
Nothing
  Right VarM b
v -> case VarM b -> Int -> b -> Maybe (b, c)
forall m c.
(Monomial m, Num c) =>
VarM m -> Int -> m -> Maybe (m, c)
diffM VarM b
v Int
k b
right of
    Just (b
right',c
c) -> (Tensor sym a b, c) -> Maybe (Tensor sym a b, c)
forall a. a -> Maybe a
Just (a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
left  b
right', c
c)
    Maybe (b, c)
Nothing         -> Maybe (Tensor sym a b, c)
forall a. Maybe a
Nothing

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

instance (KnownSymbol sym, Monomial a, Monomial b) => Monomial (Tensor sym a b) where
  type VarM (Tensor sym a b) = Either (VarM a) (VarM b)
  
  -- checking the invariant
  normalizeM :: Tensor sym a b -> Tensor sym a b
normalizeM  (Tensor a
x b
y) = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (a -> a
forall m. Monomial m => m -> m
normalizeM a
x) (b -> b
forall m. Monomial m => m -> m
normalizeM b
y)
  isNormalM :: Tensor sym a b -> Bool
isNormalM   (Tensor a
x b
y) = a -> Bool
forall m. Monomial m => m -> Bool
isNormalM a
x Bool -> Bool -> Bool
&& b -> Bool
forall m. Monomial m => m -> Bool
isNormalM b
y

  -- construction and deconstruction
  fromListM :: [(VarM (Tensor sym a b), Int)] -> Tensor sym a b
fromListM   [(VarM (Tensor sym a b), Int)]
list = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor ([(VarM a, Int)] -> a
forall m. Monomial m => [(VarM m, Int)] -> m
fromListM [(VarM a, Int)]
list1) ([(VarM b, Int)] -> b
forall m. Monomial m => [(VarM m, Int)] -> m
fromListM [(VarM b, Int)]
list2) where
                ([(VarM a, Int)]
list1,[(VarM b, Int)]
list2) = [Either (VarM a, Int) (VarM b, Int)]
-> ([(VarM a, Int)], [(VarM b, Int)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (VarM a, Int) (VarM b, Int)]
 -> ([(VarM a, Int)], [(VarM b, Int)]))
-> [Either (VarM a, Int) (VarM b, Int)]
-> ([(VarM a, Int)], [(VarM b, Int)])
forall a b. (a -> b) -> a -> b
$ ((Either (VarM a) (VarM b), Int)
 -> Either (VarM a, Int) (VarM b, Int))
-> [(Either (VarM a) (VarM b), Int)]
-> [Either (VarM a, Int) (VarM b, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Either (VarM a) (VarM b), Int)
-> Either (VarM a, Int) (VarM b, Int)
forall a b c. (Either a b, c) -> Either (a, c) (b, c)
distEither [(Either (VarM a) (VarM b), Int)]
[(VarM (Tensor sym a b), Int)]
list                                         
  toListM :: Tensor sym a b -> [(VarM (Tensor sym a b), Int)]
toListM     (Tensor a
x b
y) = ((VarM a, Int) -> (Either (VarM a) (VarM b), Int))
-> [(VarM a, Int)] -> [(Either (VarM a) (VarM b), Int)]
forall a b. (a -> b) -> [a] -> [b]
map (VarM a, Int) -> (Either (VarM a) (VarM b), Int)
forall a b b. (a, b) -> (Either a b, b)
f (a -> [(VarM a, Int)]
forall m. Monomial m => m -> [(VarM m, Int)]
toListM a
x) [(Either (VarM a) (VarM b), Int)]
-> [(Either (VarM a) (VarM b), Int)]
-> [(Either (VarM a) (VarM b), Int)]
forall a. [a] -> [a] -> [a]
++ ((VarM b, Int) -> (Either (VarM a) (VarM b), Int))
-> [(VarM b, Int)] -> [(Either (VarM a) (VarM b), Int)]
forall a b. (a -> b) -> [a] -> [b]
map (VarM b, Int) -> (Either (VarM a) (VarM b), Int)
forall b b a. (b, b) -> (Either a b, b)
g (b -> [(VarM b, Int)]
forall m. Monomial m => m -> [(VarM m, Int)]
toListM b
y) where
                f :: (a, b) -> (Either a b, b)
f (a
v,b
e) = (a -> Either a b
forall a b. a -> Either a b
Left  a
v, b
e)
                g :: (b, b) -> (Either a b, b)
g (b
v,b
e) = (b -> Either a b
forall a b. b -> Either a b
Right b
v, b
e)

  -- simple monomials
  emptyM :: Tensor sym a b
emptyM      = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
forall m. Monomial m => m
emptyM b
forall m. Monomial m => m
emptyM
  isEmptyM :: Tensor sym a b -> Bool
isEmptyM    (Tensor a
x b
y) = a -> Bool
forall m. Monomial m => m -> Bool
isEmptyM a
x Bool -> Bool -> Bool
&& b -> Bool
forall m. Monomial m => m -> Bool
isEmptyM b
y
  variableM :: VarM (Tensor sym a b) -> Tensor sym a b
variableM   VarM (Tensor sym a b)
ei = case VarM (Tensor sym a b)
ei of 
                       Left  v -> a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (VarM a -> a
forall m. Monomial m => VarM m -> m
variableM VarM a
v) b
forall m. Monomial m => m
emptyM
                       Right v -> a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
forall m. Monomial m => m
emptyM (VarM b -> b
forall m. Monomial m => VarM m -> m
variableM VarM b
v)
  singletonM :: VarM (Tensor sym a b) -> Int -> Tensor sym a b
singletonM  VarM (Tensor sym a b)
ei Int
k = case VarM (Tensor sym a b)
ei of 
                       Left  v -> a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (VarM a -> Int -> a
forall m. Monomial m => VarM m -> Int -> m
singletonM VarM a
v Int
k) b
forall m. Monomial m => m
emptyM
                       Right v -> a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
forall m. Monomial m => m
emptyM (VarM b -> Int -> b
forall m. Monomial m => VarM m -> Int -> m
singletonM VarM b
v Int
k)
  -- algebra
  mulM :: Tensor sym a b -> Tensor sym a b -> Tensor sym a b
mulM        (Tensor a
x1 b
y1) (Tensor a
x2 b
y2) = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (a -> a -> a
forall m. Monomial m => m -> m -> m
mulM a
x1 a
x2) (b -> b -> b
forall m. Monomial m => m -> m -> m
mulM b
y1 b
y2)
  productM :: [Tensor sym a b] -> Tensor sym a b
productM    [Tensor sym a b]
tensors = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor ([a] -> a
forall m. Monomial m => [m] -> m
productM ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Tensor sym a b -> a) -> [Tensor sym a b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tensor sym a b -> a
forall (sym :: Symbol) a b. Tensor sym a b -> a
projLeft [Tensor sym a b]
tensors) ([b] -> b
forall m. Monomial m => [m] -> m
productM ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (Tensor sym a b -> b) -> [Tensor sym a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Tensor sym a b -> b
forall (sym :: Symbol) a b. Tensor sym a b -> b
projRight [Tensor sym a b]
tensors)
  powM :: Tensor sym a b -> Int -> Tensor sym a b
powM        (Tensor a
x b
y) Int
k = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor (a -> Int -> a
forall m. Monomial m => m -> Int -> m
powM a
x Int
k) (b -> Int -> b
forall m. Monomial m => m -> Int -> m
powM b
y Int
k)

  divM :: Tensor sym a b -> Tensor sym a b -> Maybe (Tensor sym a b)
divM        (Tensor a
x1 b
y1) (Tensor a
x2 b
y2) = case (a -> a -> Maybe a
forall m. Monomial m => m -> m -> Maybe m
divM a
x1 a
x2, b -> b -> Maybe b
forall m. Monomial m => m -> m -> Maybe m
divM b
y1 b
y2) of
                  (Just a
z1 , Just b
z2) -> Tensor sym a b -> Maybe (Tensor sym a b)
forall a. a -> Maybe a
Just (a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
z1 b
z2)
                  (Maybe a
_       , Maybe b
_      ) -> Maybe (Tensor sym a b)
forall a. Maybe a
Nothing

  -- calculus
  diffM :: VarM (Tensor sym a b)
-> Int -> Tensor sym a b -> Maybe (Tensor sym a b, c)
diffM = VarM (Tensor sym a b)
-> Int -> Tensor sym a b -> Maybe (Tensor sym a b, c)
forall a b c (sym :: Symbol).
(Monomial a, Monomial b, Num c) =>
Either (VarM a) (VarM b)
-> Int -> Tensor sym a b -> Maybe (Tensor sym a b, c)
diffTensor

  -- degrees
  maxDegM :: Tensor sym a b -> Int
maxDegM     (Tensor a
x b
y) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (a -> Int
forall m. Monomial m => m -> Int
maxDegM a
x) (b -> Int
forall m. Monomial m => m -> Int
maxDegM b
y)
  totalDegM :: Tensor sym a b -> Int
totalDegM   (Tensor a
x b
y) = a -> Int
forall m. Monomial m => m -> Int
totalDegM a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall m. Monomial m => m -> Int
totalDegM b
y

  -- substitution and evaluation
  evalM :: (VarM (Tensor sym a b) -> c) -> Tensor sym a b -> c
evalM       VarM (Tensor sym a b) -> c
f (Tensor a
x b
y) = (VarM a -> c) -> a -> c
forall m c. (Monomial m, Num c) => (VarM m -> c) -> m -> c
evalM (Either (VarM a) (VarM b) -> c
VarM (Tensor sym a b) -> c
f (Either (VarM a) (VarM b) -> c)
-> (VarM a -> Either (VarM a) (VarM b)) -> VarM a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM a -> Either (VarM a) (VarM b)
forall a b. a -> Either a b
Left) a
x c -> c -> c
forall a. Num a => a -> a -> a
* (VarM b -> c) -> b -> c
forall m c. (Monomial m, Num c) => (VarM m -> c) -> m -> c
evalM (Either (VarM a) (VarM b) -> c
VarM (Tensor sym a b) -> c
f (Either (VarM a) (VarM b) -> c)
-> (VarM b -> Either (VarM a) (VarM b)) -> VarM b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM b -> Either (VarM a) (VarM b)
forall a b. b -> Either a b
Right) b
y
  varSubsM :: (VarM (Tensor sym a b) -> VarM (Tensor sym a b))
-> Tensor sym a b -> Tensor sym a b
varSubsM    VarM (Tensor sym a b) -> VarM (Tensor sym a b)
f (Tensor a
x b
y) = a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
x' b
y' where
                  x' :: a
x' = (VarM a -> VarM a) -> a -> a
forall m. Monomial m => (VarM m -> VarM m) -> m -> m
varSubsM (Either (VarM a) (VarM b) -> VarM a
forall a b. Either a b -> a
unsafeFromLeft  (Either (VarM a) (VarM b) -> VarM a)
-> (VarM a -> Either (VarM a) (VarM b)) -> VarM a -> VarM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (VarM a) (VarM b) -> Either (VarM a) (VarM b)
VarM (Tensor sym a b) -> VarM (Tensor sym a b)
f (Either (VarM a) (VarM b) -> Either (VarM a) (VarM b))
-> (VarM a -> Either (VarM a) (VarM b))
-> VarM a
-> Either (VarM a) (VarM b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM a -> Either (VarM a) (VarM b)
forall a b. a -> Either a b
Left ) a
x
                  y' :: b
y' = (VarM b -> VarM b) -> b -> b
forall m. Monomial m => (VarM m -> VarM m) -> m -> m
varSubsM (Either (VarM a) (VarM b) -> VarM b
forall a b. Either a b -> b
unsafeFromRight (Either (VarM a) (VarM b) -> VarM b)
-> (VarM b -> Either (VarM a) (VarM b)) -> VarM b -> VarM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (VarM a) (VarM b) -> Either (VarM a) (VarM b)
VarM (Tensor sym a b) -> VarM (Tensor sym a b)
f (Either (VarM a) (VarM b) -> Either (VarM a) (VarM b))
-> (VarM b -> Either (VarM a) (VarM b))
-> VarM b
-> Either (VarM a) (VarM b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM b -> Either (VarM a) (VarM b)
forall a b. b -> Either a b
Right) b
y
  termSubsM :: (VarM (Tensor sym a b) -> Maybe c)
-> (Tensor sym a b, c) -> (Tensor sym a b, c)
termSubsM   VarM (Tensor sym a b) -> Maybe c
f (Tensor a
x b
y, c
c) = (a -> b -> Tensor sym a b
forall (symbol :: Symbol) a b. a -> b -> Tensor symbol a b
Tensor a
x' b
y', c
cc -> c -> c
forall a. Num a => a -> a -> a
*c
dc -> c -> c
forall a. Num a => a -> a -> a
*c
e) where
                  (a
x',c
d) = (VarM a -> Maybe c) -> (a, c) -> (a, c)
forall m c.
(Monomial m, Num c) =>
(VarM m -> Maybe c) -> (m, c) -> (m, c)
termSubsM (Either (VarM a) (VarM b) -> Maybe c
VarM (Tensor sym a b) -> Maybe c
f (Either (VarM a) (VarM b) -> Maybe c)
-> (VarM a -> Either (VarM a) (VarM b)) -> VarM a -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM a -> Either (VarM a) (VarM b)
forall a b. a -> Either a b
Left ) (a
x,c
1)
                  (b
y',c
e) = (VarM b -> Maybe c) -> (b, c) -> (b, c)
forall m c.
(Monomial m, Num c) =>
(VarM m -> Maybe c) -> (m, c) -> (m, c)
termSubsM (Either (VarM a) (VarM b) -> Maybe c
VarM (Tensor sym a b) -> Maybe c
f (Either (VarM a) (VarM b) -> Maybe c)
-> (VarM b -> Either (VarM a) (VarM b)) -> VarM b -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarM b -> Either (VarM a) (VarM b)
forall a b. b -> Either a b
Right) (b
y,c
1)

--------------------------------------------------------------------------------
-- * Helpers

distEither :: (Either a b, c) -> Either (a,c) (b,c)
distEither :: (Either a b, c) -> Either (a, c) (b, c)
distEither (Either a b
ei, c
z) = case Either a b
ei of
  Left  a
x -> (a, c) -> Either (a, c) (b, c)
forall a b. a -> Either a b
Left  (a
x,c
z)
  Right b
y -> (b, c) -> Either (a, c) (b, c)
forall a b. b -> Either a b
Right (b
y,c
z)

unsafeFromLeft :: Either a b -> a
unsafeFromLeft :: Either a b -> a
unsafeFromLeft Either a b
ei = case Either a b
ei of 
  Left  a
x -> a
x
  Right b
_ -> String -> a
forall a. HasCallStack => String -> a
error String
"unsafeFromLeft: Right"

unsafeFromRight :: Either a b -> b
unsafeFromRight :: Either a b -> b
unsafeFromRight Either a b
ei = case Either a b
ei of 
  Left  a
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"unsafeFromRight: Left"
  Right b
y -> b
y

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