Reputation: 19505
Who first said the following?
A monad is just a monoid in the category of endofunctors, what's the problem?
And on a less important note, is this true and if so could you give an explanation (hopefully one that can be understood by someone who doesn't have much Haskell experience)?
Upvotes: 952
Views: 262047
Reputation: 3985
Here is another take with an explicit example using the monad IO
.
Monad
is not a Monoid
!In the Haskell documentation for Monoid
above, you can see the source code reads
class Semigroup a => Monoid a where
⟨additional conditions⟩
In English: "Define Monoid
to be a typeclass: a type a
is a Monoid
if it is a Semigroup
and ⟨additional conditions⟩".
You don't quite see the same thing in Monad
. Because a Monad
is not a Haskell monoid.
Why? The word "monoid" has 2 meanings:
S
equipped with ●: S × S → S
and e ∈ S
,The typeclass Monoid
in Haskell is a monoid in the abstract algebra sense.
In particular,
IO
certainly don't contain anything like ℕ
does.)+
takes in two integers and return one, but join
does not take in two anything --- there isn't anything inside IO
to take!)Monad
The relationship between the different concepts:
A monoid in abstract algebra is a monoid (category theory) in the category of sets.
This is an equivalence --- a monoid in the category of sets is a monoid in abstract algebra.
A monad is a monoid (category theory) in the category of endofunctors.
This is also an equivalence.
A Monad
in Haskell is a monad. For example, IO
is a monad.
This is not an equivalence! Not all monads are Haskell monads.
For clarification, there's an abuse of terminology here. When we say
ℤ
is a ring
we actually means
(ℤ, +, 0, ×, 1)
is a ring
Of course, which operators are being used are often implicit.
Similarly, when we say
ℕ
is a monoid
we means
(ℕ, +, 0)
is a monoid.
On the other hand, (ℕ, ×, 1)
is also a monoid.
When we say
X
is a monoid in the categoryY
there is similarly an abuse of notation here. It actually means
(X, μ, η)
is a monoid in the category(Y, *, e)
or
X
is an object in the categoryY
, and(X, μ, η)
satisfies the monoid axioms
or, shorter,
X
is a monoidal object in the categoryY
with respect to(μ, η, *, e)
.
(I'll use η (eta) here. Some other answers use ν (nu).)
Consider the example of ℕ
above. We wants to say
(ℕ, +, ⟨• → 0⟩)
is a monoid in the category(Sets, ×, {•})
.
You can check the types of things:
ℕ
is an object in the category of sets.+
is a morphism of sets from ℕ × ℕ
to ℕ
.⟨• → 0⟩
is a morphism of sets from the singleton set {•}
to ℕ
, that sends the only element •
to 0
.×
is a Sets2 → Sets
functor, ℕ × ℕ
is an object in Sets
,{•}
is a singleton set in the category Sets
.The Hask
category is the category where
String
, Integer
, etc.),(+ 1) :: Integer -> Integer
, read :: String -> Integer
).For any two categories A
and B
, we have the category of functors, here denoted Fun(A, B)
where
A
and B
,(If you don't know what a functor and a natural transformations are, read up on them.)
Specifically, if A = B
, then the category Fun(A, A)
is the category of endofunctors of A
.
Piecing these together,
A Haskell
Monad
is a monoid (category theory) in the monoidal category(Fun(Hask, Hask), Compose, Identity)
.
Here,
Compose
is a Fun(Hask, Hask)2 → Fun(Hask, Hask)
functor, Compose IO IO
is the endofunctor that sends String
to IO (IO String)
,Identity
is an object in the category Fun(Hask, Hask)
, Identity String
is equal to String
.
IO
is a HaskellMonad
which means:
IO
is an object in the category Fun(Hask, Hask)
:
from each object in the category Hask
, IO
sends it to another object.
e.g. from String
, you get IO String
. (Note that String
is a type, but in the category Hask
it is an object.)
from each morphism in the category Hask
, IO
sends it to another morphism.
e.g. from read :: String -> Integer
, it gets mapped to fmap read :: IO String -> IO Integer
.
return
is a morphism in the category Fun(Hask, Hask)
.
join
is a morphism in the category Fun(Hask, Hask)
.
That is, it is a natural transformation from the functor Compose IO IO
to the functor IO
.
(What is the functor Compose IO IO
? It just takes in e.g. String
and returns IO (IO String)
).
((IO, fmap), join, return)
satisfies the monoidal axioms.
Indeed, there are two equivalent ways to define a monad.
(IO, bind, return)
--- where bind
is written as >>=
.(IO, fmap, join, return)
.They're interchangeable:
bind
can be implemented with fmap
and join
as follows:
-- a :: IO x e.g. getLine :: IO String
-- f :: x -> IO y e.g. putStrLn :: String -> IO ()
-- bind a f :: IO y e.g. getLine >>= putStrLn :: IO ()
bind a f = join (fmap f a)
join
and fmap
can be implemented with bind
as follows:
-- x :: IO (IO y) e.g. fmap putStrLn getLine :: IO (IO String)
-- join x :: IO y
join x = x >>= (\ioY -> ioY)
-- f :: a -> b
-- fmap f :: IO a -> IO b
fmap f ioA = ioA >>= (return . f)
Or in Haskell syntactic sugar (the do
notation desugar to return
and bind
):
join x = do
ioY <- x -- ioY :: IO ()
-- if you call `join (fmap putStrLn getLine)`
-- then `ioY` has the value `putStrLn "⟨the input⟩"` here
result <- ioY
return result
fmap f ioA = do
x <- ioA -- x :: a
y = f x -- y :: ioB
return y
which can be shortened to
join x = do
ioY <- x
ioY
fmap f ioA = do
x <- ioA
return f x
Upvotes: 4
Reputation: 240512
Note: No, this isn't true. At some point there was a comment on this answer from Dan Piponi himself saying that the cause and effect here was exactly the opposite, that he wrote his article in response to James Iry's quip. But it seems to have been removed, perhaps by some compulsive tidier.
Below is my original answer.
It's quite possible that Iry had read From Monoids to Monads, a post in which Dan Piponi (sigfpe) derives monads from monoids in Haskell, with much discussion of category theory and explicit mention of "the category of endofunctors on Hask" . In any case, anyone who wonders what it means for a monad to be a monoid in the category of endofunctors might benefit from reading this derivation.
Upvotes: 7
Reputation: 908
I came to this post by way of better understanding the inference of the infamous quote from Mac Lane's Category Theory For the Working Mathematician.
In describing what something is, it's often equally useful to describe what it's not.
The fact that Mac Lane uses the description to describe a Monad, one might imply that it describes something unique to monads. Bear with me. To develop a broader understanding of the statement, I believe it needs to be made clear that he is not describing something that is unique to monads; the statement equally describes Applicative and Arrows among others. For the same reason we can have two monoids on Int (Sum and Product), we can have several monoids on X in the category of endofunctors. But there is even more to the similarities.
Both Monad and Applicative meet the criteria:
(e.g., in day to day Tree a -> List b
, but in Category Tree -> List
)
Tree -> List
, only List -> List
.The statement uses "Category of..." This defines the scope of the statement. As an example, the Functor Category describes the scope of f * -> g *
, i.e., Any functor -> Any functor
, e.g., Tree * -> List *
or Tree * -> Tree *
.
What a Categorical statement does not specify describes where anything and everything is permitted.
In this case, inside the functors, * -> *
aka a -> b
is not specified which means Anything -> Anything including Anything else
. As my imagination jumps to Int -> String, it also includes Integer -> Maybe Int
, or even Maybe Double -> Either String Int
where a :: Maybe Double; b :: Either String Int
.
So the statement comes together as follows:
:: f a -> g b
(i.e., any parameterized type to any parameterized type):: f a -> f b
(i.e., any one parameterized type to the same parameterized type) ... said differently,So, where is the power of this construct? To appreciate the full dynamics, I needed to see that the typical drawings of a monoid (single object with what looks like an identity arrow, :: single object -> single object
), fails to illustrate that I'm permitted to use an arrow parameterized with any number of monoid values, from the one type object permitted in Monoid. The endo, ~ identity arrow definition of equivalence ignores the functor's type value and both the type and value of the most inner, "payload" layer. Thus, equivalence returns true
in any situation where the functorial types match (e.g., Nothing -> Just * -> Nothing
is equivalent to Just * -> Just * -> Just *
because they are both Maybe -> Maybe -> Maybe
).
Sidebar: ~ outside is conceptual, but is the left most symbol in f a
. It also describes what "Haskell" reads-in first (big picture); so Type is "outside" in relation to a Type Value. The relationship between layers (a chain of references) in programming is not easy to relate in Category. The Category of Set is used to describe Types (Int, Strings, Maybe Int etc.) which includes the Category of Functor (parameterized Types). The reference chain: Functor Type, Functor values (elements of that Functor's set, e.g., Nothing, Just), and in turn, everything else each functor value points to. In Category the relationship is described differently, e.g., return :: a -> m a
is considered a natural transformation from one Functor to another Functor, different from anything mentioned thus far.
Back to the main thread, all in all, for any defined tensor product and a neutral value, the statement ends up describing an amazingly powerful computational construct born from its paradoxical structure:
:: List
); staticfold
that says nothing about the payload)In Haskell, clarifying the applicability of the statement is important. The power and versatility of this construct, has absolutely nothing to do with a monad per se. In other words, the construct does not rely on what makes a monad unique.
When trying to figure out whether to build code with a shared context to support computations that depend on each other, versus computations that can be run in parallel, this infamous statement, with as much as it describes, is not a contrast between the choice of Applicative, Arrows and Monads, but rather is a description of how much they are the same. For the decision at hand, the statement is moot.
This is often misunderstood. The statement goes on to describe join :: m (m a) -> m a
as the tensor product for the monoidal endofunctor. However, it does not articulate how, in the context of this statement, (<*>)
could also have also been chosen. It truly is an example of 'six in one, half a dozen in the other'. The logic for combining values are exactly alike; same input generates the same output from each (unlike the Sum and Product monoids for Int because they generate different results when combining Ints).
So, to recap: A monoid in the category of endofunctors describes:
~t :: m * -> m * -> m *
and a neutral value for m *
(<*>)
and (>>=)
both provide simultaneous access to the two m
values in order to compute the the single return value. The logic used to compute the return value is exactly the same. If it were not for the different shapes of the functions they parameterize (f :: a -> b
versus k :: a -> m b
) and the position of the parameter with the same return type of the computation (i.e., a -> b -> b
versus b -> a -> b
for each respectively), I suspect we could have parameterized the monoidal logic, the tensor product, for reuse in both definitions. As an exercise to make the point, try and implement ~t
, and you end up with (<*>)
and (>>=)
depending on how you decide to define it forall a b
.
If my last point is at minimum conceptually true, it then explains the precise, and only computational difference between Applicative and Monad: the functions they parameterize. In other words, the difference is external to the implementation of these type classes.
In conclusion, in my own experience, Mac Lane's infamous quote provided a great "goto" meme, a guidepost for me to reference while navigating my way through Category to better understand the idioms used in Haskell. It succeeds at capturing the scope of a powerful computing capacity made wonderfully accessible in Haskell.
However, there is irony in how I first misunderstood the statement's applicability outside of the monad, and what I hope conveyed here. Everything that it describes turns out to be what is similar between Applicative and Monads (and Arrows among others). What it doesn't say is precisely the small but useful distinction between them.
Upvotes: 9
Reputation: 14056
The answers here do an excellent job in defining both monoids and monads, however, they still don't seem to answer the question:
And on a less important note, is this true and if so could you give an explanation (hopefully one that can be understood by someone who doesn't have much Haskell experience)?
The crux of the matter that is missing here, is the different notion of "monoid", the so-called categorification more precisely -- the one of monoid in a monoidal category. Sadly Mac Lane's book itself makes it very confusing:
All told, a monad in
X
is just a monoid in the category of endofunctors ofX
, with product×
replaced by composition of endofunctors and unit set by the identity endofunctor.
Why is this confusing? Because it does not define what is "monoid in the category of endofunctors" of X
. Instead, this sentence suggests taking a monoid inside the set of all endofunctors together with the functor composition as binary operation and the identity functor as a monoidal unit. Which works perfectly fine and turns into a monoid any subset of endofunctors that contains the identity functor and is closed under functor composition.
Yet this is not the correct interpretation, which the book fails to make clear at that stage. A Monad f
is a fixed endofunctor, not a subset of endofunctors closed under composition. A common construction is to use f
to generate a monoid by taking the set of all k
-fold compositions f^k = f(f(...))
of f
with itself, including k=0
that corresponds to the identity f^0 = id
. And now the set S
of all these powers for all k>=0
is indeed a monoid "with product × replaced by composition of endofunctors and unit set by the identity endofunctor".
And yet:
S
can be defined for any functor f
or even literally for any self-map of X
. It is the monoid generated by f
.S
given by the functor composition and the identity functor has nothing do with f
being or not being a monad.And to make things more confusing, the definition of "monoid in monoidal category" comes later in the book as you can see from the table of contents. And yet understanding this notion is absolutely critical to understanding the connection with monads.
Going to Chapter VII on Monoids (which comes later than Chapter VI on Monads), we find the definition of the so-called strict monoidal category as triple (B, *, e)
, where B
is a category, *: B x B-> B
a bifunctor (functor with respect to each component with other component fixed) and e
is a unit object in B
, satisfying the associativity and unit laws:
(a * b) * c = a * (b * c)
a * e = e * a = a
for any objects a,b,c
of B
, and the same identities for any morphisms a,b,c
with e
replaced by id_e
, the identity morphism of e
. It is now instructive to observe that in our case of interest, where B
is the category of endofunctors of X
with natural transformations as morphisms, *
the functor composition and e
the identity functor, all these laws are satisfied, as can be directly verified.
What comes after in the book is the definition of the "relaxed" monoidal category, where the laws only hold modulo some fixed natural transformations satisfying so-called coherence relations, which is however not important for our cases of the endofunctor categories.
Finally, in section 3 "Monoids" of Chapter VII, the actual definition is given:
A monoid
c
in a monoidal category(B, *, e)
is an object ofB
with two arrows (morphisms)
mu: c * c -> c
nu: e -> c
making 3 diagrams commutative. Recall that in our case, these are morphisms in the category of endofunctors, which are natural transformations corresponding to precisely join
and return
for a monad. The connection becomes even clearer when we make the composition *
more explicit, replacing c * c
by c^2
, where c
is our monad.
Finally, notice that the 3 commutative diagrams (in the definition of a monoid in monoidal category) are written for general (non-strict) monoidal categories, while in our case all natural transformations arising as part of the monoidal category are actually identities. That will make the diagrams exactly the same as the ones in the definition of a monad, making the correspondence complete.
In summary, any monad is by definition an endofunctor, hence an object in the category of endofunctors, where the monadic join
and return
operators satisfy the definition of a monoid in that particular (strict) monoidal category. Vice versa, any monoid in the monoidal category of endofunctors is by definition a triple (c, mu, nu)
consisting of an object and two arrows, e.g. natural transformations in our case, satisfying the same laws as a monad.
Finally, note the key difference between the (classical) monoids and the more general monoids in monoidal categories. The two arrows mu
and nu
above are not anymore a binary operation and a unit in a set. Instead, you have one fixed endofunctor c
. The functor composition *
and the identity functor alone do not provide the complete structure needed for the monad, despite that confusing remark in the book.
Another approach would be to compare with the standard monoid C
of all self-maps of a set A
, where the binary operation is the composition, that can be seen to map the standard cartesian product C x C
into C
. Passing to the categorified monoid, we are replacing the cartesian product x
with the functor composition *
, and the binary operation gets replaced with the natural transformation mu
from
c * c
to c
, that is a collection of the join
operators
join: c(c(T))->c(T)
for every object T
(type in programming). And the identity elements in classical monoids, which can be identified with images of maps from a fixed one-point-set, get replaced with the collection of the return
operators
return: T->c(T)
But now there are no more cartesian products, so no pairs of elements and thus no binary operations.
Upvotes: 35
Reputation: 31619
That particular phrasing is by James Iry, from his highly entertaining Brief, Incomplete and Mostly Wrong History of Programming Languages, in which he fictionally attributes it to Philip Wadler.
The original quote is from Saunders Mac Lane in Categories for the Working Mathematician, one of the foundational texts of Category Theory. Here it is in context, which is probably the best place to learn exactly what it means.
But, I'll take a stab. The original sentence is this:
All told, a monad in X is just a monoid in the category of endofunctors of X, with product × replaced by composition of endofunctors and unit set by the identity endofunctor.
X here is a category. Endofunctors are functors from a category to itself (which is usually all Functor
s as far as functional programmers are concerned, since they're mostly dealing with just one category; the category of types - but I digress). But you could imagine another category which is the category of "endofunctors on X". This is a category in which the objects are endofunctors and the morphisms are natural transformations.
And of those endofunctors, some of them might be monads. Which ones are monads? Exactly the ones which are monoidal in a particular sense. Instead of spelling out the exact mapping from monads to monoids (since Mac Lane does that far better than I could hope to), I'll just put their respective definitions side by side and let you compare:
* -> *
with a Functor
instance)join
in Haskell)return
in Haskell)With a bit of squinting you might be able to see that both of these definitions are instances of the same abstract concept.
Upvotes: 985
Reputation: 30237
First, the extensions and libraries that we're going to use:
{-# LANGUAGE RankNTypes, TypeOperators #-}
import Control.Monad (join)
Of these, RankNTypes
is the only one that's absolutely essential to the below. I once wrote an explanation of RankNTypes
that some people seem to have found useful, so I'll refer to that.
Quoting Tom Crockett's excellent answer, we have:
A monad is...
- An endofunctor, T : X -> X
- A natural transformation, μ : T × T -> T, where × means functor composition
- A natural transformation, η : I -> T, where I is the identity endofunctor on X
...satisfying these laws:
- μ(μ(T × T) × T)) = μ(T × μ(T × T))
- μ(η(T)) = T = μ(T(η))
How do we translate this to Haskell code? Well, let's start with the notion of a natural transformation:
-- | A natural transformations between two 'Functor' instances. Law:
--
-- > fmap f . eta g == eta g . fmap f
--
-- Neat fact: the type system actually guarantees this law.
--
newtype f :-> g =
Natural { eta :: forall x. f x -> g x }
A type of the form f :-> g
is analogous to a function type, but instead of thinking of it as a function between two types (of kind *
), think of it as a morphism between two functors (each of kind * -> *
). Examples:
listToMaybe :: [] :-> Maybe
listToMaybe = Natural go
where go [] = Nothing
go (x:_) = Just x
maybeToList :: Maybe :-> []
maybeToList = Natural go
where go Nothing = []
go (Just x) = [x]
reverse' :: [] :-> []
reverse' = Natural reverse
Basically, in Haskell, natural transformations are functions from some type f x
to another type g x
such that the x
type variable is "inaccessible" to the caller. So for example, sort :: Ord a => [a] -> [a]
cannot be made into a natural transformation, because it's "picky" about which types we may instantiate for a
. One intuitive way I often use to think of this is the following:
Now, with that out of the way, let's tackle the clauses of the definition.
The first clause is "an endofunctor, T : X -> X." Well, every Functor
in Haskell is an endofunctor in what people call "the Hask category," whose objects are Haskell types (of kind *
) and whose morphisms are Haskell functions. This sounds like a complicated statement, but it's actually a very trivial one. All it means is that that a Functor f :: * -> *
gives you the means of constructing a type f a :: *
for any a :: *
and a function fmap f :: f a -> f b
out of any f :: a -> b
, and that these obey the functor laws.
Second clause: the Identity
functor in Haskell (which comes with the Platform, so you can just import it) is defined this way:
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f (Identity a) = Identity (f a)
So the natural transformation η : I -> T from Tom Crockett's definition can be written this way for any Monad
instance t
:
return' :: Monad t => Identity :-> t
return' = Natural (return . runIdentity)
Third clause: The composition of two functors in Haskell can be defined this way (which also comes with the Platform):
newtype Compose f g a = Compose { getCompose :: f (g a) }
-- | The composition of two 'Functor's is also a 'Functor'.
instance (Functor f, Functor g) => Functor (Compose f g) where
fmap f (Compose fga) = Compose (fmap (fmap f) fga)
So the natural transformation μ : T × T -> T from Tom Crockett's definition can be written like this:
join' :: Monad t => Compose t t :-> t
join' = Natural (join . getCompose)
The statement that this is a monoid in the category of endofunctors then means that Compose
(partially applied to just its first two parameters) is associative, and that Identity
is its identity element. I.e., that the following isomorphisms hold:
Compose f (Compose g h) ~= Compose (Compose f g) h
Compose f Identity ~= f
Compose Identity g ~= g
These are very easy to prove because Compose
and Identity
are both defined as newtype
, and the Haskell Reports define the semantics of newtype
as an isomorphism between the type being defined and the type of the argument to the newtype
's data constructor. So for example, let's prove Compose f Identity ~= f
:
Compose f Identity a
~= f (Identity a) -- newtype Compose f g a = Compose (f (g a))
~= f a -- newtype Identity a = Identity a
Q.E.D.
Upvotes: 114