Why monoids will abide...

http://apfelmus.nfshost.com/monoid-fingertree.html Thanks Apfelmus for this inspiring contribution!

2009/1/21 Don Stewart
http://apfelmus.nfshost.com/monoid-fingertree.html
Thanks Apfelmus for this inspiring contribution! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
And for an introduction : http://sigfpe.blogspot.com/2009/01/haskell-monoids-and-their-uses.html

Another important application of monoids is in parallelisation. In
map-reduce you want to split the reduce part over multiple processors
and combine the results back together again. Associativity ensures
that when you combine the pieces together you get the same result as
if you did the whole operation on one processor.
Eg. we can rewrite
(((a `mappend` b) `mappend` c) `mappend` d
as
(a `mappend` b) `mappend` (c `mappend` d)
and compute (a `mappend` b) and (c `mappend` d) on separate
processors. And so on recursively. (The mempty element tells us what
result we should give if we're reducing an empty array.)
For a large class of problems, parallelising the algorithm consists of
teasing out the hidden monoid structure so it can be chopped up in
this way.
--
Dan
On Tue, Jan 20, 2009 at 4:27 PM, Don Stewart
http://apfelmus.nfshost.com/monoid-fingertree.html
Thanks Apfelmus for this inspiring contribution! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

To my mind, in the map-reduce case you generally need a commutative
monoid. Or, you need an extra infrastructure that mappend's only
results from adjacent machines, or something like that.
2009/1/21 Dan Piponi
Another important application of monoids is in parallelisation. In map-reduce you want to split the reduce part over multiple processors and combine the results back together again. Associativity ensures that when you combine the pieces together you get the same result as if you did the whole operation on one processor.
Eg. we can rewrite
(((a `mappend` b) `mappend` c) `mappend` d
as
(a `mappend` b) `mappend` (c `mappend` d)
and compute (a `mappend` b) and (c `mappend` d) on separate processors. And so on recursively. (The mempty element tells us what result we should give if we're reducing an empty array.)
For a large class of problems, parallelising the algorithm consists of teasing out the hidden monoid structure so it can be chopped up in this way. -- Dan
On Tue, Jan 20, 2009 at 4:27 PM, Don Stewart
wrote: http://apfelmus.nfshost.com/monoid-fingertree.html
Thanks Apfelmus for this inspiring contribution! _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Wed, Jan 21, 2009 at 11:12 PM, Eugene Kirpichov
To my mind, in the map-reduce case you generally need a commutative monoid. Or, you need an extra infrastructure that mappend's only results from adjacent machines, or something like that.
This is a good paper on the stuff I'm talking about: http://citeseer.ist.psu.edu/blelloch90prefix.html It doesn't explicitly mention monoids but it's all about associative operations with identity. -- Dan

See, that's the kind of name we need!
StructureWithAssociativeOperationAndIdentity -- make both the mathematicians
AND the non-mathematicians mad!
On Thu, Jan 22, 2009 at 9:53 AM, Dan Piponi
On Wed, Jan 21, 2009 at 11:12 PM, Eugene Kirpichov
wrote: To my mind, in the map-reduce case you generally need a commutative monoid. Or, you need an extra infrastructure that mappend's only results from adjacent machines, or something like that.
This is a good paper on the stuff I'm talking about: http://citeseer.ist.psu.edu/blelloch90prefix.html It doesn't explicitly mention monoids but it's all about associative operations with identity. -- Dan _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On 2009 Jan 22, at 10:09, Andrew Wagner wrote:
See, that's the kind of name we need! StructureWithAssociativeOperationAndIdentity -- make both the mathematicians AND the non-mathematicians mad!
"SimpleArithmetic" (you have "numbers" and a single "arithmetic operation" on them). You can play similar games with the mathematical concepts of groups and rings. (But you get into trouble with magmas and semigroups.) In any case, my response to bikeshedding these days is to present a fait accompli so people can just get stuff done instead of waiting for many-legs-and-no-brain (otherwise known as a committee) to do something. The math terms have at least the advantage of already being well defined. Yes, this means you get to learn some abstract math --- but then, you're going to be faced with that the first time you encounter (or need!) type-level Peano numbers anyway. Or fix/mfix ("least defined fixed point"). -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

On Thu, Jan 22, 2009 at 06:53:24AM -0800, Dan Piponi wrote:
On Wed, Jan 21, 2009 at 11:12 PM, Eugene Kirpichov
wrote: To my mind, in the map-reduce case you generally need a commutative monoid. Or, you need an extra infrastructure that mappend's only results from adjacent machines, or something like that.
This is a good paper on the stuff I'm talking about: http://citeseer.ist.psu.edu/blelloch90prefix.html It doesn't explicitly mention monoids but it's all about associative operations with identity.
Indeed, the parallel scan algorithm over an arbitrary monoid (originally due to Ladner and Fischer) was one of the inspirations for the use of monoids in the fingertree paper.

Thanks; I saw you mention the paper before, but now I finally started
reading it :)
By the way, the paper *does* arrange an extra infrastructure for
mappending only adjacent results.
Looks like with a commutative monoid, a fold could be done in a fully
distributed fashion, however it would no more be a scan.
2009/1/22 Dan Piponi
On Wed, Jan 21, 2009 at 11:12 PM, Eugene Kirpichov
wrote: To my mind, in the map-reduce case you generally need a commutative monoid. Or, you need an extra infrastructure that mappend's only results from adjacent machines, or something like that.
This is a good paper on the stuff I'm talking about: http://citeseer.ist.psu.edu/blelloch90prefix.html It doesn't explicitly mention monoids but it's all about associative operations with identity. -- Dan

On Thu, 22 Jan 2009, Eugene Kirpichov wrote:
To my mind, in the map-reduce case you generally need a commutative monoid. Or, you need an extra infrastructure that mappend's only results from adjacent machines, or something like that.
The paper http://www.cs.vu.nl/~ralf/MapReduce/ analyzes the model of Google's MapReduce and Sawzall. quick haskell summaries at: http://www.thenewsh.com/~newsham/x/machine/MapReduce.hs http://www.thenewsh.com/~newsham/x/machine/Sawzall.hs The MapReduce model isn't based directly on a monoid, but the Sawzall model is. Tim Newsham http://www.thenewsh.com/~newsham/

One wart that was briefly mentioned during the Great Monoid Naming Thread of 2009 is the need to wrap types in newtypes to provide multiple instances of the same class with different semantics -- the archetypical example being Integer as a monoid over addition as well as multiplication. I was just wondering if not phantom types might serve here as an alternative way to go about that. Here's a small example illustrating it: ---------------------------------------- {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} module Monoids where import Data.Monoid data Foo a = Foo Integer deriving (Show, Eq) data Additive data Multiplicative instance Monoid (Foo Additive) where mappend (Foo x) (Foo y) = Foo (x+y) mempty = Foo 0 instance Monoid (Foo Multiplicative) where mappend (Foo x) (Foo y) = Foo (x*y) mempty = Foo 1 instance Num (Foo a) where fromInteger x = Foo x Foo x + Foo y = Foo (x+y) Foo x * Foo y = Foo (x*y) signum (Foo x) = Foo (signum x) ---------------------------------------- Loading this into ghci, you get: *Monoids> mconcat [1,2] <interactive>:1:0: Ambiguous type variable `t' in the constraints: `Monoid t' arising from a use of `mconcat' at <interactive>:1:0-12 `Num t' arising from the literal `2' at <interactive>:1:11 Probable fix: add a type signature that fixes these type variable(s) *Monoids> mconcat [1,2::Foo Additive] Foo 3 *Monoids> mconcat [1,2::Foo Multiplicative] Foo 2 (This can of course be prettified a bit by omitting the constructor from the Show instance). Any thought about this, pro/contra the newtype method? -k -- If I haven't seen further, it is by standing in the footprints of giants

On Thu, 2009-01-22 at 16:11 +0100, Ketil Malde wrote:
One wart that was briefly mentioned during the Great Monoid Naming Thread of 2009 is the need to wrap types in newtypes to provide multiple instances of the same class with different semantics -- the archetypical example being Integer as a monoid over addition as well as multiplication.
I was just wondering if not phantom types might serve here as an alternative way to go about that. Here's a small example illustrating it:
---------------------------------------- {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-}
module Monoids where import Data.Monoid
data Foo a = Foo Integer deriving (Show, Eq)
data Additive data Multiplicative
instance Monoid (Foo Additive) where mappend (Foo x) (Foo y) = Foo (x+y) mempty = Foo 0
instance Monoid (Foo Multiplicative) where mappend (Foo x) (Foo y) = Foo (x*y) mempty = Foo 1
instance Num (Foo a) where fromInteger x = Foo x Foo x + Foo y = Foo (x+y) Foo x * Foo y = Foo (x*y) signum (Foo x) = Foo (signum x) ----------------------------------------
Loading this into ghci, you get: *Monoids> mconcat [1,2]
<interactive>:1:0: Ambiguous type variable `t' in the constraints: `Monoid t' arising from a use of `mconcat' at <interactive>:1:0-12 `Num t' arising from the literal `2' at <interactive>:1:11 Probable fix: add a type signature that fixes these type variable(s) *Monoids> mconcat [1,2::Foo Additive] Foo 3 *Monoids> mconcat [1,2::Foo Multiplicative] Foo 2
(This can of course be prettified a bit by omitting the constructor from the Show instance).
Any thought about this, pro/contra the newtype method?
The old wiki had an excellent page that has not been replicated either verbatim or in spirit in the new wiki. http://web.archive.org/web/20060831090007/http://www.haskell.org/hawiki/Comm... This lists many small tips and tricks that Haskell programmers have discovered/used throughout the years. This particular example is an example of using wrapper types to attach a phantom type as described here: http://web.archive.org/web/20070614230306/http://haskell.org/hawiki/WrapperT...

On Thu, 22 Jan 2009 09:46:19 -0800, Derek Elkins
The old wiki had an excellent page that has not been replicated either verbatim or in spirit in the new wiki. http://web.archive.org/web/20060831090007/http://www.haskell.org/hawiki/Comm...
Thanks, this is really useful. There is a "wikisnapshot" on haskell.org http://haskell.org/wikisnapshot/CommonHaskellIdioms.html which looks like a replication and has more working links than the web.archive.org page. Anish

On Tue, 2009-01-27 at 08:51 -0800, Anish Muttreja wrote:
On Thu, 22 Jan 2009 09:46:19 -0800, Derek Elkins
wrote: The old wiki had an excellent page that has not been replicated either verbatim or in spirit in the new wiki. http://web.archive.org/web/20060831090007/http://www.haskell.org/hawiki/Comm...
Thanks, this is really useful.
There is a "wikisnapshot" on haskell.org http://haskell.org/wikisnapshot/CommonHaskellIdioms.html which looks like a replication and has more working links than the web.archive.org page.
The snapshot is quite a bit older than what is available on archive.org. You should be able to stick the link to any page that doesn't work into archive.org and get a version that does work (i.e. re-search for the page.)

On Thu, Jan 22, 2009 at 10:11 AM, Ketil Malde
I was just wondering if not phantom types might serve here as an alternative way to go about that. Here's a small example illustrating it:
...
*Monoids> mconcat [1,2::Foo Additive] Foo 3 *Monoids> mconcat [1,2::Foo Multiplicative] Foo 2
(This can of course be prettified a bit by omitting the constructor from the Show instance).
Any thought about this, pro/contra the newtype method?
I'm not sure that requiring type annotations is less intrusive than
using a wrapper or an explicit dictionary. But there may be types
where this sort of thing makes sense to do.
My favorite alternative to Monoid uses labeled instances.
data Proxy l -- empty, to ensure that labels are never examined
class LMonoid label where
type Carrier label :: *
unit :: Proxy label -> Carrier label
mult :: Proxy label -> Carrier label -> Carrier label -> Carrier label
data Sum a
sum_ :: Proxy (Sum a)
sum_ = undefined
instance Num a => LMonoid (Sum a) where
type Carrier (Sum a) = a
unit _ = 0
mult _ = (+)
-- this works nicely with the writer monad
data Writer l a = W (Carrier l) a
instance (LMonoid l) => Monad (Writer l) where
return a = W (unit (undefined :: Proxy l)) a
(W o1 a) >>= f = let W o2 b = f a in W (mult (undefined :: Proxy l) o1 o2) b
tell :: Carrier l -> Writer l ()
tell x = W x ()
-- and with Foldable
class Foldable f where
fold :: (LMonoid l) => Proxy l -> f (Carrier l) -> Carrier l
-- e.g., fold sum_ [1,2,3]
-- and it works well with Monoid
data Std a
instance (Monoid a) => LMonoid (Std a) where
unit _ = mempty
mult _ = mappend
newtype WrapL l = WrapL (Carrier l)
instance LMonoid l => Monoid (WrapL l) where
mempty = WrapL (unit (undefined :: Proxy l))
mappend (Wrap x) (Wrap y) = WrapL (mult (undefined::l) x y)
--
Dave Menendez
participants (12)
-
Andrew Wagner
-
Anish Muttreja
-
Brandon S. Allbery KF8NH
-
Dan Piponi
-
David Menendez
-
Derek Elkins
-
Don Stewart
-
Eugene Kirpichov
-
Ketil Malde
-
minh thu
-
Ross Paterson
-
Tim Newsham