darcs patch: Add equating p x y = p x == p y

Wed Oct 11 15:14:32 BST 2006 Duncan Coutts

On Wed, 11 Oct 2006, Duncan Coutts
Wed Oct 11 15:14:32 BST 2006 Duncan Coutts
* Add equating p x y = p x == p y Just as useful as the 'comparing' function from Data.Ord, but for cases where we check equality rather than ordering. Use like: groupBy (equating fst)
Instead of adding 'comparing', 'equating' etc., I suggest that you add the more general 'on', which is just as easy to use. ('on' has been mentioned on the lists a couple of times before.) (*) `on` f = \x y -> f x * f y groupBy ((==) `on` fst) sortBy (compare `on` snd) maximumBy (customCompare `on` f) -- /NAD

On 10/11/06, Nils Anders Danielsson
Instead of adding 'comparing', 'equating' etc., I suggest that you add the more general 'on', which is just as easy to use. ('on' has been mentioned on the lists a couple of times before.)
(*) `on` f = \x y -> f x * f y
groupBy ((==) `on` fst) sortBy (compare `on` snd) maximumBy (customCompare `on` f)
Oh, oops. I meant to send this to the list the *first* time... so, um, where is the patch for this?

"Samuel Bronson"
(*) `on` f = \x y -> f x * f y
groupBy ((==) `on` fst) sortBy (compare `on` snd) maximumBy (customCompare `on` f)
Oh, oops. I meant to send this to the list the *first* time... so, um, where is the patch for this?
The question is where in the module hierarchy should such a function live? It does not really belong with Data.List, or indeed any particular data structure module. I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be const id flip (.) ($) ($!) Any suggestions for a good name for such a module? Data.Function does not sound right to my ears. Regards, Malcolm

Hello Malcolm, Friday, October 20, 2006, 2:34:15 PM, you wrote:
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
some *.Base? at least in GHC, GHC.Base module holds them all -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Bulat Ziganshin
Friday, October 20, 2006, 2:34:15 PM, you wrote:
`on` const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
some *.Base? at least in GHC, GHC.Base module holds them all
But the whole point is that these functions are in *no* way implementation-specific! They are very general, very "basic" indeed, but basic to the language, not a compiler. Regards, Malcolm

Hello Malcolm, Friday, October 20, 2006, 3:20:17 PM, you wrote:
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
some *.Base? at least in GHC, GHC.Base module holds them all
But the whole point is that these functions are in *no* way implementation-specific! They are very general, very "basic" indeed, but basic to the language, not a compiler.
i highlighted the _Base_ part of module name, not the _GHC_ part :) but Combinators looks better, i agree or maybe Data.Function for functions on functions - $, flip, on and appropriate datatype modules for type-specific operations (Data.Tuple for mapFst/mapSnd and so on) -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

On Fri, Oct 20, 2006 at 02:55:01PM +0400, Bulat Ziganshin wrote:
Hello Malcolm,
Friday, October 20, 2006, 2:34:15 PM, you wrote:
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
some *.Base? at least in GHC, GHC.Base module holds them all
they are in Jhc.Basics in jhc. John -- John Meacham - ⑆repetae.net⑆john⑈

On 2006-10-20 at 11:34BST Malcolm Wallace wrote:
I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
Control.Combinators? Such general beasts as mapFst, mapSnd and >< from Data.Graph.Inductive.Query.Monad could go in there, as could other pair handling combinators like (f <&> g) x = (f x, g x) They don't do much in the way of contolling flow, so one might argue that they should just be Combinators. Jón -- Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk

Jon Fairbairn
Control.Combinators? Such general beasts as mapFst, mapSnd and >< from Data.Graph.Inductive.Query.Monad could go in there, as could other pair handling combinators like (f <&> g) x = (f x, g x)
Pairs are a data structure. I would be inclined to place mapFst, mapSnd, curry, and uncurry in a separate module, probably Data.Pair or Data.Tuple. Regards, Malcolm

On 2006-10-20 at 12:22BST Malcolm Wallace wrote:
Jon Fairbairn
wrote: Control.Combinators? Such general beasts as mapFst, mapSnd and >< from Data.Graph.Inductive.Query.Monad could go in there, as could other pair handling combinators like (f <&> g) x = (f x, g x)
Pairs are a data structure.
Whoops, so they are. There I was thinking they were just (forall r. (a -> b -> r) -> r) ;-) Still, the other ones (const, id, flip, $) /are/ (pure) combinators, so why not call them that? -- Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk

Control.Combinators? Such general beasts as mapFst, mapSnd and >< from Data.Graph.Inductive.Query.Monad could go in there, as could other pair handling combinators like (f <&> g) x = (f x, g x)
Pair handling combinators could go into Data.Tuple. I append what I currently have. (This is a typical instance of the kind of module where the code is (at least an essential part of) the documentation. Can Haddock be told to include the code in the documentation? ) Wolfram --------------------------------------------------------------- \section{Tuple Utilities} \begin{code} module Data.Utils.Tuple where \end{code} \begin{code} swap (x,y) = (y,x) \end{code} \begin{code} pupd f g (x,y) = (f x, g y) mapPair f (x,y) = (f x, f y) mapTriple f (x,y,z) = (f x, f y, f z) pupd1 f (x,y) = (f x, y) pupd2 g (x,y) = (x, g y) {-# INLINE pupd #-} {-# INLINE pupd1 #-} {-# INLINE pupd2 #-} \end{code} \begin{code} keep1 f p@(x,y) = (x, f p) keep2 f p@(x,y) = (f p, y) \end{code}

Wolfram wrote: | > | > Control.Combinators? Such general beasts as mapFst, mapSnd | > and >< from Data.Graph.Inductive.Query.Monad could go in | > there, as could other pair handling combinators like (f <&> | > g) x = (f x, g x) | | Pair handling combinators could go into Data.Tuple. Many of those combinators can be expressed conveniently using functions from Control.Arrow. | > swap (x,y) = (y,x)
swap = flip (,) :p
| > pupd f g (x,y) = (f x, g y)
pupd = (***)
| > mapPair f (x,y) = (f x, f y)
mapPair = join (***)
| > mapTriple f (x,y,z) = (f x, f y, f z) Not this one. I sometimes use nested pairs instead of triples to allow use of the basic arrow combinators. | > pupd1 f (x,y) = (f x, y)
pupd1 = first
| > pupd2 g (x,y) = (x, g y)
pupd2 = second
| > keep1 f p@(x,y) = (x, f p)
keep1 = (fst &&&)
| > keep2 f p@(x,y) = (f p, y)
keep2 = (&&& snd)
I'm not opposing introduction of these special tuple combinators, but it may be good to reuse existing code. Regards, Arie

On Fri, 20 Oct 2006, Malcolm Wallace wrote:
The question is where in the module hierarchy should such a function live? It does not really belong with Data.List, or indeed any particular data structure module.
I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
I also like a special module for that. Why not Data.Function?

I agree that Data.Function is appropriate. The Data.Foo modules seem to follow a common pattern of a value type + some special values (eg: empty) and functions to operate on them. const and id are the "special values" and the remaining combinators are functions on that type, namely functions. I think the name Data.Function also helps underscore that these functions treat their argument functions more or less as data. Henning Thielemann wrote:
On Fri, 20 Oct 2006, Malcolm Wallace wrote:
The question is where in the module hierarchy should such a function live? It does not really belong with Data.List, or indeed any particular data structure module.
I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
I also like a special module for that. Why not Data.Function? _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
It does sound right to my ears, and I thought of it before I read to the last paragraph. In my lectures, I use the example of shows versus show to demonstrate that functions can be a more efficient datatype than more conventional datatypes like lists... Wolfram

Malcolm Wallace wrote:
I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
Clearly, they should all go in a module called Util. Or possibly GeneralUtilities ;-) Seriously, currently they are all provided by Prelude, and lacking an obvious separate place to put them, I think Prelude is just fine. The reasons to put them somewhere else would be if the list grew longer and/or there were some that we didn't want in scope by default; but I don't see either of these being the case soon. Cheers, Simon

Simon Marlow
I would like to propose a new module for functions like this, which are in some sense "purely" functional, that is, they do not involve any data structure at all, just functions. Other examples would be
const id flip (.) ($) ($!)
Any suggestions for a good name for such a module? Data.Function does not sound right to my ears.
Seriously, currently they are all provided by Prelude, and lacking an obvious separate place to put them, I think Prelude is just fine.
Yes! That is the answer I wanted. In fact, my proposal for Haskell' is that these are the _only_ things that should be in the Prelude. This is a very minimalist approach, but I believe everything else currently in Prelude can be more readily given a home in some separate library module named after its main data structure. Of course, some aggregation of small utility functions back into a single larger collection would be useful to most people, probably something like import Std.Haskell but the idea would be that the Prelude only gives you the basics, on top of which everything else is built. You should be able to replace the Std.Haskell with some alternative of your own choosing. Regards, Malcolm
participants (13)
-
Arie Peterson
-
Bulat Ziganshin
-
Duncan Coutts
-
Henning Thielemann
-
John Meacham
-
Jon Fairbairn
-
kahl@cas.mcmaster.ca
-
Malcolm Wallace
-
Matthew Cox
-
Nils Anders Danielsson
-
Samuel Bronson
-
Simon Marlow
-
Stefan Holdermans