使用自定义比较器函数压缩两个列表的标准方法

Question

如果经常需要压缩两个列表，丢弃不匹配的元素（其中“匹配”是通过比较列表的部分元素来定义的）。例如：

let as = [(1,"a"), (2,"b"), (4,"c")]
let bs = [(2,"a"), (3,"b"), (4,"c"), (5, "d")]
zipWithAdjust (fst) (fst) as bs
-- ~> [((2,"b"),(2,"a")), ((4,"c"),(4,"c"))]

我实现zipWithAdjust如下：

zipWithAdjust :: (Ord c, Show a, Show b, Show c) => (a -> c) -> (b -> c) -> [a] -> [b] -> [(a,b)]
zipWithAdjust cmpValA cmpValB (a:as) (b:bs)
  | cmpValA a == cmpValB b = (a,b) : zipWithAdjust cmpValA cmpValB as bs
  | cmpValA a > cmpValB b = zipWithAdjust cmpValA cmpValB (a:as) bs
  | cmpValA a < cmpValB b = zipWithAdjust cmpValA cmpValB as (b:bs)
zipWithAdjust _ _ _ _ = []

它工作得很好，但我觉得有一种标准的方式来做这样的 zip。我找到了Data.Align 和this SO Question，但不知道如何在我的用例中使用它。

是否有标准的方法来做到这一点（使用库函数）？是 Data.Align 吗？如果是这样，如何使用 Data.Align 实现上述功能？

编辑：更改了 < 大小写，以使实现与示例匹配。

Answer 1

据我所知，没有such function。但是，您可以通过使用 (a -> b -> Ordering) 而不是两个附加函数来使您的函数更通用：

zipWithAdjust :: (a -> b -> Ordering) -> [a] -> [b] -> [(a,b)]
zipWithAdjust cmp (a:as) (b:bs)
  | ord == LT = zipWithAdjust cmp as (b:bs)
  | ord == GT = zipWithAdjust cmp (a:as) (bs)
  | ord == EQ = (a,b) : zipWithAdjust cmp as bs
  where ord = cmp a b

zipWithAdjust _ _ _ = []

result =  zipWithAdjust (\x y -> compare (fst x) (fst y)) [(1,"a"), (2,"b"), (4,"c")] [(2,"a"), (3,"b"), (4,"c"), (5, "d")]

但是，我不会再称它为 zip，而是类似 compareMerge 或类似名称。

Answer 2

您可能会喜欢Data.Map's intersection capabilities。它在某些方面的能力略逊一筹，而在另一些方面则更有能力。例如：

> let as = fromList [(1,"a"), (2,"b"), (4,"c")]; bs = fromList [(2,"a"), (3,"b"), (4,"c"), (5, "d")]
> intersectionWith (,) as bs
fromList [(2,("b","a")),(4,("c","c"))]

Answer 3

我会说这句话更惯用了

zipWithAdjust cmpA cmpB (a:as) (b:bs) =
    case cmpA a `compare` cmpB b of
        EQ -> (a, b) : zipWithAdjust cmpA cmpB    as     bs
        GT ->          zipWithAdjust cmpA cmpB (a:as)    bs
        LT ->          zipWithAdjust cmpA cmpB    as  (b:bs)
zipWithAdjust _ _ _ _ = []

它肯定会更快，因为它减少了计算cmpA a 和cmpB b 的次数。这不是真正的 zip，因为您同时进行过滤，并且在您的 GT 和 LT 案例中也有所抵消。我会说这个解决方案非常好，不需要使用标准函数来实现它。

Answer 4

编辑： 使用来自Data.These 的These a b 类型（由Data.Align 使用），其中：

ordzipBy :: (Ord t) => (a -> t) -> (b -> t) -> [a] -> [b] -> [These a b]
ordzipBy f g a@(x:t) b@(y:r) = case compare (f x) (g y) of
    LT -> This  x   : ordzipBy f g t b
    GT -> That    y : ordzipBy f g a r
    EQ -> These x y : ordzipBy f g t r
ordzipBy _ _ a       []      = map This a
ordzipBy _ _ []      b       = map That b

我们可以将三个集合操作表示为：

diffBy :: (Ord t) => (a -> t) -> (b -> t)  -> [a] -> [b] -> [a]
meetBy :: (Ord t) => (a -> t) -> (b -> t)  -> [a] -> [b] -> [(a, b)]
joinBy :: (Ord t) => (a -> t) -> (a->a->a) -> [a] -> [a] -> [a]

diffBy f g xs ys = [x     | This  x   <- ordzipBy f g xs ys]
meetBy f g xs ys = [(x,y) | These x y <- ordzipBy f g xs ys]
joinBy f h xs ys = mergeThese h   `map`  ordzipBy f f xs ys

你描述的是meetBy，即集合交集运算，将两个有序列表视为集合。

编译器高效编译这些定义的能力是另一个问题。沿着ordzipBy 的行手动编码的三个集合函数可能会运行得更快。

ordzipBy f g 与align 兼容，[] 与nil 兼容，但实现它所涉及的类型机器高于我的工资等级。 :) 另外，我不清楚align (f <$> xs) (g <$> ys) = bimap f g <$> align xs ys 是否有意义，因为映射函数f 和g 可以很好地改变xs 和ys 元素的相互顺序。

这两个问题（类型和规律）是相关的：选择器函数恢复的用于排序目的的数据部分作为位置，作为形状，然而是原始数据的一部分。 （参见instance Alternative ZipList in Haskell?）。

---

更新：看看下面的工作是否符合你的预期。

{-# LANGUAGE InstanceSigs, DatatypeContexts #-}
import Data.These
import Data.Align

newtype Ord a => ZL a b = ZL {unzl :: [(a,b)]}
      deriving (Eq, Show)

instance Ord a => Functor (ZL a) where
  fmap f (ZL xs) = ZL [(k, f v) | (k,v)<-xs]

instance Ord a => Align (ZL a) where 
  nil = ZL []
  align :: (ZL a b) -> (ZL a c) -> (ZL a (These b c))
  align (ZL a) (ZL b) = ZL (g a b) where
    g a@((k,x):t) b@((n,y):r) = case compare k n of
        LT -> (k, This  x  ) : g t b 
        GT -> (n, That    y) : g a r
        EQ -> (k, These x y) : g t r  
    g a               []              = [(k, This x) | (k,x) <- a]
    g []              b               = [(n, That y) | (n,y) <- b]

diffBy :: (Ord t) => (a -> t) -> (b -> t)  -> [a] -> [b] -> [a]
meetBy :: (Ord t) => (a -> t) -> (b -> t)  -> [a] -> [b] -> [(a, b)]
joinBy :: (Ord t) => (a -> t) -> (a->a->a) -> [a] -> [a] -> [a]

diffBy f g xs ys = catThis        . map snd . unzl 
                    $ align (ZL [(f x,x) | x<-xs]) (ZL [(g y,y) | y<-ys])
meetBy f g xs ys = catThese       . map snd . unzl 
                    $ align (ZL [(f x,x) | x<-xs]) (ZL [(g y,y) | y<-ys])
joinBy f h xs ys = map (mergeThese h . snd) . unzl 
                    $ align (ZL [(f x,x) | x<-xs]) (ZL [(f y,y) | y<-ys])

虽然没有很好地处理无限列表，而手动编码的函数显然可以很容易地转换为handle such cases correctly：

*Main> diffBy id id [1..5] [4..9]
[1,2,3]
*Main> diffBy id id [1..5] [4..]
[1,2,3Interrupted.

*Main> meetBy id id [1,3..10] [2,5..20]
[(5,5)]
*Main> joinBy id const [1,3..10] [2,5..20]
[1,2,3,5,7,8,9,11,14,17,20]