Haskell - 将一个联合类型的列表转换为元组列表

Question

我正在寻找一种方法将列表转换为n元组，每个n元组对应于一个不交并集中的n个构造函数之一。标准库定义了一个类似的函数，专门用于Either类型：

partitionEithers :: [Either a b] -> ([a], [b])

我正在寻找解决以下要求的广义问题的技术：

• 书写方便
• 尽可能少的样板代码
• 在一次遍历中处理列表
• 允许使用数据类型泛型、元编程、现有库等

示例

这是一个具有两个提议解决方案的示例规范：

partitionSum :: [MySum] -> ([A], [B], [C], [D])

data MySum
  = CaseA A
  | CaseB B
  | CaseC C
  | CaseD D

data A = A deriving Show
data B = B deriving Show
data C = C deriving Show
data D = D deriving Show

-- expect "([A,A],[B,B,B],[],[D])"
test :: IO ()
test = print . partitionSum $
  [CaseD D, CaseB B, CaseA A, CaseA A, CaseB B, CaseB B]

第一次尝试：使用 n 个列表推导式遍历列表 n 次。

partitionSum1 :: [MySum] -> ([A], [B], [C], [D])
partitionSum1 xs =
  ( [a | CaseA a <- xs]
  , [b | CaseB b <- xs]
  , [c | CaseC c <- xs]
  , [d | CaseD d <- xs]
  )

第二次尝试：对输入列表进行单次遍历。我必须手动将状态穿过折叠，这使得解决方案有些重复和烦人，需要编写大量代码。

partitionSum2 :: [MySum] -> ([A], [B], [C], [D])
partitionSum2 = foldr f ([], [], [], [])
  where
    f x (as, bs, cs, ds) =
      case x of
        CaseA a -> (a : as, bs, cs, ds)
        CaseB b -> (as, b : bs, cs, ds)
        CaseC c -> (as, bs, c : cs, ds)
        CaseD d -> (as, bs, cs, d : ds)

- dumbo

---

一个想法可能是使用模板Haskell来构建函数本身，尽管模板Haskell是一个有争议的话题。 - Willem Van Onsem

这是我曾经根据可表示函子写的一个泛化函数partition :: Representable r => Foldable f => Eq (Rep r) => (a -> Rep r) -> f a -> r [a]，基于可表示函子。 - Iceland_jack

Answer 1

除了可表示答案之外：

---

从看到 foldr f ([], [], [], []) 这个东西，我想到了定义一个单子（monoid），其中空值情况是 mempty。

{-# DerivingVia #-}
..
import GHC.Generics (Generically(..), ..)

type Classify :: Type
type Classify = C [A] [B] [C] [D]
  deriving
  stock Generic

  deriving (Semigroup, Monoid)
  via Generically Classify

-- mempty = C [] [] [] []
-- C as bs cs ds <> C as1 bs1 cd1 ds1 = C (as ++ as1) (bs ++ bs1) (cs ++ cs1) (ds ++ ds1)

Generically将来会从GHC.Generics中导出。通过通用点对点提升，它定义了Classify作为一个半群和单子。

有了这个，你只需要一个分类器函数，把MySum分类到Classify中，然后就可以用foldMap来定义partition了。

classify :: MySum -> Classify
classify = \case
  SumA a -> C [a] [] [] []
  SumB b -> C [] [b] [] []
  SumC c -> C [] [] [c] []
  SumD d -> C [] [] [] [d]

partition :: Foldable f => f MySum -> Classify
partition = foldMap classify

- Iceland_jack

Answer 2

作为将总和转换为乘积的函数，使用 generics-sop 可以实现相当简单。这是一个库，它通过更专业的类型增强了 GHC 的通用性，使代数类型（即总和乘积）的归纳变得更简单。

首先，一个前提：

{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}

import Generics.SOP hiding ((:.:))
import qualified GHC.Generics as GHC
import GHC.Generics ((:.:)(..))


partitionSum :: (Generic t) => [t] -> NP ([] :.: NP I) (Code t)

这是您想要编写的方法。让我们检查它的类型。

• 单个参数是某种通用类型的列表。非常简单明了。请注意，此处的Generic来自于generics-sop，而不是GHC。
• 返回值是一个n元组，其中每个元素都是由NP I（本身是n元组，因为通常，代数数据类型构造函数可能具有多个字段）组成的列表。
• Code t是t的和乘积类型表示。它是一系列类型的列表。例如，Code (Either a b) ~ '[ '[a], '[b] ]。 t的通用值表示是SOP I (Code t) - 代码的总和乘积。

为了实现这个方法，我们可以将每个t转换为其通用表示，然后对结果列表进行折叠：

partitionSum = partitionSumGeneric . map from

partitionSumGeneric :: SListI xss => [SOP I xss] -> NP ([] :.: NP I) xss
partitionSumGeneric = foldr (\(SOP x) -> classifyGeneric x) emptyClassifier

partitionSumGeneric基本上与partitionSum相同，但是操作于值的通用表示。

现在进入有趣的部分。让我们从我们的fold的基本情况开始。这应该在每个位置包含空列表。generics-sop提供了一个方便的机制来生成一个具有每个位置上统一值的产品类型:

emptyClassifier :: SListI xs => NP ([] :.: NP I) xs
emptyClassifier = hpure (Comp1 [])

递归情况如下：如果该值在索引k处具有标签，则将该值添加到累加器中索引k的列表中。我们可以同时对总和类型（现在是通用的，所以类型为NS（NP I）xs的值-产品之和）和累加器进行递归来实现这一点。

classifyGeneric :: NS (NP I) xss -> NP ([] :.: NP I) xss -> NP ([] :.: NP I) xss
classifyGeneric (Z x)  (Comp1 l :* ls) = (Comp1 $ x : l) :* ls
classifyGeneric (S xs) (      l :* ls) =              l  :* classifyGeneric xs ls

以下是您的示例，添加了一些数据，使其更加有趣：

data MySum
  = CaseA A
  | CaseB B
  | CaseC C
  | CaseD D

-- All that's needed for `partitionSum' to work with your type
deriving instance GHC.Generic MySum
instance Generic MySum

data A = A Int deriving Show
data B = B String Int deriving Show
data C = C deriving Show
data D = D Integer deriving Show

test = partitionSum $
  [CaseD $ D 0, CaseB $ B "x" 1, CaseA $ A 2, CaseA $ A 3, CaseB $ B "y" 4, CaseB $ B "z" 5]

结果是：

Comp1 {unComp1 = [I (A 2) :* Nil,I (A 3) :* Nil]} :* Comp1 {unComp1 = [I (B "x" 1) :* Nil,I (B "y" 4) :* Nil,I (B "z" 5) :* Nil]} :* Comp1 {unComp1 = []} :* Comp1 {unComp1 = [I (D 0) :* Nil]} :*Nil

- user2407038