[Haskell-cafe] inv f g = f . g . f

Nikita Danilenko nda at informatik.uni-kiel.de
Mon Aug 19 10:01:55 CEST 2013


Hi,

as for the nomenclature - mathematically the pattern

f^{-1} . g . f

is sometimes called "conjugation" [1]. One (trivial) type of occurrence is

data Foo a = Foo { unFoo :: a }
deriving Show

instance Functor Foo where

fmap f = Foo . f . unFoo

The under function from the lens library [2] allows expressing this as
follows:

instance Functor Foo where

fmap = under (iso Foo unFoo)

which is a very elegant way of capturing the essence of the pattern.

Best regards,

Nikita

[1] http://en.wikipedia.org/wiki/Conjugacy_class
[2]
http://hackage.haskell.org/packages/archive/lens/3.9.0.2/doc/html/Control-Lens-Iso.html#v:under

On 17/08/13 22:57, Dan Burton wrote:
> The lens docs even have an example of another helper function,
> "involuted" for functions which are their own inverse.
>
> >>> "live" & involuted reverse %~ ('d':)
> "lived"
>
> inv f g = involuted f %~ g
>
> http://hackage.haskell.org/packages/archive/lens/3.9.0.2/doc/html/Control-Lens-Iso.html#v:involuted
>
> -- Dan Burton
>
>
> On Sat, Aug 17, 2013 at 1:43 PM, Dan Burton <danburton.email at gmail.com
> <mailto:danburton.email at gmail.com>> wrote:
>
>     This is indeed a job for lens, particularly, the Iso type, and the
>     "under" function. Lens conveniently comes with a typeclassed
>     isomorphism called "reversed", which of course has a list instance.
>
>     >>> under reversed (take 10) ['a'.. 'z']
>     "qrstuvwxyz"
>
>     -- Dan Burton
>
>     On Aug 17, 2013 10:23 AM, "Anton Nikishaev" <me at lelf.lu
>     <mailto:me at lelf.lu>> wrote:
>
>         Christopher Done <chrisdone at gmail.com
>         <mailto:chrisdone at gmail.com>> writes:
>
>         > Anyone ever needed this? Me and John Wiegley were discussing
>         a decent
>         > name for it, John suggested inv as in involution. E.g.
>         >
>         > inv reverse (take 10)
>         > inv reverse (dropWhile isDigit)
>         > trim = inv reverse (dropWhile isSpace) . dropWhile isSpace
>         >
>         > That seems to be the only use-case I've ever come across.
>
>         And it's here only because reverse^-1 ≡ reverse, is not it?
>         I only can see how f ∘ g ∘ f^-1 can be a pattern.
>
>         > There's also this one:
>         >
>         > co f g = f g . g
>         >
>         > which means you can write
>         >
>         > trim = co (inv reverse) (dropWhile isSpace)
>         >
>         > but that's optimizing an ever rarer use-case.
>
>
>         --
>         lelf
>
>
>
>         _______________________________________________
>         Haskell-Cafe mailing list
>         Haskell-Cafe at haskell.org <mailto:Haskell-Cafe at haskell.org>
>         http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe


-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 899 bytes
Desc: OpenPGP digital signature
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130819/f3079cff/attachment.pgp>


More information about the Haskell-Cafe mailing list