{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}


-- |
-- Module      : OAlg.Entity.Sum.SumSymbol
-- Description : free sums over symbols.
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- free sums with symbols in @__a__@.
module OAlg.Entity.Sum.SumSymbol
  ( -- * SumSymbol
    SumSymbol(..), ssypsq, ssylc, sumSymbol, sy, ssyMap, ssySum, ssyJoin
  , ssyprj

    -- * R
  , R(..)
  
  ) where

import Control.Monad

import Data.List (map,repeat,zip,(++))
import Data.Foldable

import OAlg.Prelude

import OAlg.Data.Constructable

import OAlg.Structure.Fibred
import OAlg.Structure.Additive
import OAlg.Structure.Multiplicative
import OAlg.Structure.Ring
import OAlg.Structure.Vectorial

import OAlg.Entity.Sequence hiding (sy)
import OAlg.Entity.Sum.Definition

--------------------------------------------------------------------------------
-- R -

-- | adjoining the root @()@.
newtype R a = R a deriving (Int -> R a -> ShowS
forall a. Show a => Int -> R a -> ShowS
forall a. Show a => [R a] -> ShowS
forall a. Show a => R a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [R a] -> ShowS
$cshowList :: forall a. Show a => [R a] -> ShowS
show :: R a -> String
$cshow :: forall a. Show a => R a -> String
showsPrec :: Int -> R a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> R a -> ShowS
Show,R a -> R a -> Bool
forall a. Eq a => R a -> R a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: R a -> R a -> Bool
$c/= :: forall a. Eq a => R a -> R a -> Bool
== :: R a -> R a -> Bool
$c== :: forall a. Eq a => R a -> R a -> Bool
Eq,R a -> R a -> Bool
R a -> R a -> Ordering
R a -> R a -> R a
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 {a}. Ord a => Eq (R a)
forall a. Ord a => R a -> R a -> Bool
forall a. Ord a => R a -> R a -> Ordering
forall a. Ord a => R a -> R a -> R a
min :: R a -> R a -> R a
$cmin :: forall a. Ord a => R a -> R a -> R a
max :: R a -> R a -> R a
$cmax :: forall a. Ord a => R a -> R a -> R a
>= :: R a -> R a -> Bool
$c>= :: forall a. Ord a => R a -> R a -> Bool
> :: R a -> R a -> Bool
$c> :: forall a. Ord a => R a -> R a -> Bool
<= :: R a -> R a -> Bool
$c<= :: forall a. Ord a => R a -> R a -> Bool
< :: R a -> R a -> Bool
$c< :: forall a. Ord a => R a -> R a -> Bool
compare :: R a -> R a -> Ordering
$ccompare :: forall a. Ord a => R a -> R a -> Ordering
Ord,R a -> Statement
forall a. Validable a => R a -> Statement
forall a. (a -> Statement) -> Validable a
valid :: R a -> Statement
$cvalid :: forall a. Validable a => R a -> Statement
Validable)

instance Entity a => Entity (R a)

instance Entity a => Fibred (R a) where
  type Root (R a) = ()
  root :: R a -> Root (R a)
root R a
_ = ()

instance OrdRoot (R a)

--------------------------------------------------------------------------------
-- SumSymbol -

-- | free sum with symbols in @__a__@.
newtype SumSymbol r a = SumSymbol (Sum r (R a)) deriving (SumSymbol r a -> SumSymbol r a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r a.
(Entity a, Entity r) =>
SumSymbol r a -> SumSymbol r a -> Bool
/= :: SumSymbol r a -> SumSymbol r a -> Bool
$c/= :: forall r a.
(Entity a, Entity r) =>
SumSymbol r a -> SumSymbol r a -> Bool
== :: SumSymbol r a -> SumSymbol r a -> Bool
$c== :: forall r a.
(Entity a, Entity r) =>
SumSymbol r a -> SumSymbol r a -> Bool
Eq,SumSymbol r a -> SumSymbol r a -> Bool
SumSymbol r a -> SumSymbol r a -> Ordering
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
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 {r} {a}.
(Entity a, Entity r, Ord r, Ord a) =>
Eq (SumSymbol r a)
forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Bool
forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Ordering
forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
min :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cmin :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
max :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cmax :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
>= :: SumSymbol r a -> SumSymbol r a -> Bool
$c>= :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Bool
> :: SumSymbol r a -> SumSymbol r a -> Bool
$c> :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Bool
<= :: SumSymbol r a -> SumSymbol r a -> Bool
$c<= :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Bool
< :: SumSymbol r a -> SumSymbol r a -> Bool
$c< :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Bool
compare :: SumSymbol r a -> SumSymbol r a -> Ordering
$ccompare :: forall r a.
(Entity a, Entity r, Ord r, Ord a) =>
SumSymbol r a -> SumSymbol r a -> Ordering
Ord,SumSymbol r a -> Statement
forall a. (a -> Statement) -> Validable a
forall r a.
(Distributive r, Total r, Commutative r, Entity a) =>
SumSymbol r a -> Statement
valid :: SumSymbol r a -> Statement
$cvalid :: forall r a.
(Distributive r, Total r, Commutative r, Entity a) =>
SumSymbol r a -> Statement
Validable,N -> SumSymbol r a -> SumSymbol r a
Root (SumSymbol r a) -> SumSymbol r a
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
forall a.
Fibred a
-> (Root a -> a) -> (a -> a -> a) -> (N -> a -> a) -> Additive a
forall {r} {a}.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
Fibred (SumSymbol r a)
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
N -> SumSymbol r a -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
Root (SumSymbol r a) -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
ntimes :: N -> SumSymbol r a -> SumSymbol r a
$cntimes :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
N -> SumSymbol r a -> SumSymbol r a
+ :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$c+ :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
zero :: Root (SumSymbol r a) -> SumSymbol r a
$czero :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Entity a) =>
Root (SumSymbol r a) -> SumSymbol r a
Additive,Z -> SumSymbol r a -> SumSymbol r a
SumSymbol r a -> SumSymbol r a
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
forall a.
Additive a
-> (a -> a) -> (a -> a -> a) -> (Z -> a -> a) -> Abelian a
forall {r} {a}.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
Additive (SumSymbol r a)
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
Z -> SumSymbol r a -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
SumSymbol r a -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
ztimes :: Z -> SumSymbol r a -> SumSymbol r a
$cztimes :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
Z -> SumSymbol r a -> SumSymbol r a
- :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$c- :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
negate :: SumSymbol r a -> SumSymbol r a
$cnegate :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Abelian r,
 Entity a) =>
SumSymbol r a -> SumSymbol r a
Abelian)

--------------------------------------------------------------------------------
-- ssylc -

-- | the underlying linear combination.
ssylc :: Semiring r => SumSymbol r a -> LinearCombination r a
ssylc :: forall r a. Semiring r => SumSymbol r a -> LinearCombination r a
ssylc (SumSymbol Sum r (R a)
s) = forall r a. [(r, a)] -> LinearCombination r a
LinearCombination forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(r
r,R a
a) -> (r
r,a
a)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. LinearCombination r a -> [(r, a)]
lcs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Semiring r => Sum r a -> LinearCombination r a
smlc Sum r (R a)
s

--------------------------------------------------------------------------------
-- ssypsq -

-- | the underlying partial sequence.
ssypsq :: Semiring r => SumSymbol r a -> PSequence a r
ssypsq :: forall r a. Semiring r => SumSymbol r a -> PSequence a r
ssypsq SumSymbol r a
x = forall i x. [(x, i)] -> PSequence i x
PSequence forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. LinearCombination r a -> [(r, a)]
lcs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Semiring r => SumSymbol r a -> LinearCombination r a
ssylc SumSymbol r a
x

--------------------------------------------------------------------------------
-- SumSymbol - Entity -

ssyShow :: (Semiring r, Show a) => SumSymbol r a -> String
ssyShow :: forall r a. (Semiring r, Show a) => SumSymbol r a -> String
ssyShow SumSymbol r a
s = forall {a} {a}.
(Distributive a, Total a, Show a) =>
[(a, a)] -> String
shws forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. LinearCombination r a -> [(r, a)]
lcs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Semiring r => SumSymbol r a -> LinearCombination r a
ssylc SumSymbol r a
s where
  shws :: [(a, a)] -> String
shws [(a, a)]
ss = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. a -> [a] -> [a]
tween String
"+" forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}.
(Distributive a, Total a, Show a) =>
(a, a) -> String
shw [(a, a)]
ss
  shw :: (a, a) -> String
shw (a
r,a
a) | a
r forall a. Eq a => a -> a -> Bool
== forall r. Semiring r => r
rOne = forall a. Show a => a -> String
show a
a
            | Bool
otherwise = forall a. Show a => a -> String
show a
r forall a. [a] -> [a] -> [a]
++ String
"!" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a

instance (Semiring r, Show a) => Show (SumSymbol r a) where
  show :: SumSymbol r a -> String
show SumSymbol r a
s = String
"SumSymbol[" forall a. [a] -> [a] -> [a]
++ forall r a. (Semiring r, Show a) => SumSymbol r a -> String
ssyShow SumSymbol r a
s forall a. [a] -> [a] -> [a]
++ String
"]"

instance (Semiring r, Commutative r, Entity a) => Entity (SumSymbol r a)

--------------------------------------------------------------------------------
-- SumSymbol - Fibred - Vectorial -

instance (Semiring r, Commutative r, Entity a) => Fibred (SumSymbol r a) where
  type Root (SumSymbol r a) = ()
  root :: SumSymbol r a -> Root (SumSymbol r a)
root SumSymbol r a
_ = ()

instance (Semiring r, Commutative r, Entity a, Ord a) => Vectorial (SumSymbol r a) where
  type Scalar (SumSymbol r a) = r
  Scalar (SumSymbol r a)
r ! :: Scalar (SumSymbol r a) -> SumSymbol r a -> SumSymbol r a
! (SumSymbol Sum r (R a)
a) = forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (Scalar (SumSymbol r a)
r forall v. Vectorial v => Scalar v -> v -> v
! Sum r (R a)
a)

instance (Semiring r, Commutative r, Entity a, Ord a) => Euclidean (SumSymbol r a) where
  SumSymbol r a
x <!> :: SumSymbol r a -> SumSymbol r a -> Scalar (SumSymbol r a)
<!> SumSymbol r a
y
    = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Additive a => a -> a -> a
(+) forall r. Semiring r => r
rZero
    forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
    forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall i x. PSequence i x -> [(x, i)]
psqxs
    forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall i x y z.
Ord i =>
(x -> y -> z)
-> (x -> z)
-> (y -> z)
-> PSequence i x
-> PSequence i y
-> PSequence i z
psqInterlace forall c. Multiplicative c => c -> c -> c
(*) (forall b a. b -> a -> b
const forall r. Semiring r => r
rZero) (forall b a. b -> a -> b
const forall r. Semiring r => r
rZero) (forall r a. Semiring r => SumSymbol r a -> PSequence a r
ssypsq SumSymbol r a
x) (forall r a. Semiring r => SumSymbol r a -> PSequence a r
ssypsq SumSymbol r a
y)
    
--------------------------------------------------------------------------------
-- sumSymbol -

-- | the induced free sum given by a list of scalars and symbols.
sumSymbol :: (Semiring r, Commutative r, Entity a, Ord a) => [(r,a)] -> SumSymbol r a
sumSymbol :: forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
[(r, a)] -> SumSymbol r a
sumSymbol [(r, a)]
xs = forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall r a. SumForm r a -> SumForm r a -> SumForm r a
(:+) (forall r a. Root a -> SumForm r a
Zero ()) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(r
r,a
a) -> r
r forall r a. r -> SumForm r a -> SumForm r a
:! (forall r a. a -> SumForm r a
S forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. a -> R a
R a
a)) [(r, a)]
xs

--------------------------------------------------------------------------------
-- sy -

-- | the induced free sum given by the symbol.
sy :: (Semiring r, Commutative r, Entity a, Ord a) => a -> SumSymbol r a
sy :: forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
a -> SumSymbol r a
sy a
a = forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
[(r, a)] -> SumSymbol r a
sumSymbol [(forall r. Semiring r => r
rOne,a
a)]

--------------------------------------------------------------------------------
-- ssyMap -

-- | mapping of free sums
ssyMap :: (Semiring r, Commutative r, Entity y, Ord y) => (x -> y) -> SumSymbol r x -> SumSymbol r y
ssyMap :: forall r y x.
(Semiring r, Commutative r, Entity y, Ord y) =>
(x -> y) -> SumSymbol r x -> SumSymbol r y
ssyMap x -> y
f (SumSymbol Sum r (R x)
s) = forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (forall y r x.
(Singleton (Root y), Fibred y, Ord y, Semiring r, Commutative r) =>
(x -> y) -> Sum r x -> Sum r y
smMap R x -> R y
f' Sum r (R x)
s) where
  f' :: R x -> R y
f' (R x
x) = forall a. a -> R a
R (x -> y
f x
x)

--------------------------------------------------------------------------------
-- ssySum -

-- | additive homomorphism given by a mapping of a symbol in @__x__@ to a linear combination of
-- @__y__@.
ssySum :: (Semiring r, Commutative r, Entity y, Ord y)
  => (x -> LinearCombination r y) -> SumSymbol r x -> SumSymbol r y
ssySum :: forall r y x.
(Semiring r, Commutative r, Entity y, Ord y) =>
(x -> LinearCombination r y) -> SumSymbol r x -> SumSymbol r y
ssySum x -> LinearCombination r y
f (SumSymbol Sum r (R x)
s) = forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. SumForm r (SumForm r a) -> SumForm r a
smfJoin forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall y x r.
Singleton (Root y) =>
(x -> y) -> SumForm r x -> SumForm r y
smfMap (forall r x y.
Semiring r =>
(x -> LinearCombination r y) -> R x -> SumForm r (R y)
f' x -> LinearCombination r y
f) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Exposable x => x -> Form x
form Sum r (R x)
s where
  f' :: Semiring r => (x -> LinearCombination r y) -> R x -> SumForm r (R y)
  f' :: forall r x y.
Semiring r =>
(x -> LinearCombination r y) -> R x -> SumForm r (R y)
f' x -> LinearCombination r y
f (R x
x) = forall r a.
Semiring r =>
Root a -> LinearCombination r a -> SumForm r a
lcsmf () forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. [(r, a)] -> LinearCombination r a
LinearCombination forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall (h :: * -> * -> *) (f :: * -> *) a b.
Applicative1 h f =>
h a b -> f a -> f b
amap1 (\(r
r,y
y) -> (r
r,forall a. a -> R a
R y
y)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. LinearCombination r a -> [(r, a)]
lcs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ x -> LinearCombination r y
f x
x

--------------------------------------------------------------------------------
-- ssyJoin -

-- | joining a free sum of free sums to a free sum.
ssyJoin :: (Semiring r, Commutative r, Entity x, Ord x)
  => SumSymbol r (SumSymbol r x) -> SumSymbol r x
ssyJoin :: forall r x.
(Semiring r, Commutative r, Entity x, Ord x) =>
SumSymbol r (SumSymbol r x) -> SumSymbol r x
ssyJoin (SumSymbol Sum r (R (SumSymbol r x))
s) = forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. SumForm r (SumForm r a) -> SumForm r a
smfJoin forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall y x r.
Singleton (Root y) =>
(x -> y) -> SumForm r x -> SumForm r y
smfMap forall r x. R (SumSymbol r x) -> SumForm r (R x)
f forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Exposable x => x -> Form x
form Sum r (R (SumSymbol r x))
s where
  f :: R (SumSymbol r x) -> SumForm r (R x)
  f :: forall r x. R (SumSymbol r x) -> SumForm r (R x)
f (R (SumSymbol Sum r (R x)
s)) = forall x. Exposable x => x -> Form x
form Sum r (R x)
s

--------------------------------------------------------------------------------
-- ssyprj -

-- | the projectin of a free sum according to the given set of symbols.
--
-- __Definition__ Let @x@ be in @'SumSymbol' __r__ __a__@ and @s@ a 'Set' of symbols in
-- @__a__@, then @x@ is called __/representable according to/__ @s@ iff all symbols of @'ssylc' x@
-- are elements of @s@.
--
-- __Property__ Let @s@ be a set of symbols in @__a__@ and @x@ be representable in
-- @'SumSymbol' __r__ __a__@ according to @s@, then @'ssyprj' x '==' x@.
--
-- __Examples__ 
--
-- >>> ssyprj (Set [A,D,E]) (3!sy D) :: SumSymbol Z Symbol
-- SumSymbol[3!D]
--
-- >>> ssyprj (Set [A,D,E]) (2!sy B) :: SumSymbol Z Symbol
-- SumSymbol[]
--
-- >>> ssyprj (Set [A,D,E]) (3!sy D + sy A - 5!sy E) :: SumSymbol Z Symbol
-- SumSymbol[A+3!D+-5!E]
--
-- >>> ssyprj (Set [A,D,E]) (2!sy D + 7!sy B - sy E + sy F) :: SumSymbol Z Symbol
-- SumSymbol[2!D+-1!E]
ssyprj :: (Semiring r, Commutative r, Ord a, Entity a) => Set a -> SumSymbol r a -> SumSymbol r a
ssyprj :: forall r a.
(Semiring r, Commutative r, Ord a, Entity a) =>
Set a -> SumSymbol r a -> SumSymbol r a
ssyprj Set a
xs SumSymbol r a
x = forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
[(r, a)] -> SumSymbol r a
sumSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall i x. PSequence i x -> [(x, i)]
psqxs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall i x y z.
Ord i =>
(x -> y -> z)
-> (x -> z)
-> (y -> z)
-> PSequence i x
-> PSequence i y
-> PSequence i z
psqInterlace forall c. Multiplicative c => c -> c -> c
(*) (forall b a. b -> a -> b
const forall r. Semiring r => r
rZero) (forall b a. b -> a -> b
const forall r. Semiring r => r
rZero) PSequence a r
xs' (forall r a. Semiring r => SumSymbol r a -> PSequence a r
ssypsq SumSymbol r a
x)
  where xs' :: PSequence a r
xs' = forall i x. [(x, i)] -> PSequence i x
PSequence (forall a. a -> [a]
repeat forall r. Semiring r => r
rOne forall a b. [a] -> [b] -> [(a, b)]
`zip` forall x. Set x -> [x]
setxs Set a
xs )