Подсчитайте N-Ary (с различными типами!) Декартовы продукты в Haskell

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 

EDIT: Я узнал (спасибо dfeuer), что такую ​​же функциональность имеется в наличии из существующего пакета hlist:

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

Используя шаблон Haskell, можно добиться этого.

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

Тогда, возможно, немного неудобным, но это цена за поддержку любых кортежей:

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

Я нашел лучшее решение сам, это решение идеально подходит для пользователей, но это реализация своего рода уродливые (необходимо создать экземпляр каждого кортежа, как молния):

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

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} 

class Zip a b | 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'])