In Haskell, it is easy to write functions that act on or return tuples of things, e.g. the prelude function splitAt:
splitAt :: Int -> [a] -> ([a], [a])
but is there no easy, convenient, way of writing functions that act on or result in cotuples of things? E.g. a function that returns an Int or a Double. As a concrete example, let's say I want to write a function
MyDivision :: Int -> Int -> (Int + Double)
where + is my symbol for cotupling, so MyDivision x y returns x/y as an Int if the division results in an integer but as a Double if the division does not result in an integer.
So far, it seems that I have two choices, either declare a new datatype
data IntOrDouble = AnInt Int | ADouble Double
or use
Either Int Double
where the first alternative requires a lot of typing and thinking of names and the second alternative quickly gets messy when you have larger cotuples and get types looking like
Either (Either a (Either b c)) (Either (Either d f) g)
Now, if I had a a cotuple type, say
a + b + c + d
I would like to be able to form functions
f :: (a + b + c + d) -> e
g :: (a + b + c + d) -> (e + f + g + h)
by just supplying functions
f1 :: a -> e, f2 :: b -> e, f3 :: c -> e, f4 :: d -> e
g1 :: a -> e, g2 :: b -> f, g3 :: c -> g, g4 :: d -> h
and setting
f = f1 + f2 + f3 + f4
g = g1 <+> g2 <+> g3 <+> g4
or something of the like.
Is this possible?
Well co-tuples are properly called coproducts which is just Either.
So, let's go ahead and do something like
{-# LANGUAGE TypeOperators #-}
type (+) = Either
This is left associative by the way. Now we have pretty syntax like
foo :: Int + Bool + Char
foo = Right 'c'
Now, what you seem to want there is in fact very similar to a church representation of Either flattened out. We can just build this up with the either combinator
(+) :: (a -> c) -> (b -> c) -> (a + b) -> c
l + r = either l r
(<+>) :: (a -> c) -> (b -> d) -> (a + b) -> (c + d)
l <+> r = either (Left . l) (Right . r)
infixl 4 <+>, +
A fun challenge would be to create a generic inject function which takes something like Proxy k where k is some representation of natural numbers at the type level and returns a great nested mess of Eithers for you.
Update:
I got bored, here's the code for generic inj
data Nat = S Nat | Z
type NatRep (n :: Nat) = Proxy n
type family Tuplish (l :: Nat) (r :: Nat) t
type instance Tuplish Z Z t = t
type instance Tuplish (S n) Z t = (Tuplish n Z ()) + t
type instance Tuplish l (S n) t = (Tuplish l n t) + ()
predP :: Proxy (S n) -> Proxy n
predP = reproxy
class Inject (l :: Nat) (r :: Nat) v where
inj :: NatRep l -> NatRep r -> v -> Tuplish l r v
instance Inject Z Z v where
inj _ _ = id
instance Inject (S n) Z v where
inj _ _ v = Right v
instance Inject n m v => Inject n (S m) v where
inj l r v = Left (inj l (predP r) v)
I renamed your + to >+< and your <+> to >*<, but you could do something like this:
type a + b = Either a b
(>+<) :: (a -> c) -> (b -> c) -> a + b -> c
(>+<) = either
(>*<) :: (a -> e) -> (b -> f) -> a + b -> e + f
(f >*< _) (Left a) = Left (f a)
(_ >*< g) (Right b) = Right (g b)
I tried to name the operators to be more suggestive of their operation.
Here's another way to implement >*<:
import Control.Arrow ((+++))
(>*<) :: (a -> e) -> (b -> f) -> a + b -> e + f
(>*<) = (+++)
As a side note: "Tuples" are often called product types and this is what's called a coproduct type (or sum type). The most basic coproduct type is Either and all other coproduct types are isomorphic to Either A B for some types A and B.
Related
One past exam question was to state the type of the function ring with definition ring r q p = r (q p). Supposedly the answer is ring :: (b -> c) -> (a -> b) -> (a -> c), but I don't see where this comes from. Surely such a type would indicate that ring only receives two arguments, but in the definition it takes three, so what's going on?
Every function in Haskell takes one parameter. A function can however return a function that takes another parameter. Haskell however introduces some syntax to make it more convenient. A signature (b -> c) -> (a -> b) -> (a -> c) is thus equivalent to (b -> c) -> ((a -> b) -> (a -> c)) or (b -> c) -> (a -> b) -> a -> c.
Let us first analyze the expression:
ring r q p = r (q p)
Since at the moment we do not know much about the type yet, we will first assign some types to the parameters:
r :: a
q :: b
p :: c
ring :: a -> b -> c -> d
Now we can start to determine the types. In the expression, we see q p, this thus means that q is a function, and p a parameter. This thus means that q is a function of type c -> e (with e a type parameter we introduce).
So we derived that:
q :: c -> e
p :: c
q p :: e
Next we see that the result of q p is used as a parameter with r the function, so that means r is a function that takes an e as parameter type. We thus set the type of r to e -> f. We thus know that:
q p :: e
r :: e -> f
r (q p) :: f
Since the result of ring r q p is r (q p), this thus means that the type of ring is:
ring :: (e -> f) -> (c -> e) -> c -> f
or more verbose:
ring :: (e -> f) -> ((c -> e) -> (c -> f))
Let's go step by step into you ring function (known for everybody as compose or .)
here is the story:
ring r q p = r (q p)
if you start with p you can give to it a type, the variable is not bounded or restricted, so it can be variable, generic, so let's choose a name, a
p :: a
now, q has something that you can tell, it takes values of type p as parameter, right? Because it is applied to p , (q p), so, q is a function, and a function has the form (type -> type),
p :: a
q :: (type -> type)
now you can replace the input, q expects a p typed values, and p :: a so:
p :: a
q :: a -> type
again, the type of the return can be the same as the input, but is not restricted to be, so we can use another name to it, let use b
p :: a
q :: a -> b
(q p) :: b
now, what about r ?, r expects the result of (q p) and you know the type, it is b, same logic, r :: type -> type because it is a function
p :: a
q :: a -> b
(q p) :: b
r :: b -> type
and finally, the return type of r is not restricted, so it can be a c type, so:
p :: a
q :: a -> b
(q p) :: b
r :: b -> c
r (q p) :: c
replacing everything in ring:
ring :: (b -> c) -> (a -> b) -> a -> c
ring r q p = r (q p)
see that I didn't use the final parenthesis, because they are not needed, in haskell the functions are curried, so, its true that if you give two functions to ring, it will return a third function of type a -> c
let's see:
ring show (+1)
(+1) :: Num a -> a -> a
show :: Show a => a -> String
ring show (+1) :: (Show a, Num a) => a -> String
and I didn't give the value, so that why you can write ring as:
ring :: (b -> c) -> (a -> b) -> (a -> c)
and remove it to:
ring :: (b -> c) -> (a -> b) -> a -> c
and to see more, check the types of:
ring show :: Show a => (b -> a) -> b -> String
ring show (+1) :: (Show a, Num a) => a -> String
ring show (+1) 2 :: String
ring also can have more extra parenthesis:
ring :: (b -> c) -> ((a -> b) -> (a -> c))
as you can see in ring show it returns ((a -> b) -> (a -> c)) and ring show (+1) returns (a -> c)
I have two functions
(\f b -> (\a -> a) f b b)
and
(\f b -> (\a -> 0) f b b)
I tried to find the type of these functions by hand and got
(t1 -> t1 -> t2) -> t1 -> t2
and
Num t3 => (t1 -> t1 -> t2) -> t1 -> t3
But when I use GHCI to get the type using :t I get the following
(\f b -> (\a -> a) f b b) :: (t1 -> t1 -> t2) -> t1 -> t2
(\f b -> (\a -> 0) f b b) :: Num (t1 -> t1 -> t2) => p -> t1 -> t2
I don't understand how changing \a -> a to \a -> 0 changes the first parameter from (t1 -> t1 -> t2) to p
Deriving the type for (\f b -> (\a -> a) f b b)
Well let us try to derive the type for the expression:
(\f b -> (\a -> a) f b b)
or more verbose:
(\f -> (\b -> (((\a -> a) f) b) b))
We here see that this is a function taking two parameters (well technically speaking a function always takes one parameter, and the result of that function then can take another one, but let us assume that if we talk about "two parameters", we mean such construct).
The parameters are thus f, and b, and initially we do not know much about these, so we assign them a type, and the expression is:
f :: g
b :: h
(\f b -> (\a -> a) f b b) :: g -> (h -> i)
We thus create three types g, h and i (I here used other identifiers than a, b and c, since that could introduce confusion with the variables).
But we are not done yet, since the expression itself, can introduce more constraints on how the types behave. We see for example a lambda expression: \a -> a, this clearly has as type:
\a -> a :: j -> j
Next we see a function application, with \a -> a as function, and f as argument, so that means that g ~ j (g and j are the same type), and the type of (\a -> a) f is (\a -> a) f :: g.
But we are not done yet, since the result of (\a -> a) f, now acts as a function in a function application with b, so that means that g is in fact a function, with input type h, and some (currently unknown output type), so:
g ~ (h -> k)
So the type of (\a -> a) f b is k, but again we are not done yet, since we perform another function application with (\a -> a) f b as function (type k), and b as parameter, so that means that k is in fact a function, with h as parameter type, and the result is the type of the expression, so i. So that means we have:
g ~ j
g ~ (h -> k)
k ~ (h -> i)
In other words, the type of the expression is:
(\f b -> (\a -> a) f b b) :: (h -> (h -> i)) -> (h -> i)
or less verbose:
(\f b -> (\a -> a) f b b) :: (h -> h -> i) -> h -> i
Deriving the type for (\f b -> (\a -> 0) f b b)
The first steps of the derivation are more or less the same, we first introduce some type variables:
f :: g
b :: h
(\f b -> (\a -> 0) f b b) :: g -> (h -> i)
and now we start doing the inference. We first infer the type of (\a -> 0). This is a function, with type Num l => j -> l since 0 is a Number, but it can be any Num type, and has nothing to do with the type of the parameter a.
Next we see that there is a function call with (\a -> 0) as function, and f as parameter, we thus conclude that g ~ j. The type of the result of this function call is (\a -> 0) f :: Num l => l.
Now we see another function call with (\a -> 0) f as function, and b as parameter. We thus conclude that l is a function (so l ~ (h -> k)).
The last function call is with (\a -> 0) f b :: k as function, and b again as parameter. This means that k is a function k ~ h -> i. We thus obtain the following types and equalities:
f :: g
b :: h
(\a -> 0) :: Num l => j -> l
(\f b -> (\a -> 0) f b b) :: g -> (h -> i)
g ~ j
l ~ (h -> k)
k ~ (h -> i)
The type of the expression is thus:
(\f b -> (\a -> 0) f b b) :: g -> (h -> i)
or more specific:
(\f b -> (\a -> 0) f b b) :: Num (h -> (h -> i)) => g -> (h -> i)
or less verbose:
(\f b -> (\a -> 0) f b b) :: Num (h -> h -> i) => g -> h -> i
So since we use as inner lambda expression (\a -> 0), nor the type nor the value of f, are relevant anymore. (\a -> 0) f will always return 0, and this should be a function, that can take a b into account.
At least from a theoretical point of view, there is nothing "strange" about a function that is a Num (as long as it supports the functions that should be implemented by Num types). We could for example implement a function instance Num (a -> b -> Int), and thus see 0 as a constant function that always maps to 0, and (+) as a way to construct a new function that adds the two functions together.
Recently I've finally started to feel like I understand catamorphisms. I wrote some about them in a recent answer, but briefly I would say a catamorphism for a type abstracts over the process of recursively traversing a value of that type, with the pattern matches on that type reified into one function for each constructor the type has. While I would welcome any corrections on this point or on the longer version in the answer of mine linked above, I think I have this more or less down and that is not the subject of this question, just some background.
Once I realized that the functions you pass to a catamorphism correspond exactly to the type's constructors, and the arguments of those functions likewise correspond to the types of those constructors' fields, it all suddenly feels quite mechanical and I don't see where there is any wiggle room for alternate implementations.
For example, I just made up this silly type, with no real concept of what its structure "means", and derived a catamorphism for it. I don't see any other way I could define a general-purpose fold over this type:
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
xCata a b c d v = case v of
A i x -> a i x
B -> b
C f x -> c f (xCata a b c d x)
D x -> d x
My question is, does every type have a unique catamorphism (up to argument reordering)? Or are there counterexamples: types for which no catamorphism can be defined, or types for which two distinct but equally reasonable catamorphisms exist? If there are no counterexamples (i.e., the catamorphism for a type is unique and trivially derivable), is it possible to get GHC to derive some sort of typeclass for me that does this drudgework automatically?
The catamorphism associated to a recursive type can be derived mechanically.
Suppose you have a recursively defined type, having multiple constructors, each one with its own arity. I'll borrow OP's example.
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
Then, we can rewrite the same type by forcing each arity to be one, uncurrying everything. Arity zero (B) becomes one if we add a unit type ().
data X a b f = A (Int, b)
| B ()
| C (f a, X a b f)
| D a
Then, we can reduce the number of constructors to one, exploiting Either instead of multiple constructors. Below, we just write infix + instead of Either for brevity.
data X a b f = X ((Int, b) + () + (f a, X a b f) + a)
At the term-level, we know we can rewrite any recursive definition
as the form x = f x where f w = ..., writing an explicit fixed point equation x = f x. At the type-level, we can use the same method
to refector recursive types.
data X a b f = X (F (X a b f)) -- fixed point equation
data F a b f w = F ((Int, b) + () + (f a, w) + a)
Now, we note that we can autoderive a functor instance.
deriving instance Functor (F a b f)
This is possible because in the original type each recursive reference only occurred in positive position. If this does not hold, making F a b f not a functor, then we can't have a catamorphism.
Finally, we can write the type of cata as follows:
cata :: (F a b f w -> w) -> X a b f -> w
Is this the OP's xCata type? It is. We only have to apply a few type isomorphisms. We use the following algebraic laws:
1) (a,b) -> c ~= a -> b -> c (currying)
2) (a+b) -> c ~= (a -> c, b -> c)
3) () -> c ~= c
By the way, it's easy to remember these isomorphisms if we write (a,b) as a product a*b, unit () as1, and a->b as a power b^a. Indeed they become
c^(a*b) = (c^a)^b
c^(a+b) = c^a*c^b
c^1 = c
Anyway, let's start to rewrite the F a b f w -> w part, only
F a b f w -> w
=~ (def F)
((Int, b) + () + (f a, w) + a) -> w
=~ (2)
((Int, b) -> w, () -> w, (f a, w) -> w, a -> w)
=~ (3)
((Int, b) -> w, w, (f a, w) -> w, a -> w)
=~ (1)
(Int -> b -> w, w, f a -> w -> w, a -> w)
Let's consider the full type now:
cata :: (F a b f w -> w) -> X a b f -> w
~= (above)
(Int -> b -> w, w, f a -> w -> w, a -> w) -> X a b f -> w
~= (1)
(Int -> b -> w)
-> w
-> (f a -> w -> w)
-> (a -> w)
-> X a b f
-> w
Which is indeed (renaming w=r) the wanted type
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
The "standard" implementation of cata is
cata g = wrap . fmap (cata g) . unwrap
where unwrap (X y) = y
wrap y = X y
It takes some effort to understand due to its generality, but this is indeed the intended one.
About automation: yes, this can be automatized, at least in part.
There is the package recursion-schemes on hackage which allows
one to write something like
type X a b f = Fix (F a f b)
data F a b f w = ... -- you can use the actual constructors here
deriving Functor
-- use cata here
Example:
import Data.Functor.Foldable hiding (Nil, Cons)
data ListF a k = NilF | ConsF a k deriving Functor
type List a = Fix (ListF a)
-- helper patterns, so that we can avoid to match the Fix
-- newtype constructor explicitly
pattern Nil = Fix NilF
pattern Cons a as = Fix (ConsF a as)
-- normal recursion
sumList1 :: Num a => List a -> a
sumList1 Nil = 0
sumList1 (Cons a as) = a + sumList1 as
-- with cata
sumList2 :: forall a. Num a => List a -> a
sumList2 = cata h
where
h :: ListF a a -> a
h NilF = 0
h (ConsF a s) = a + s
-- with LambdaCase
sumList3 :: Num a => List a -> a
sumList3 = cata $ \case
NilF -> 0
ConsF a s -> a + s
A catamorphism (if it exists) is unique by definition. In category theory a catamorphism denotes the unique homomorphism from an initial algebra into some other algebra. To the best of my knowledge in Haskell all catamorphisms exists because Haskell's types form a Cartesian Closed Category where terminal objects, all products, sums and exponentials exist. See also Bartosz Milewski's blog post about F-algebras, which gives a good introduction to the topic.
I am an intermediate schemer, but only a haskell beginner. Here is my problem:
Suppose you have an associative binary operation, says (>>=). Is there a polyvariadic function p such that p (>>=) h g f e = h >>= g >>= f >>= e?
I am asking this question because this question says it is possible if the binary operation takes inputs of the same type. I wonder if this can be generalized.
EDIT-1: I try to modify the code in http://okmij.org/ftp/Haskell/vararg-fn.lhs (the section of Variable number of variably typed arguments) with little progress.
EDIT-2: Simplify the code a bit.
{-# LANGUAGE FunctionalDependencies, FlexibleInstances #-}
module Main where
class Lfold f a b | b -> a where
lfold :: (a -> (f a) -> (f a)) -> (f a) -> a -> b
instance Lfold f a (f a) where
lfold op rid x = op x rid
instance Lfold f a b => Lfold f a (a -> b) where
lfold op rid x y = lfold op (op x rid) y
test :: [String]
test = lfold (:) [] "a" "b" "c"
main :: IO ()
main = putStrLn $ show test
Yes, you can create such a function. It is very ugly however, and you will need to explicitly type every argument you are going to pass to make the compiler find the correct instance.
Starting from the polyvariadic function template you linked, I arrived at
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses #-}
class ImplicitChain m a r where
p :: m a -> r
instance Monad m => ImplicitChain m a (m a) where
p :: m a -> m a
p x = x
instance (Monad m, ImplicitChain m b r) => ImplicitChain m a ((a -> m b) -> r) where
p :: m a -> (a -> m b) -> r
p x f = p (x >>= f)
h :: Int -> [Int]
h = replicate 2
g :: Int -> [Int]
g = (:[])
f :: Int -> [Int]
f = flip enumFromTo 2
test :: [Int]
test = p [1::Int] h g f
But you were asking whether we can do more generic, so that the binary operation is an argument as well. Yes:
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses, UndecidableInstances #-}
class ImplicitVariadic a b r where
p :: (a -> b -> a) -> r
instance ImplicitVariadic a b (a -> a) where
p :: (a -> b -> a) -> a -> a
p _ x = x
instance (ImplicitVariadic a b (a -> r)) => ImplicitVariadic a b (a -> b -> r) where
p :: (a -> b -> a) -> a -> b -> r
p f x y = p f (f x y)
You can't (at least, not easily), because you need to know how many arguments you are getting ahead of time. Because all functions in Haskell are automatically curried, every function takes exactly one argument and returns one value. Even a simple binary operator takes one argument (the first operand) and returns a function that takes one argument (the second operand) and returns a result. That is,
a + b == (+) a b
== ((+) a) b
There is no way for your imaginary function p to know from its first argument how many other arguments are going to be given. That is, what should the type of p be?
p :: (a -> a -> a) -> a -- zero arguments?
p :: (a -> a -> a) -> a -> a -- one argument?
p :: (a -> a -> a) -> a -> a -> a -- two arguments?
p :: (a -> a -> a) -> a -> a -> a -> a -- three arguments?
Instead, the best you can do is use a fold, which takes an operation and a list of operands.
foldr (+) 0 [h, g, f, e] == h + g + f + e + 0 -- explicit first argument of 0
foldr1 (+) [h, g, f, e] == h + g + f + e -- assumes a list of at least one value
To see what I mean by "not easily", look at the implementation of printf in the Text.Printf module. Even that is not a good example, because the first argument carries information (the number of placeholders in the format string) that a binary operation alone does not.
Generic programming time!
If I have a function:
f :: a1 -> a2 -> a3 -> ... -> an
and a value
v :: aX -- where 1 <= x < n
Without knowing at compile time which of the arguments of f the value v is the right type for (if any), can I partially apply f to v? (using Typeable, Data, TH, or any other trick)
Slightly more solidly, can I construct the function g (below) at run-time? It doesn't actually have to be polymorphic, all my types will be monomorphic!
g :: (a1 -> a2 -> a3 -> a4 -> a5) -> a3 -> (a1 -> a2 -> a4 -> a5)
g f v = \x y z -> f x y v z
I know that, using Typeable (typeRepArgs specifically), v is the 3rd argument of f, but that doesn't mean I have a way to partially apply f.
My code would probably look like:
import Data.Typeable
data Box = forall a. Box (TyRep, a)
mkBox :: Typeable a => a -> Box
mkBox = (typeOf a, a)
g :: Box -> Box -> [Box]
g (Box (ft,f)) (Box (vt,v)) =
let argNums = [n | n <- [1..nrArgs], isNthArg n vt ft]
in map (mkBox . magicApplyFunction f v) argNums
isNthArg :: Int -> TyRep -> TyRep -> Bool
isNthArg n arg func = Just arg == lookup n (zip [1..] (typeRepArgs func))
nrArgs :: TyRep -> Int
nrArgs = (\x -> x - 1) . length . typeRepArgs
Is there anything that can implement the magicApplyFunction?
EDIT: I finally got back to playing with this. The magic apply function is:
buildFunc :: f -> x -> Int -> g
buildFunc f x 0 = unsafeCoerce f x
buildFunc f x i =
let !res = \y -> (buildFunc (unsafeCoerce f y) x (i-1))
in unsafeCoerce res
I'm not going to write the whole solution here for now, but I'm sure this can be done purely with Data.Dynamic and Typeable. The source for dynApply and funResultTy should provide the key elements:
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
dynApply (Dynamic t1 f) (Dynamic t2 x) =
case funResultTy t1 t2 of
Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
Nothing -> Nothing
funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
funResultTy trFun trArg
= case splitTyConApp trFun of
(tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
_ -> Nothing
To keep things simple, I'd have type Box = (Dynamic, [Either TypeRep Dynamic]). The latter starts out as a list of typereps of arguments. magicApply would look for the first matching TypeRep in the box and substitute the Dynamic of the value. Then you could have an extract that given a Box to which all arguments have been magicapplied, actually performs the dynApply calls to produce the resulting dynamic result.
Hm.. Typeable only? How about good old OverlappingInstances?
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,
UndecidableInstances, IncoherentInstances, ScopedTypeVariables #-}
class Magical a b c where
apply :: a -> b -> c
instance (AreEqual a c e, Magical' e (a -> b) c r) => Magical (a -> b) c r where
apply f a = apply' (undefined :: e) f a
class Magical' e a b c where
apply' :: e -> a -> b -> c
instance (r ~ b) => Magical' True (a -> b) a r where
apply' _ f a = f a
instance (Magical b c d, r ~ (a -> d)) => Magical' False (a -> b) c r where
apply' _ f c = \a -> apply (f a) c
data True
data False
class AreEqual a b r
instance (r ~ True) => AreEqual a a r
instance (r ~ False) => AreEqual a b r
test :: Int -> Char -> Bool
test i c = True
t1 = apply test (5::Int)
t2 = apply test 'c'