{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
{-# 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.Canonical
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

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

-- | free sum with symbols in @__a__@.
newtype SumSymbol r a = SumSymbol (Sum r (R a)) deriving (SumSymbol r a -> SumSymbol r a -> Bool
(SumSymbol r a -> SumSymbol r a -> Bool)
-> (SumSymbol r a -> SumSymbol r a -> Bool) -> Eq (SumSymbol r a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r a.
(Show a, Show r, Eq a, Eq r, Validable a, Validable r, Typeable a,
 Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
$c== :: forall r a.
(Show a, Show r, Eq a, Eq r, Validable a, Validable r, Typeable a,
 Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
== :: SumSymbol r a -> SumSymbol r a -> Bool
$c/= :: forall r a.
(Show a, Show r, Eq a, Eq r, Validable a, Validable r, Typeable a,
 Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
/= :: SumSymbol r a -> SumSymbol r a -> Bool
Eq,Eq (SumSymbol r a)
Eq (SumSymbol r a) =>
(SumSymbol r a -> SumSymbol r a -> Ordering)
-> (SumSymbol r a -> SumSymbol r a -> Bool)
-> (SumSymbol r a -> SumSymbol r a -> Bool)
-> (SumSymbol r a -> SumSymbol r a -> Bool)
-> (SumSymbol r a -> SumSymbol r a -> Bool)
-> (SumSymbol r a -> SumSymbol r a -> SumSymbol r a)
-> (SumSymbol r a -> SumSymbol r a -> SumSymbol r a)
-> Ord (SumSymbol r a)
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.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
Eq (SumSymbol r a)
forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Ordering
forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$ccompare :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Ordering
compare :: SumSymbol r a -> SumSymbol r a -> Ordering
$c< :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
< :: SumSymbol r a -> SumSymbol r a -> Bool
$c<= :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
<= :: SumSymbol r a -> SumSymbol r a -> Bool
$c> :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
> :: SumSymbol r a -> SumSymbol r a -> Bool
$c>= :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> Bool
>= :: SumSymbol r a -> SumSymbol r a -> Bool
$cmax :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
max :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cmin :: forall r a.
(Ord r, Ord a, Show a, Show r, Validable a, Validable r,
 Typeable a, Typeable r) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
min :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
Ord,SumSymbol r a -> Statement
(SumSymbol r a -> Statement) -> Validable (SumSymbol r a)
forall a. (a -> Statement) -> Validable a
forall r a.
(Distributive r, Total r, Commutative r, Show a, Eq a, Validable a,
 Typeable a) =>
SumSymbol r a -> Statement
$cvalid :: forall r a.
(Distributive r, Total r, Commutative r, Show a, Eq a, Validable a,
 Typeable a) =>
SumSymbol r a -> Statement
valid :: SumSymbol r a -> Statement
Validable,Fibred (SumSymbol r a)
N -> SumSymbol r a -> SumSymbol r a
Root (SumSymbol r a) -> SumSymbol r a
Fibred (SumSymbol r a) =>
(Root (SumSymbol r a) -> SumSymbol r a)
-> (SumSymbol r a -> SumSymbol r a -> SumSymbol r a)
-> (N -> SumSymbol r a -> SumSymbol r a)
-> Additive (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, Show a,
 Validable a, Typeable a) =>
Fibred (SumSymbol r a)
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
N -> SumSymbol r a -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
Root (SumSymbol r a) -> SumSymbol r a
forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$czero :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
Root (SumSymbol r a) -> SumSymbol r a
zero :: Root (SumSymbol r a) -> SumSymbol r a
$c+ :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
+ :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cntimes :: forall r a.
(Distributive r, Total r, Commutative r, Ord a, Show a,
 Validable a, Typeable a) =>
N -> SumSymbol r a -> SumSymbol r a
ntimes :: N -> SumSymbol r a -> SumSymbol r a
Additive,Additive (SumSymbol r a)
Z -> SumSymbol r a -> SumSymbol r a
Additive (SumSymbol r a) =>
(SumSymbol r a -> SumSymbol r a)
-> (SumSymbol r a -> SumSymbol r a -> SumSymbol r a)
-> (Z -> SumSymbol r a -> SumSymbol r a)
-> Abelian (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.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
Additive (SumSymbol r a)
forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
Z -> SumSymbol r a -> SumSymbol r a
forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a
forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cnegate :: forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a
negate :: SumSymbol r a -> SumSymbol r a
$c- :: forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
SumSymbol r a -> SumSymbol r a -> SumSymbol r a
- :: SumSymbol r a -> SumSymbol r a -> SumSymbol r a
$cztimes :: forall r a.
(Ord a, Distributive r, Total r, Abelian r, Commutative r, Show a,
 Validable a, Typeable a) =>
Z -> SumSymbol r a -> SumSymbol r a
ztimes :: Z -> 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) = [(r, a)] -> LinearCombination r a
forall r a. [(r, a)] -> LinearCombination r a
LinearCombination ([(r, a)] -> LinearCombination r a)
-> [(r, a)] -> LinearCombination r a
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((r, R a) -> (r, a)) -> [(r, R a)] -> [(r, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(r
r,R a
a) -> (r
r,a
a)) ([(r, R a)] -> [(r, a)]) -> [(r, R a)] -> [(r, a)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ LinearCombination r (R a) -> [(r, R a)]
forall r a. LinearCombination r a -> [(r, a)]
lcs (LinearCombination r (R a) -> [(r, R a)])
-> LinearCombination r (R a) -> [(r, R a)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Sum r (R a) -> LinearCombination r (R a)
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 = [(r, a)] -> PSequence a r
forall i x. [(x, i)] -> PSequence i x
PSequence ([(r, a)] -> PSequence a r) -> [(r, a)] -> PSequence a r
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ LinearCombination r a -> [(r, a)]
forall r a. LinearCombination r a -> [(r, a)]
lcs (LinearCombination r a -> [(r, a)])
-> LinearCombination r a -> [(r, a)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ SumSymbol r a -> LinearCombination r a
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 = [(r, a)] -> String
forall {a} {a}.
(Distributive a, Total a, Show a) =>
[(a, a)] -> String
shws ([(r, a)] -> String) -> [(r, a)] -> String
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ LinearCombination r a -> [(r, a)]
forall r a. LinearCombination r a -> [(r, a)]
lcs (LinearCombination r a -> [(r, a)])
-> LinearCombination r a -> [(r, a)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ SumSymbol r a -> LinearCombination r a
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 = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
tween String
"+" ([String] -> [String]) -> [String] -> [String]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((a, a) -> String) -> [(a, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> String
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall r. Semiring r => r
rOne = a -> String
forall a. Show a => a -> String
show a
a
            | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
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[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SumSymbol r a -> String
forall r a. (Semiring r, Show a) => SumSymbol r a -> String
ssyShow SumSymbol r a
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

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

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

type instance Root (SumSymbol r a) = ()

instance ShowRoot (SumSymbol r a)
instance EqRoot (SumSymbol r a)
instance ValidableRoot (SumSymbol r a)
instance TypeableRoot (SumSymbol r a)

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

--------------------------------------------------------------------------------
-- Canonical -

instance (Entity a, Ord a, Semiring r, Commutative r) => Projectible (SumSymbol r a) [a] where
  prj :: [a] -> SumSymbol r a
prj = Sum r (R a) -> SumSymbol r a
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (Sum r (R a) -> SumSymbol r a)
-> ([a] -> Sum r (R a)) -> [a] -> SumSymbol r a
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Sheaf (R a) -> Sum r (R a)
forall a b. Projectible a b => b -> a
prj (Sheaf (R a) -> Sum r (R a))
-> ([a] -> Sheaf (R a)) -> [a] -> Sum r (R a)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Root (R a) -> [R a] -> Sheaf (R a)
forall f. Root f -> [f] -> Sheaf f
Sheaf () ([R a] -> Sheaf (R a)) -> ([a] -> [R a]) -> [a] -> Sheaf (R a)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. (a -> R a) -> [a] -> [R a]
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 a -> R a
forall x. x -> R x
R

instance (Entity a, Ord a, Semiring r, Commutative r)
  => Projectible (SumSymbol r a) (LinearCombination r a) where
  prj :: LinearCombination r a -> SumSymbol r a
prj = Sum r (R a) -> SumSymbol r a
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (Sum r (R a) -> SumSymbol r a)
-> (LinearCombination r a -> Sum r (R a))
-> LinearCombination r a
-> SumSymbol r a
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Form (Sum r (R a)) -> Sum r (R a)
SumForm r (R a) -> Sum r (R a)
forall x. Constructable x => Form x -> x
make (SumForm r (R a) -> Sum r (R a))
-> (LinearCombination r a -> SumForm r (R a))
-> LinearCombination r a
-> Sum r (R a)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. ((r, a) -> SumForm r (R a) -> SumForm r (R a))
-> SumForm r (R a) -> [(r, a)] -> SumForm r (R a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (r, a) -> SumForm r (R a) -> SumForm r (R a)
forall {r} {x}. (r, x) -> SumForm r (R x) -> SumForm r (R x)
(+!) (Root (R a) -> SumForm r (R a)
forall r a. Root a -> SumForm r a
Zero ()) ([(r, a)] -> SumForm r (R a))
-> (LinearCombination r a -> [(r, a)])
-> LinearCombination r a
-> SumForm r (R a)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. LinearCombination r a -> [(r, a)]
forall r a. LinearCombination r a -> [(r, a)]
lcs where (r
x,x
a) +! :: (r, x) -> SumForm r (R x) -> SumForm r (R x)
+! SumForm r (R x)
b = r
x r -> SumForm r (R x) -> SumForm r (R x)
forall r a. r -> SumForm r a -> SumForm r a
:! R x -> SumForm r (R x)
forall r a. a -> SumForm r a
S (x -> R x
forall x. x -> R x
R x
a) SumForm r (R x) -> SumForm r (R x) -> SumForm r (R x)
forall r a. SumForm r a -> SumForm r a -> SumForm r a
:+ SumForm r (R x)
b

instance (Entity a, Ord a, Semiring r, Commutative r)
  => Projectible (SumSymbol r a) (LinearCombination r (SumSymbol r a)) where
  prj :: LinearCombination r (SumSymbol r a) -> SumSymbol r a
prj LinearCombination r (SumSymbol r a)
xs = Sum r (R a) -> SumSymbol r a
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol
         (Sum r (R a) -> SumSymbol r a) -> Sum r (R a) -> SumSymbol r a
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Sum r (R a)) -> Sum r (R a)
SumForm r (R a) -> Sum r (R a)
forall x. Constructable x => Form x -> x
make
         (SumForm r (R a) -> Sum r (R a)) -> SumForm r (R a) -> Sum r (R a)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ SumForm r (SumForm r (R a)) -> SumForm r (R a)
forall r a. SumForm r (SumForm r a) -> SumForm r a
smfJoin
         (SumForm r (SumForm r (R a)) -> SumForm r (R a))
-> SumForm r (SumForm r (R a)) -> SumForm r (R a)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Root (SumForm r (R a))
-> LinearCombination r (SumForm r (R a))
-> SumForm r (SumForm r (R a))
forall r a.
Semiring r =>
Root a -> LinearCombination r a -> SumForm r a
lcsmf ()
         (LinearCombination r (SumForm r (R a))
 -> SumForm r (SumForm r (R a)))
-> LinearCombination r (SumForm r (R a))
-> SumForm r (SumForm r (R a))
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (SumSymbol r a -> SumForm r (R a))
-> LinearCombination r (SumSymbol r a)
-> LinearCombination r (SumForm r (R a))
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 (\(SumSymbol Sum r (R a)
s) -> Sum r (R a) -> Form (Sum r (R a))
forall x. Exposable x => x -> Form x
form Sum r (R a)
s) LinearCombination r (SumSymbol r a)
xs
    
--------------------------------------------------------------------------------
-- 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 = LinearCombination r a -> SumSymbol r a
forall a b. Projectible a b => b -> a
prj (LinearCombination r a -> SumSymbol r a)
-> ([(r, a)] -> LinearCombination r a) -> [(r, a)] -> SumSymbol r a
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. [(r, a)] -> LinearCombination r a
forall r a. [(r, a)] -> LinearCombination r a
LinearCombination

--------------------------------------------------------------------------------
-- 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 = [(r, a)] -> SumSymbol r a
forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
[(r, a)] -> SumSymbol r a
sumSymbol [(r
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) = Sum r (R y) -> SumSymbol r y
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol ((R x -> R y) -> Sum r (R x) -> Sum r (R y)
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) = y -> R y
forall x. x -> R x
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) = Sum r (R y) -> SumSymbol r y
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (Sum r (R y) -> SumSymbol r y) -> Sum r (R y) -> SumSymbol r y
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Sum r (R y)) -> Sum r (R y)
SumForm r (R y) -> Sum r (R y)
forall x. Constructable x => Form x -> x
make (SumForm r (R y) -> Sum r (R y)) -> SumForm r (R y) -> Sum r (R y)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ SumForm r (SumForm r (R y)) -> SumForm r (R y)
forall r a. SumForm r (SumForm r a) -> SumForm r a
smfJoin (SumForm r (SumForm r (R y)) -> SumForm r (R y))
-> SumForm r (SumForm r (R y)) -> SumForm r (R y)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (R x -> SumForm r (R y))
-> SumForm r (R x) -> SumForm r (SumForm r (R y))
forall y x r.
Singleton (Root y) =>
(x -> y) -> SumForm r x -> SumForm r y
smfMap ((x -> LinearCombination r y) -> R x -> SumForm r (R y)
forall r x y.
Semiring r =>
(x -> LinearCombination r y) -> R x -> SumForm r (R y)
f' x -> LinearCombination r y
f) (SumForm r (R x) -> SumForm r (SumForm r (R y)))
-> SumForm r (R x) -> SumForm r (SumForm r (R y))
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Sum r (R x) -> Form (Sum r (R x))
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) = Root (R y) -> LinearCombination r (R y) -> SumForm r (R y)
forall r a.
Semiring r =>
Root a -> LinearCombination r a -> SumForm r a
lcsmf () (LinearCombination r (R y) -> SumForm r (R y))
-> LinearCombination r (R y) -> SumForm r (R y)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ [(r, R y)] -> LinearCombination r (R y)
forall r a. [(r, a)] -> LinearCombination r a
LinearCombination ([(r, R y)] -> LinearCombination r (R y))
-> [(r, R y)] -> LinearCombination r (R y)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((r, y) -> (r, R y)) -> [(r, y)] -> [(r, R y)]
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 (\(r
r,y
y) -> (r
r,y -> R y
forall x. x -> R x
R y
y)) ([(r, y)] -> [(r, R y)]) -> [(r, y)] -> [(r, R y)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ LinearCombination r y -> [(r, y)]
forall r a. LinearCombination r a -> [(r, a)]
lcs (LinearCombination r y -> [(r, y)])
-> LinearCombination r y -> [(r, y)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ 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) = Sum r (R x) -> SumSymbol r x
forall r a. Sum r (R a) -> SumSymbol r a
SumSymbol (Sum r (R x) -> SumSymbol r x) -> Sum r (R x) -> SumSymbol r x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Sum r (R x)) -> Sum r (R x)
SumForm r (R x) -> Sum r (R x)
forall x. Constructable x => Form x -> x
make (SumForm r (R x) -> Sum r (R x)) -> SumForm r (R x) -> Sum r (R x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ SumForm r (SumForm r (R x)) -> SumForm r (R x)
forall r a. SumForm r (SumForm r a) -> SumForm r a
smfJoin (SumForm r (SumForm r (R x)) -> SumForm r (R x))
-> SumForm r (SumForm r (R x)) -> SumForm r (R x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (R (SumSymbol r x) -> SumForm r (R x))
-> SumForm r (R (SumSymbol r x)) -> SumForm r (SumForm r (R x))
forall y x r.
Singleton (Root y) =>
(x -> y) -> SumForm r x -> SumForm r y
smfMap R (SumSymbol r x) -> SumForm r (R x)
forall r x. R (SumSymbol r x) -> SumForm r (R x)
f (SumForm r (R (SumSymbol r x)) -> SumForm r (SumForm r (R x)))
-> SumForm r (R (SumSymbol r x)) -> SumForm r (SumForm r (R x))
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Sum r (R (SumSymbol r x)) -> Form (Sum r (R (SumSymbol r x)))
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)) = Sum r (R x) -> Form (Sum r (R x))
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 = [(r, a)] -> SumSymbol r a
forall r a.
(Semiring r, Commutative r, Entity a, Ord a) =>
[(r, a)] -> SumSymbol r a
sumSymbol ([(r, a)] -> SumSymbol r a) -> [(r, a)] -> SumSymbol r a
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ PSequence a r -> [(r, a)]
forall i x. PSequence i x -> [(x, i)]
psqxs (PSequence a r -> [(r, a)]) -> PSequence a r -> [(r, a)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (r -> r -> r)
-> (r -> r)
-> (r -> r)
-> PSequence a r
-> PSequence a r
-> PSequence a r
forall i x y z.
Ord i =>
(x -> y -> z)
-> (x -> z)
-> (y -> z)
-> PSequence i x
-> PSequence i y
-> PSequence i z
psqInterlace r -> r -> r
forall c. Multiplicative c => c -> c -> c
(*) (r -> r -> r
forall b a. b -> a -> b
const r
forall r. Semiring r => r
rZero) (r -> r -> r
forall b a. b -> a -> b
const r
forall r. Semiring r => r
rZero) PSequence a r
xs' (SumSymbol r a -> PSequence a r
forall r a. Semiring r => SumSymbol r a -> PSequence a r
ssypsq SumSymbol r a
x)
  where xs' :: PSequence a r
xs' = [(r, a)] -> PSequence a r
forall i x. [(x, i)] -> PSequence i x
PSequence (r -> [r]
forall a. a -> [a]
repeat r
forall r. Semiring r => r
rOne [r] -> [a] -> [(r, a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Set a -> [a]
forall x. Set x -> [x]
setxs Set a
xs )