在Haskell中计算N-Ary（具有不同类型的!!）笛卡尔积

Question

我知道函数sequence可以处理[[1, 2], [3, 4]] -> [[1, 3], [1, 4], [2, 3], [2, 4]]问题。

但是我认为真正的笛卡尔积应该处理([1, 2], ['a', 'b']) -> [(1, 'a'), (1, 'b'), (2, 'a'), (2, 'b')]问题，并且如果每个列表的类型不同，或者外部元组的类型（和大小），则应该关心邻居。

所以，我想要的cartProd函数具有这样的类型：([a1], [a2], [a3] ...) -> [(a1, a2, a3 ...)]

我知道类型系统在这里存在一些问题。但是有什么方法可以实现此cartProd的完美版本吗？

Answer 1

通常的异构列表可以在这里使用：

{-# 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

我们通常使用类在HLists上编写函数，其中一个实例用于Nil，另一个实例用于:>情况。但是，仅具有一个用例的类（此处为笛卡尔积）并不是一个好主意，因此让我们将问题归结为适用性排序：

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 (f x ': xs) (y ': ys) where
  hsequence (fx :> fxs) = (:>) <$> fx <*> hsequence fxs

请注意在实例定义中使用~约束。它极大地帮助了类型推断（以及类声明中的功能依赖）；一般的想法是将尽可能多的信息从实例头移到约束，因为这会使GHC延迟解决它们，直到有足够的上下文信息为止。

现在的直角坐标产品开箱即用：

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

而且我们也可以将hsequence与任何Applicative一起使用：

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

编辑：我发现（感谢dfeuer）可以从现有的hlist包中获得相同的功能：

hlist

Answer 2

使用模板Haskell可以实现这一目标。

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']]

然后也许有点尴尬，但是这是支持任何元组的代价：

{-# LANGUAGE TemplateHaskell #-}
f :: ExpQ -> ExpQ
f ess = do es <- ess
           case es of
             (TupE e) -> return $ h e
             _ -> 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]

Answer 3

我自己找到了一个更好的解决方案，该解决方案非常适合用户，但是它的实现有点丑陋（必须创建每个元组的实例，就像zip一样：]]

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')]
我们还可以通过这种方式提供更好的zip版本，以便我们可以使用单个函数名{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}

class CartProd a b | 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'])
代替zip'，zip，zip3 ...：

zip4