type PT_Int = Int
type PT_String = String
data PolyType = PT_Int Int | PT_String String
Given a function f, how do I write a function that lifts it into PolyType?
(just trying to understand lifting)
Your PolyType is equivalent to Either Int String. In case you haven't seen Either before:
data Either a b = Left a | Right b
so you could have a function like
liftP :: (Either Int String -> a) -> PolyType -> a
liftP f poly = case poly of
PT_Int i -> f (Left i)
PT_String s -> f (Right s)
PolyType contains either Int or String, so you can only lift functions that are defined over both Int and String.
That said, I don't think this is what you're after. The term "lifting" is usually used in the context of polymorphic data types like [a], Maybe a, (->) a or in general some type f a where f :: * -> *.
In these cases, given a function g :: a -> b, you want a new function [a] -> [b], Maybe a -> Maybe b or in general f a -> f b. This is exactly fmap from Functor.
class Functor f where
fmap :: (a -> b) -> (f a -> f b)
but your PolyType is monomorphic (it doesn't have a free variable in its type. To be precise, it has kind *) so it can't be a Functor.
You chould change your definition of PolyType to
data PolyType a = PT a
Now this is a valid Functor (it's just the Identity Functor)
instance Functor PolyType where
fmap f (PT a) = PT (f a)
The type of fmap (specialized for this particular PolyType instance) is
fmap :: (a -> b) -> PolyType a -> PolyType b
Related
This is yet another Haskell-through-category-theory question.
Let's take something simple and well-known as an example. fmap?
So fmap :: (a -> b) -> f a -> f b, omitting the fact that f is actually a Functor. As far as I understand, (a -> b) -> f a -> f b is nothing but a syntax sugar for the (a -> b) -> (f a -> f b); hence conclusion:
(1) fmap is a function producing a function.
Now, Hask contains functions as well, so (a -> b) and, in particular, (f a -> f b) is an object of the Hask (because objects of the Hask are well-defined Haskell types - a-ka mathematical sets - and there indeed exists set of type (a -> b) for each possible a, right?). So, once again:
(2) (a -> b) is an object of the Hask.
Now weird thing happens: fmap, obviously, is a morphism of the Hask, so it is a function, that takes another function and transform it to a yet another function; final function hasn't been applied yet.
Hence, one needs one more Hask's morphism to get from the (f a -> f b) to the f b. For each item i of type a there exists a morphism apply_i :: (f a -> f b) -> f b defined as \f -> f (lift i), where lift i is a way to build an f a with particular i inside.
The other way to see it is GHC-style: (a -> b) -> f a -> f b. On the contrast with what I've written above, (a -> b) -> f a is mapping to the regular object of the Hask. But such a view contradicts fundamental Haskell's axiom - no multivariate functions, but applied (curried) alternatives.
I'd like to ask at this point: is (a -> b) -> f a -> f b suppose to be an (a -> b) -> (f a -> f b) -> f b, sugared for simplicity, or am I missing something really, really important there?
is (a -> b) -> f a -> f b suppose to be an (a -> b) -> (f a -> f b) -> f b, sugared for simplicity
No. I think what you're missing, and it's not really your fault, is that it's only a very special case that the middle arrow in (a -> b) -> (f a -> f b) can be called morphism in the same way as the outer (a -> b) -> (f a -> f b) can. The general case of a Functor class would be (in pseudo-syntax)
class (Category (──>), Category (~>)) => Functor f (──>) (~>) where
fmap :: (a ──> b) -> f a ~> f b
So, it maps morphisms in the category whose arrows are denoted ──> to morphisms in the category ~>, but this morphism-mapping itself is just plainly a function. Your right, in Hask specifically function-arrows are the same sort of arrows as the morphism arrows, but this is mathematically speaking a rather degenerate scenario.
fmap is actually an entire family of morphisms. A morphism in Hask is always from a concrete type to another concrete type. You can think of a function as a morphism if the function has a concrete argument type and a concrete return type. A function of type Int -> Int represents a morphism (an endomorphism, really) from Int to Int in Hask. fmap, however has type Functor f => (a -> b) -> f a -> f b. Not a concrete type in sight! We just have type variables and a quasi-operator => to deal with.
Consider the following set of concrete function types.
Int -> Int
Char -> Int
Int -> Char
Char -> Char
Further, consider the following type constructors
[]
Maybe
[] applied to Int returns a type we could call List-of-Ints, but we usually just call [Int]. (One of the most confusing things about functors when I started out was that we just don't have separate names to refer to the types that various type constructors produce; the output is just named by the expression that evaluates to it.) Maybe Int returns the type we just call, well, Maybe Int.
Now, we can define a bunch of functions like the following
fmap_int_int_list :: (Int -> Int) -> [Int] -> [Int]
fmap_int_char_list :: (Int -> Char) -> [Int] -> [Char]
fmap_char_int_list :: (Char -> Int) -> [Char] -> [Int]
fmap_char_char_list :: (Char -> Char) -> [Char] -> [Char]
fmap_int_int_maybe :: (Int -> Int) -> Maybe Int -> Maybe Int
fmap_int_char_maybe :: (Int -> Char) -> Maybe Int -> Maybe Char
fmap_char_int_maybe:: (Char -> Int) -> Maybe Char -> Maybe Int
fmap_char_char_maybe :: (Char -> Char) -> Maybe Char -> Maybe Char
Each of these is a distinct morphism in Hask, but when we define them in Haskell, there's a lot of repetition.
fmap_int_int_list f xs = map f xs
fmap_int_char_list f xs = map f xs
fmap_char_int_list f xs = map f xs
fmap_char_char_list f xs = map f xs
fmap_int_int_maybe f x = case x of Nothing -> Nothing; Just y -> Just (f y)
fmap_int_char_maybe f x = case x of Nothing -> Nothing; Just y -> Just (f y)
fmap_char_int_maybe f x = case x of Nothing -> Nothing; Just y -> Just (f y)
fmap_char_char_maybe f x = case x of Nothing -> Nothing; Just y -> Just (f y)
The definitions don't differ when the type of f differs, only when the type of x/xs differs. That means we can define the following polymorphic functions
fmap_a_b_list f xs = map f xs
fmap_a_b_maybe f x = case x of Nothing -> Nothing; Just y -> Just (f y)
each of which represents a set of morphisms in Hask.
fmap itself is an umbrella term we use to refer to constructor-specific morphisms referred to by all the polymorphic functions.
With that out of the way, we can better understand fmap :: Functor f => (a -> b) -> f a -> f b.
Given fmap f, we first look at the type of f. We might find out, for example, that f :: Int -> Int, which means fmap f has to return one of fmap_int_int_list or fmap_int_int_maybe, but we're not sure which yet. So instead, it returns a constrained function of type Functor f => (Int -> Int) -> f Int -> f Int. Once that function is applied to a value of type [Int] or Maybe Int, we'll finally have enough information to know which morphism is actually meant.
Now weird thing happens: fmap, obviously, is a morphism of the Hask, so it is a function, that takes another function and transform it to a yet another function; final function hasn't been applied yet.
Hence, one needs one more Hask's morphism to get from the (f a -> f b) to the f b. For each item i of type a there exists a morphism apply_i :: (f a -> f b) -> f b defined as \f -> f (lift i), where lift i is a way to build an f a with particular i inside.
The notion of application in category theory is modelled in the form of CCC's - Cartesian Closed Categories. A category 𝓒 is a CCC if you have a natural bijection 𝓒(X×Y,Z) ≅ 𝓒(X,Y⇒Z).
In particular this implies that there exists a natural transformation 𝜺 (the evaluation), where 𝜺[Y,Z]:(Y⇒Z)×Y→Z, such that for every g:X×Y→Z there exists a 𝝀g:X→(Y⇒Z) such that, g = 𝝀g×id;𝜺[Y,Z]. So when you say,
Hence, one needs one more Hask's morphism to get from the (f a -> f b) to the f b.
The way you go from (f a -> f b) to the f b, or using the notation above, from (f a ⇒ f b) is via 𝜺[f a,f b]:(f a ⇒ f b) × f a → f b.
The other important point to keep in mind is that in Category Theory "elements" are not primitive concepts. Rather an element is an arrow of the form 𝟏→X,where 𝟏 is the terminal object. If you take X=𝟏 you have that 𝓒(Y,Z) ≅ 𝓒(𝟏×Y,Z) ≅ 𝓒(𝟏,Y⇒Z). That is, the morphisms g:Y→Z are in bijection to elements 𝝀g:𝟏→(Y⇒Z).
In Haskell this means functions are precisely the "elements" of arrow types. So in Haskell an application h y would be modelled via the evaluation of 𝝀h:𝟏→(Y⇒Z) on y:𝟏→Y. That is, the evaluation of (𝝀h)×y:𝟏→(Y⇒Z)×Y, which is given by the composition (𝝀h)×y;𝜺[Y,Z]:𝟏→Z.
For the sake of completeness, this answer focuses on a point that was addressed in various comments, but not by the the other answers.
The other way to see it is GHC-style: (a -> b) -> f a -> f b. On the contrast with what I've written above, (a -> b) -> f a is mapping to the regular object of the Hask.
-> in type signatures is right-associative. That being so, (a -> b) -> f a -> f b is really the same as (a -> b) -> (f a -> f b), and seeing (a -> b) -> f a in it would be a syntactic mix-up. It is no different from how...
(++) :: [a] -> [a] -> [a]
... doesn't mean that partially applying (++) will give us an [a] list (rather, it gives us a function that prepends some list).
From this point of view, the category theory questions you raise (for instance, on "need[ing] one more Hask's morphism to get from the (f a -> f b) to the f b") are a separate matter, addressed well by Jorge Adriano's answer.
I am learning haskell and one of the tricky part are type variables.
Consider following example:
Prelude> :t fmap
fmap :: Functor f => (a -> b) -> f a -> f b
there is type variables a and b, they can be any type. And f is a type that has to be implemented a Functor.
Lets define a function for first argument for fmap:
Prelude> let replaceWithP = const 'p'
Now, I pass the function replaceWithP to fmap and looking at the type signature:
Prelude> :t fmap replaceWithP
fmap replaceWithP :: Functor f => f b -> f Char
Why does f a becomes to f b, why does it not stay a?
First, the type
fmap replaceWithP :: Functor f => f b -> f Char
is exactly equivalent to
fmap replaceWithP :: Functor f => f a -> f Char
because all type variables are implicitly universally quantified, so they can be renamed at will (this is known as alpha-conversion).
One might still wonder where the name b printed by GHC comes from. After all, fmap had f a in its type, so why did GHC choose to rename it as b?
The "culprit" here is replaceWithP
> :t const
const :: a -> b -> a
> let replaceWithP = const 'p'
> :t replaceWithP
replaceWithP :: b -> Char
So, b comes from the type of replaceWithP.
Type variables can be thought of normal variables, except you have types instead.
What does this mean? For instance, the variable a in C might be defined as:
int a = 2;
What are the possible values that you could have assigned a? The whole int range, because that's the set of values that a may take on. Let's take a look at this in pseudo-Haskell:
type b = Int
What are the set of values that b may take on? That's a trickier question. Typically we're used to seeing things such as 2, "hello", or True as values. However, in Haskell, we also allow types to be treated as values. Sort of. Let's say that b can take on any kind of form *. Essentially, this includes all types that do not need extra information for their construction:
data Tree a = Leaf a | Branch (Tree a) (Tree a)
Tree -- no, has kind: * -> *
Tree Int -- okay!
Int -- okay!
String -- okay!
This means that in your example:
fmap :: Functor f => (a -> b) -> f a -> f b
The variables a and b can be thought of variables that can take on types of any form provided that the type you decide to give it is within the appropriate range of type values (as restricted by kinds).
To more precisely answer your question now: why do we observe that:
fmap :: Functor f => (a -> b) -> f a -> f b
fmap replaceWithP :: Functor f => f b -> f Char
Let me rewrite the following equivalent definition, because variable naming can cause confusion:
fmap :: Functor f => (a -> b) -> f a -> f b
fmap replaceWithP :: Functor f => f z -> f Char
Hopefully this looks more clear now. When you supplied the replaceWithP :: x -> Char function, the following mappings occur:
-- Function types
fmap :: Functor f => (a -> b) -> f a -> f b
replaceWithP :: x -> Char
-- Type variable mappings
a -> x
b -> Char
What does this look like if we perform substitution?
Functor f => (x -> Char) -> f x -> f Char
After you have supplied in the replaceWithP function, you consume the first parameter, so you're left with:
fmap replaceWithP :: Functor f => f x -> f Char
Or equivalently:
fmap replaceWithP :: Functor f => f b -> f Char
Can some body explain me the signature of Functor.
Prelude> :info Functor
class Functor (f :: * -> *) where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
I don't understand what * means.
* is the syntax used by Haskell for kinds
In this case it means that f is higher-kinded (think functions on the type level)
Here f is taking one type (the first *) and is producing another type (the second *)
you can basically forget all this here and just read it as:
class Functor f where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
but it's a nice documentation IMO and there are quite a few classes that are more complicated and the kind-signature is really helpful - for example:
class MonadTrans (t :: (* -> *) -> * -> *) where
lift :: Monad m => m a -> t m a
-- Defined in `Control.Monad.Trans.Class'
Here t takes a type-constructor itself (the Monad) together with another type and produces a type again.
I'm very much a Haskell novice, so apologies if the answer is obvious, but I'm working through the Typeclassopedia in an effort to better understand categories. When doing the exercises for the section on Functors, I came across this problem:
Give an example of a type of kind * -> * which cannot be made an instance of
Functor (without using undefined).
My first thought was to define some kind of infinitely recursing definition of fmap, but wouldn't that essentially be the same as if undefined was used in the definition?
If someone could explain the answer it would be greatly appreciated.
Thanks!
Source of original exercise here, section 3: http://www.haskell.org/haskellwiki/Typeclassopedia#Introduction
A simple example is
data K a = K (a -> Int)
Here's what ghci tells us is we try to automatically derive a Functor instance for K:
Prelude> :set -XDeriveFunctor
Prelude> data K a = K (a -> Int)
Prelude> :k K
K :: * -> *
Prelude> data K a = K (a -> Int) deriving Functor
<interactive>:14:34:
Can't make a derived instance of `Functor K':
Constructor `K' must not use the type variable in a function argument
In the data type declaration for `K'
The problem is that the standard Functor class actually represents covariant functors (fmap lifts its argument to f a -> f b), but there is no way you can compose a -> b and a -> Int to get a function of type b -> Int (see Ramon's answer). However, it's possible to define a type class for contravariant functors:
class Contravariant f where
contramap :: (a -> b) -> f b -> f a
and make K an instance of it:
instance Contravariant K where
contramap f (K g) = K (g . f)
For more on covariance/contravariance in Haskell, see here.
Edit: Here's also a nice comment on this topic from Chris Smith on Reddit.
To expand on my (short) comment and on Mikhail's answer:
Given (-> Int), you'd expect fmap to look as such:
(a -> Int) -> (a -> b) -> (b -> Int)
or:
(a -> Int) -> (a -> b) -> b -> Int
It is easy to prove that from the three arguments (a -> Int), (a -> b), b there is no possible way to reach Int (without undefined), thus from (a -> Int), (a -> b) there is no way to reach (b -> Int). Conclusion: no Functor instance exists for (-> Int).
I also had trouble with this one, and I found Ramon and Mikhail's answers informative -- thanks! I'm putting this in an answer rather than a comment because 500 chars is too short, and for code formatting.
I was having trouble understanding what was covariant about (a -> Int) and came up with this counterexample showing data K a = K (a -> Int) can be made an instance of Functor (disproving Ramon's proof)
data K a = K (a -> Int)
instance Functor K where
fmap g (K f) = K (const 0)
If it compiles, it must be correct, right? ;-)
I spent some time trying other permutations. Flopping the function around just made it easier:
-- "o" for "output"
-- The fmapped (1st) type is a function output so we're OK.
data K0 o = K0 (Int -> o)
instance Functor K0 where
fmap :: (oa -> ob) -> (K0 oa) -> (K0 ob)
fmap g (K0 f) = K0 (g . f)
Turning the Int into a type variable reduced it to Section 3.2 exercise 1 part 2:
-- The fmapped (2nd) type argument is an output
data K1 a b = K1 (a -> b)
instance Functor (K1 a) where
fmap :: (b1 -> b2) -> K1 a b1 -> K1 a b2
fmap g (K1 f) = K1 (g . f)
Forcing the fmapped type to be an argument of the function was the key... just like Mikhail's answer said, but now I understand it ;-)
-- The fmapped (2nd) type argument is an input
data K2 a b = K2 (b -> a)
instance Functor (K2 o) where
fmap :: (ia -> ib) -> (K2 o ia) -> (K2 o ib)
-- Can't get our hands on a value of type o
fmap g (K2 f) = K2 (const (undefined :: o))
-- Nor one of type ia
fmap g (K2 f) = K2 (const (f (undefined :: ia)))
We're used to having universally quantified types for polymorphic functions. Existentially quantified types are used much less often. How can we express existentially quantified types using universal type quantifiers?
It turns out that existential types are just a special case of Σ-types (sigma types). What are they?
Sigma types
Just as Π-types (pi types) generalise our ordinary function types, allowing the resulting type to depend on the value of its argument, Σ-types generalise pairs, allowing the type of second component to depend on the value of the first one.
In a made-up Haskell-like syntax, Σ-type would look like this:
data Sigma (a :: *) (b :: a -> *)
= SigmaIntro
{ fst :: a
, snd :: b fst
}
-- special case is a non-dependent pair
type Pair a b = Sigma a (\_ -> b)
Assuming * :: * (i.e. the inconsistent Set : Set), we can define exists a. a as:
Sigma * (\a -> a)
The first component is a type and the second one is a value of that type. Some examples:
foo, bar :: Sigma * (\a -> a)
foo = SigmaIntro Int 4
bar = SigmaIntro Char 'a'
exists a. a is fairly useless - we have no idea what type is inside, so the only operations that can work with it are type-agnostic functions such as id or const. Let's extend it to exists a. F a or even exists a. Show a => F a. Given F :: * -> *, the first case is:
Sigma * F -- or Sigma * (\a -> F a)
The second one is a bit trickier. We cannot just take a Show a type class instance and put it somewhere inside. However, if we are given a Show a dictionary (of type ShowDictionary a), we can pack it with the actual value:
Sigma * (\a -> (ShowDictionary a, F a))
-- inside is a pair of "F a" and "Show a" dictionary
This is a bit inconvenient to work with and assumes that we have a Show dictionary around, but it works. Packing the dictionary along is actually what GHC does when compiling existential types, so we could define a shortcut to have it more convenient, but that's another story. As we will learn soon enough, the encoding doesn't actually suffer from this problem.
Digression: thanks to constraint kinds, it's possible to reify the type class into concrete data type. First, we need some language pragmas and one import:
{-# LANGUAGE ConstraintKinds, GADTs, KindSignatures #-}
import GHC.Exts -- for Constraint
GADTs already give us the option to pack a type class along with the constructor, for example:
data BST a where
Nil :: BST a
Node :: Ord a => a -> BST a -> BST a -> BST a
However, we can go one step further:
data Dict :: Constraint -> * where
D :: ctx => Dict ctx
It works much like the BST example above: pattern matching on D :: Dict ctx gives us access to the whole context ctx:
show' :: Dict (Show a) -> a -> String
show' D = show
(.+) :: Dict (Num a) -> a -> a -> a
(.+) D = (+)
We also get quite natural generalisation for existential types that quantify over more type variables, such as exists a b. F a b.
Sigma * (\a -> Sigma * (\b -> F a b))
-- or we could use Sigma just once
Sigma (*, *) (\(a, b) -> F a b)
-- though this looks a bit strange
The encoding
Now, the question is: can we encode Σ-types with just Π-types? If yes, then the existential type encoding is just a special case. In all glory, I present you the actual encoding:
newtype SigmaEncoded (a :: *) (b :: a -> *)
= SigmaEncoded (forall r. ((x :: a) -> b x -> r) -> r)
There are some interesting parallels. Since dependent pairs represent existential quantification and from classical logic we know that:
(∃x)R(x) ⇔ ¬(∀x)¬R(x) ⇔ (∀x)(R(x) → ⊥) → ⊥
forall r. r is almost ⊥, so with a bit of rewriting we get:
(∀x)(R(x) → r) → r
And finally, representing universal quantification as a dependent function:
forall r. ((x :: a) -> R x -> r) -> r
Also, let's take a look at the type of Church-encoded pairs. We get a very similar looking type:
Pair a b ~ forall r. (a -> b -> r) -> r
We just have to express the fact that b may depend on the value of a, which we can do by using dependent function. And again, we get the same type.
The corresponding encoding/decoding functions are:
encode :: Sigma a b -> SigmaEncoded a b
encode (SigmaIntro a b) = SigmaEncoded (\f -> f a b)
decode :: SigmaEncoded a b -> Sigma a b
decode (SigmaEncoded f) = f SigmaIntro
-- recall that SigmaIntro is a constructor
The special case actually simplifies things enough that it becomes expressible in Haskell, let's take a look:
newtype ExistsEncoded (F :: * -> *)
= ExistsEncoded (forall r. ((x :: *) -> (ShowDictionary x, F x) -> r) -> r)
-- simplify a bit
= ExistsEncoded (forall r. (forall x. (ShowDictionary x, F x) -> r) -> r)
-- curry (ShowDictionary x, F x) -> r
= ExistsEncoded (forall r. (forall x. ShowDictionary x -> F x -> r) -> r)
-- and use the actual type class
= ExistsEncoded (forall r. (forall x. Show x => F x -> r) -> r)
Note that we can view f :: (x :: *) -> x -> x as f :: forall x. x -> x. That is, a function with extra * argument behaves as a polymorphic function.
And some examples:
showEx :: ExistsEncoded [] -> String
showEx (ExistsEncoded f) = f show
someList :: ExistsEncoded []
someList = ExistsEncoded $ \f -> f [1]
showEx someList == "[1]"
Notice that someList is actually constructed via encode, but we dropped the a argument. That's because Haskell will infer what x in the forall x. part you actually mean.
From Π to Σ?
Strangely enough (although out of the scope of this question), you can encode Π-types via Σ-types and regular function types:
newtype PiEncoded (a :: *) (b :: a -> *)
= PiEncoded (forall r. Sigma a (\x -> b x -> r) -> r)
-- \x -> is lambda introduction, b x -> r is a function type
-- a bit confusing, I know
encode :: ((x :: a) -> b x) -> PiEncoded a b
encode f = PiEncoded $ \sigma -> case sigma of
SigmaIntro a bToR -> bToR (f a)
decode :: PiEncoded a b -> (x :: a) -> b x
decode (PiEncoded f) x = f (SigmaIntro x (\b -> b))
I found an anwer in Proofs and Types by Jean-Yves Girard, Yves Lafont and Paul Taylor.
Imagine we have some one-argument type t :: * -> * and construct an existential type that holds t a for some a: exists a. t a. What can we do with such a type? In order to compute something out of it we need a function that can accept t a for arbitrary a, that means a function of type forall a. t a -> b. Knowing this, we can encode an existential type simply as a function that takes functions of type forall a. t a -> b, supplies the existential value to them and returns the result b:
{-# LANGUAGE RankNTypes #-}
newtype Exists t = Exists (forall b. (forall a. t a -> b) -> b)
Creating an existential value is now easy:
exists :: t a -> Exists t
exists x = Exists (\f -> f x)
And if we want to unpack the existential value, we just apply its content to a function that produces the result:
unexists :: (forall a. t a -> b) -> Exists t -> b
unexists f (Exists e) = e f
However, purely existential types are of very little use. We cannot do anything reasonable with a value we know nothing about. More often we need an existential type with a type class constraint. The procedure is just the same, we just add a type class constraint for a. For example:
newtype ExistsShow t = ExistsShow (forall b. (forall a. Show a => t a -> b) -> b)
existsShow :: Show a => t a -> ExistsShow t
existsShow x = ExistsShow (\f -> f x)
unexistsShow :: (forall a. Show a => t a -> b) -> ExistsShow t -> b
unexistsShow f (ExistsShow e) = e f
Note: Using existential quantification in functional programs is often considered a code-smell. It can indicate that we haven't liberated ourselves from OO thinking.