diff --git a/Data/Profunctor/Costrong.idr b/Data/Profunctor/Costrong.idr index ca5d3b0..24800dd 100644 --- a/Data/Profunctor/Costrong.idr +++ b/Data/Profunctor/Costrong.idr @@ -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 diff --git a/Data/Profunctor/Strong.idr b/Data/Profunctor/Strong.idr index fe72699..4197968 100644 --- a/Data/Profunctor/Strong.idr +++ b/Data/Profunctor/Strong.idr @@ -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 diff --git a/Data/Tensor.idr b/Data/Tensor.idr index 7e8ee20..65e3cb9 100644 --- a/Data/Tensor.idr +++ b/Data/Tensor.idr @@ -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