Add assocl and assocr functions to Data.Tensor

This commit is contained in:
Kiana Sheibani 2023-03-07 22:21:54 -05:00
parent 5a35b099c1
commit be4985714d
Signed by: toki
GPG key ID: 6CB106C25E86A9F7
3 changed files with 30 additions and 25 deletions

View file

@ -33,7 +33,7 @@ import Data.Profunctor.Types
||| * `costrongl = costrongr . dimap swap swap`
||| * `costrongl . dimap unitr.rightToLeft unitr.leftToRight = id`
||| * `costrongl . lmap (mapSnd f) = costrongl . rmap (mapSnd f)`
||| * `costrongr . costrongr = costrongr . dimap assoc.leftToRight assoc.rightToLeft`
||| * `costrongr . costrongr = costrongr . dimap assocl assocr`
|||
||| @ ten The tensor product of the monoidal structure
public export

View file

@ -30,7 +30,7 @@ import Data.Profunctor.Types
||| * `strongl = dimap swap swap . strongr`
||| * `dimap unitr.rightToLeft unitr.leftToRight . strongl = id`
||| * `lmap (mapSnd f) . strongl = rmap (mapSnd f) . strongl`
||| * `strongr . strongr = dimap assoc.rightToLeft assoc.leftToRight . strongr`
||| * `strongr . strongr = dimap assocr assocl . strongr`
|||
||| @ ten The tensor product of the monoidal structure
public export
@ -156,13 +156,13 @@ ProfunctorFunctor (GenTambara ten) where
export
Tensor ten i => ProfunctorComonad (GenTambara ten) where
proextract (MkTambara p) = dimap unitr.rightToLeft unitr.leftToRight p
produplicate (MkTambara p) = MkTambara $ MkTambara $ dimap assoc.rightToLeft assoc.leftToRight p
produplicate (MkTambara p) = MkTambara $ MkTambara $ dimap assocr assocl p
export
Associative ten => Symmetric ten => Profunctor p => GenStrong ten (GenTambara ten p) where
strongl (MkTambara p) = MkTambara $ dimap assoc.rightToLeft assoc.leftToRight p
strongr (MkTambara p) = MkTambara $ dimap (assoc.rightToLeft . mapFst swap)
(mapFst swap . assoc.leftToRight) p
strongl (MkTambara p) = MkTambara $ dimap assocr assocl p
strongr (MkTambara p) = MkTambara $ dimap (assocr . mapFst swap)
(mapFst swap . assocl) p
export
Bifunctor ten => Profunctor p => Functor (GenTambara ten p a) where
@ -223,10 +223,10 @@ export
projoin (MkPastro {x=x',y=y',z=z'} l' (MkPastro {x,y,z} l m r) r') = MkPastro ll m rr
where
ll : y `ten` (z' `ten` z) -> b
ll = l' . mapFst l . assoc.leftToRight . mapSnd swap
ll = l' . mapFst l . assocl . mapSnd swap
rr : a -> x `ten` (z' `ten` z)
rr = mapSnd swap . assoc.rightToLeft . mapFst r . r'
rr = mapSnd swap . assocr . mapFst r . r'
export
ProfunctorAdjunction (GenPastro ten) (GenTambara ten) where
@ -238,15 +238,15 @@ export
strongl (MkPastro {x,y,z} l m r) = MkPastro l' m r'
where
l' : y `ten` (z `ten` c) -> b `ten` c
l' = mapFst l . assoc.leftToRight
l' = mapFst l . assocl
r' : a `ten` c -> x `ten` (z `ten` c)
r' = assoc.rightToLeft . mapFst r
r' = assocr . mapFst r
strongr (MkPastro {x,y,z} l m r) = MkPastro l' m r'
where
l' : y `ten` (c `ten` z) -> c `ten` b
l' = swap . mapFst l . assoc.leftToRight . mapSnd swap
l' = swap . mapFst l . assocl . mapSnd swap
r' : c `ten` a -> x `ten` (c `ten` z)
r' = mapSnd swap . assoc.rightToLeft . mapFst r . swap
r' = mapSnd swap . assocr . mapFst r . swap
||| The monad generated by the reflective subcategory of profunctors that