Add assocl
and assocr
functions to Data.Tensor
This commit is contained in:
parent
5a35b099c1
commit
be4985714d
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -15,10 +15,18 @@ module Data.Tensor
|
|||
||| associative up to isomorphism.
|
||||
|||
|
||||
||| Laws:
|
||||
||| * `mapFst assoc.rightToLeft . assoc.leftToRight . assoc.leftToRight = assoc.leftToRight . mapSnd assoc.leftToRight`
|
||||
||| * `mapFst assocl . assocl . assocl = assocl . mapSnd assocl`
|
||||
public export
|
||||
interface Bifunctor ten => Associative ten where
|
||||
assocl : a `ten` (b `ten` c) -> (a `ten` b) `ten` c
|
||||
assocl = assoc.leftToRight
|
||||
|
||||
assocr : (a `ten` b) `ten` c -> a `ten` (b `ten` c)
|
||||
assocr = assoc.rightToLeft
|
||||
|
||||
assoc : a `ten` (b `ten` c) <=> (a `ten` b) `ten` c
|
||||
assoc = MkEquivalence assocl assocr
|
||||
|
||||
|
||||
||| A bifunctor that admits a swap map, i.e. a bifunctor that is
|
||||
||| symmetric up to isomorphism.
|
||||
|
@ -38,7 +46,7 @@ interface Bifunctor ten => Symmetric ten where
|
|||
||| monoidal category.
|
||||
|||
|
||||
||| Laws:
|
||||
||| * `mapSnd unitl.leftToRight = mapFst unitr.leftToRight . assoc.leftToRight`
|
||||
||| * `mapSnd unitl.leftToRight = mapFst unitr.leftToRight . assocl`
|
||||
public export
|
||||
interface Associative ten => Tensor ten i | ten where
|
||||
unitl : i `ten` a <=> a
|
||||
|
@ -52,7 +60,8 @@ interface Associative ten => Tensor ten i | ten where
|
|||
|
||||
export
|
||||
Associative Pair where
|
||||
assoc = MkEquivalence (\(x,(y,z)) => ((x,y),z)) (\((x,y),z) => (x,(y,z)))
|
||||
assocl (x,(y,z)) = ((x,y),z)
|
||||
assocr ((x,y),z) = (x,(y,z))
|
||||
|
||||
export
|
||||
Symmetric Pair where
|
||||
|
@ -71,17 +80,13 @@ Tensor Pair () where
|
|||
|
||||
export
|
||||
Associative Either where
|
||||
assoc = MkEquivalence f b
|
||||
where
|
||||
f : forall a,b,c. Either a (Either b c) -> Either (Either a b) c
|
||||
f (Left x) = Left (Left x)
|
||||
f (Right (Left x)) = Left (Right x)
|
||||
f (Right (Right x)) = Right x
|
||||
assocl (Left x) = Left (Left x)
|
||||
assocl (Right (Left x)) = Left (Right x)
|
||||
assocl (Right (Right x)) = Right x
|
||||
|
||||
b : forall a,b,c. Either (Either a b) c -> Either a (Either b c)
|
||||
b (Left (Left x)) = Left x
|
||||
b (Left (Right x)) = Right (Left x)
|
||||
b (Right x) = Right (Right x)
|
||||
assocr (Left (Left x)) = Left x
|
||||
assocr (Left (Right x)) = Right (Left x)
|
||||
assocr (Right x) = Right (Right x)
|
||||
|
||||
export
|
||||
Symmetric Either where
|
||||
|
|
Loading…
Reference in a new issue