Compute N-Ary (with different types!) Cartesian product in Haskell

Question

I know that the sequence function can handle the problem [[1, 2], [3, 4]] -> [[1, 3], [1, 4], [2, 3], [2, 4]] .

But I think that the real Cartesian product should handle the problem ([1, 2], ['a', 'b']) -> [(1, 'a'), (1, 'b'), (2, 'a'), (2, 'b')] , and it should take care of slower if the type of each list is different, and not the external type (and size).

So, the cartProd function that I want is of the type: ([a1], [a2], [a3] ...) -> [(a1, a2, a3 ...)]

I know that there is a problem with the type system. But is there a way to implement the perfect version of this cartProd ?

Answer 1

Here you can use the usual heterogeneous list:

 {-# LANGUAGE UndecidableInstances, GADTs, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, DataKinds, TypeOperators, FlexibleInstances #-} import Control.Applicative data HList xs where Nil :: HList '[] (:>) :: x -> HList xs -> HList (x ': xs) infixr 5 :> -- A Show instance, for illustrative purposes here. instance Show (HList '[]) where show _ = "Nil" instance (Show x, Show (HList xs)) => Show (HList (x ': xs)) where show (x :> xs) = show x ++ " : " ++ show xs 

We usually write functions to HLists using classes, with one instance for Nil and another for the case :> . However, it would be nice to have a class for only one use case (namely, for Cartesian products here), so let me generalize the problem to an applicative sequence:

 class Applicative f => HSequence f (xs :: [*]) (ys :: [*]) | xs -> ys, ys f -> xs where hsequence :: HList xs -> f (HList ys) instance Applicative f => HSequence f '[] '[] where hsequence = pure instance (Applicative g, HSequence f xs ys, y ~ x, f ~ g) => HSequence g (fx ': xs) (y ': ys) where hsequence (fx :> fxs) = (:>) <$> fx <*> hsequence fxs 

Note the use of ~ restrictions in instance definition. This greatly facilitates type inference (along with functional dependencies in the class declaration); the general idea is to move as much information as possible from the instance head to the constraints, since this allows the GHC delay to solve them until there is enough contextual information.

Now Cartesian products work out of the box:

 > hsequence ([1, 2] :> "ab" :> Nil) [1 : 'a' : Nil,1 : 'b' : Nil,2 : 'a' : Nil,2 : 'b' : Nil] 

And we can also use hsequence with any Applicative :

 > hsequence (Just "foo" :> Just () :> Just 10 :> Nil) Just "foo" : () : 10 : Nil 

EDIT: I found out (thanks to dfeuer) that the same functionality is available from the existing hlist package:

 import Data.HList.CommonMain > hSequence ([3, 4] .*. "abc" .*. HNil) [H[3, 'a'],H[3, 'b'],H[3, 'c'],H[4, 'a'],H[4, 'b'],H[4, 'c']] 

Answer 2

Using a Haskell template can be achieved.

 {-# LANGUAGE TemplateHaskell #-} f :: ExpQ -> ExpQ f ess = do es <- ess case es of (TupE e) -> return $ he _ -> fail "f expects tuple of lists" where h ts = let ns = zipWith (\_ -> mkName . ('x':) . show) ts [0..] in CompE $ (zipWith (BindS . VarP) ns ts) ++ [NoBindS $ TupE $ map VarE ns] 

Then it may be a little inconvenient to use, but the price of supporting any tuples:

 Prelude> take 7 $ $(f [| ([1..], [1..2], "ab") |] ) [(1,1,'a'),(1,1,'b'),(1,2,'a'),(1,2,'b'),(2,1,'a'),(2,1,'b'),(2,2,'a')] 

Answer 3

I found the best solution myself, this solution is ideal for the user, but the implementation is kind of ugly (you must create an instance of each tuple, like zip):

 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} class CartProd ab | a -> b where cartProd :: a -> b instance CartProd ([a], [b]) [(a, b)] where cartProd (as, bs) = [(a, b) | a <- as, b <- bs] instance CartProd ([a], [b], [c]) [(a, b, c)] where cartProd (as, bs, cs) = [(a, b, c) | a <- as, b <- bs, c <- cs] c = cartProd (['a'..'c'], [0..2]) d = cartProd (['a'..'c'], [0..2], ['x'..'z']) 

We can also provide a better version of zip so that we can use the same zip' function name instead of zip , zip3 , zip4 ...:

 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} class Zip ab | a -> b where zip' :: a -> b instance Zip ([a], [b]) [(a, b)] where zip' (as, bs) = zip as bs instance Zip ([a], [b], [c]) [(a, b, c)] where zip' (as, bs, cs) = zip3 as bs cs a = zip' (['a'..'z'], [0..]) b = zip' (['a'..'z'], [0..], ['x'..'z'])