Proposal: Add these two handy functions to Data.List

Edward Kmett ekmett at gmail.com
Fri Jul 2 18:05:07 EDT 2010


+1 for the simple versions.

I have a comonads package extracting lightweighter weight versions of some
of the comonads from category-extras that is all but ready to go up on
hackage.

That should get you a reasonably low-cost and standardizable import to draw
a comonad class from for your own work, but I'd like to see it adopted a bit
more before putting it forward as anything like a candidate for anything
platform/base related.

-Edward Kmett

On Fri, Jul 2, 2010 at 2:59 PM, Cale Gibbard <cgibbard at gmail.com> wrote:

> I would love to have the more abstract interface you describe here as
> well, but it's obviously a larger change to the base library. (I'd
> also like to play the bike-shed game with the names 'down' and 'up',
> preferring something more descriptive than that. Perhaps 'separate'
> and 'attach'?)
>
> ----- Note: the following is a bit of a rant. This isn't really the
> right place for it, but...
>
> The obvious place to put the Comonad class is in the Prelude, but it
> seems the Prelude never changes any more, enmeshed between the
> competing nets of implement-first and standardise-first. Putting it in
> Control.Comonad instead wouldn't hurt so much either I suppose.
> Regardless, that situation saddens me, and I wish that as a community
> we could devise a system for making progress on changes we'd all like
> to see on that level (or most of us, anyway). I don't think the
> standardisation process is the right place for it. In my opinion, it
> would be important to try the implementations of these things on a
> fairly large scale  -- say, a sizeable fraction of the scale of
> Hackage -- before committing to put them into a standard.
>
> Python has future imports, and maybe something along those lines could
> help. We already have a *fairly* decent versioning system for
> packages, which includes the base package. What more infrastructure do
> people think we need? Should we have a periodically-shifting fork of
> the entirety of Hackage, where libraries are built against
> future-Haskell vs. contemporary-Haskell, and when a critical mass of
> libraries and users is reached, and a good enough period of time has
> passed, we shift things along, future becoming contemporary and
> contemporary becoming past?
>
> There should be a place where we can really experiment with the
> foundational libraries in a large scale and _usable_ way without so
> much concern for immediately breaking existing code or interfaces.
>
> ----- Okay, enough of that.
>
> Differentiation of datastructures is fairly fundamental, and almost
> certainly does deserve to be in the base library, in my opinion. Many
> of the datastructures provided by other libraries are differentiable,
> and it would be worthwhile to have a common suggested interface to
> that, as well as a motivating force to get people to provide those
> operations.
>
> At the same time as this, I made my little proposal in the hopes that
> it could perhaps get into the libraries quickly (haha, it took *years*
> before Data.List finally got a simple permutations function), and
> provide some happiness in the short-term.
>
>  - Cale
>
> On 2 July 2010 04:59, Conor McBride <conor at strictlypositive.org> wrote:
> > Hi
> >
> > I use these also. But I'd make a suggestion: dig out the rest
> > of the structure that these operations suggest.
> >
> > [Statutory mathematics warning: differential calculus.]
> >
> > They're both instances of "Hancock's cursor-down operator",
> > whose type is
> >
> >  down :: Differentiable f => f x -> f (x, D f x)
> >
> > where Differentiable is the class of differentiable functors
> > and D is the type family which differentiates a functor to
> > get the type of one-hole element-contexts.
> >
> > The intuitive meaning of "down" is "decorate each subobject with
> > its context". When you use such an f as the pattern functor
> > for a recursive type, you collect the ways you can move one
> > level down in a zipper (whose root is at the top, of course).
> >
> > On 2 Jul 2010, at 00:48, Cale Gibbard wrote:
> >
> >> When working with the list monad, I often find myself in need of one
> >> of the two following functions:
> >>
> >> -- | Produce a list of all ways of selecting an element from a list,
> >> each along with the remaining elements in the list.
> >> -- e.g. select [1,2,3,4] ==
> >> [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
> >> -- This is useful for selection without replacement in the list monad
> >> or list comprehensions.
> >> select :: [a] -> [(a,[a])]
> >> select [] = []
> >> select (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- select xs]
> >
> > This is "down" for lists thought of as unordered bags. For sake
> > of argument, make the distinction by wrapping
> >
> >  newtype Bag x = Bag [x]
> >
> > and hurrah! D Bag = Bag. As a power-series Bag x is the same
> > as e-to-the-x, quotienting each possible n-tuple of x's by its
> > n! possible permutations. A Bag has
> >
> >  no elements in 0! possible orders
> >  1  element  in 1! possible orders
> >  2  elements in 2! possible orders
> >  3  elements in 3! possible orders
> >  and so ad infinitum...
> >
> >> -- | Produce a list of all ways of separating a list into an initial
> >> segment, a single element, and a final segment.
> >> -- e.g. separate [1,2,3,4] ==
> >> [([],1,[2,3,4]),([1],2,[3,4]),([1,2],3,[4]),([1,2,3],4,[])]
> >> separate :: [a] -> [([a],a,[a])]
> >> separate [] = []
> >> separate (x:xs) = ([],x,xs) : [(x:us,v,vs) | (us,v,vs) <- separate xs]
> >
> > This is "down" for lists precisely. A one hole context in a list
> > is a pair of lists (the list of elements before the hole, the
> > list of elements after).
> >
> >> It would be really nice if they were in Data.List. The first I find
> >> occurring in my code moreso than the second, though just a moment ago,
> >> the second of these was quite useful to a beginner on #haskell, and it
> >> has come up quite a number of times before for me.
> >
> > Me too: I look for it, now. It does raise wider questions about lists
> > versus bags. If we want to play these games, we should distinguish the
> > types according to the sense in which we use them, then overload the
> > operators which play the same role in each case.
> >
> > To fill in a bit more of the picture, "up" is your regular plugger-
> > inner
> >
> >  up :: Differentiable f => (x, D f x) -> f x
> >
> > and you have laws
> >
> >  fmap fst (down xs) = xs
> >  fmap up (down xs) = fmap (const xs) xs
> >
> > [Statutory mathematics warning: comonads]
> >
> > If we have "up" and "down", what is "sideways"? Well, refactor the
> > bits and pieces for a moment, please.
> >
> >  newtype Id x = Id x   -- Identity is far too long a name for this
> >  newtype (:*:) f g x = f x :*: g x  -- functor pairing
> >  type Div f = Id :*: D f  -- a pair of a thing and its context
> >                           -- being an f with a focus
> >
> >  class (Functor f, ...) => Differentiable f where
> >    type D f x
> >    up    :: Div f x -> f x
> >    down  :: f x -> f (Div f x)
> >
> > and now we need to add the constraint Comonad (Div f) to the class,
> > as we should also have
> >
> >    counit :: Div f x -> x  -- discard context
> >    cojoin :: Div f x -> Div f (Div f x)
> >      -- show how to refocus a focused f by decorating each
> >      -- element (in focus or not) with its context
> >      -- i.e. "sideways"
> >
> > with stuff like
> >
> >   up . cojoin = down . up
> >
> > Folks, if comonads make you boggle, now's yer chance to get a grip
> > of them. They capture notions of things-in-context, and these
> > zippery comonads provide very concrete examples.
> >
> > Cale, your handy functions are another surfacing of the calculus
> > iceberg.
> >
> > The question for library designers is at what level to engage with
> > this structure. In doing so, we should of course take care to
> > protect Joe Programmer from the Screaming Heebie-Jeebies. I am not
> > qualified to judge how best this is to be done, but I thought I
> > might at least offer some of the raw data for that calculation.
> >
> > All the best
> >
> > Conor
> >
> >
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20100702/13dd0657/attachment-0001.html


More information about the Libraries mailing list