haskell - "symmetric"函数的模式

Question

按照建议尝试这个新的stackoverflow :) 这并不是haskell 特有的，但它在haskell 中是最清楚的。

这是一个每隔一段时间就会出现的模式:一个函数接受两个对称处理的参数。 mappends 经常有这个属性。一个例子:

-- | Merge sorted lists of ranges.
merge :: (Ord n) => [(n, n)] -> [(n, n)] -> [(n, n)]
merge [] r2 = r2
merge r1 [] = r1
merge r1@((s1, e1) : rest1) r2@((s2, e2) : rest2)
    | e1 < s2 = (s1, e1) : merge rest1 r2
    | e2 < s1 = (s2, e2) : merge r1 rest2
    | s1 >= s2 && e1 <= e2 = merge rest1 r2 -- 1 within 2
    | s2 >= s1 && e2 <= e1 = merge r1 rest2 -- 2 within 1
    | e1 > e2 = merge (merged : rest1) rest2
    | otherwise = merge rest1 (merged : rest2)
    where merged = (min s1 s2, max e1 e2)

请注意，“r1”和“r2”的处理是对称的。实际上只有 4 种情况:与 null 合并会产生非 null 的情况，不重叠会产生不变的范围，包含在另一个中的一个会抛出包含的范围，重叠会创建一个合并的范围并尝试将其与其余的合并。

然而，每个案例都有一个镜像变体，因此最终为 8，即使镜子 4 可以机械衍生。不仅有两倍的出错空间，而且由于对称性，错误不会被类型检查器发现。这种模式有名字吗？一种消除重复的方法？我想我可以尝试为一个列表定义它，然后写'mappend a b = mconcat [a，b]'，但这个问题对我来说更难以一般形式思考(例如，它让我头疼尝试考虑将合并的间隔放回哪个列表)。定义 mappend 然后将 mconcat 排除在外要容易得多。也许有更好的方法来考虑列表版本以避免头部受伤？

我想我想做的是“专注”一个案例，这样我就可以用“这个”和“那个”来写。这不仅比两个同等特权的 'r1' 和 'r2' 更容易想到，而且 that->this 的情况应该从 this->that 中隐含。

Answer 1

诀窍是你融合了两个单独的步骤。第一步只是合并列表。第二个是合并间隔，使它们不重叠。把这两个步骤分解出来，一切都变得简单了。

mergeList (x@(s1,_):xs) (y@(s2,_):ys) = case compare s1 s2 of
      LT -> x : merge xs (y:ys)
      GT -> y : merge (x:xs) ys
      EQ -> x : y : merge xs ys
mergeList xs ys = xs ++ ys

mergeRuns (x@(s1,e1):x'@(s2,e2):xs) 
    | e1 < s2   = x : mergeRuns (x':xs) -- x is less than and nonoverlapping
    | otherwise = mergeRuns ((s1, max e1 e2) : xs) -- there is overlap
mergeRuns x = x

merge xs ys = mergeRuns $ mergeList xs ys

(未经测试)

如果您添加一些内联编译指示，ghc 应该会为您生成更多融合的代码。否则，您可以手动融合它们以获得更庞大但更有效的实现。我们的，您可以保留它，因为无论如何它应该非常有效。

另一种方法是编写一个函数 mergeCons :: (n,n) -> [(n,n)] -> [(n,n)] (实际上只是 mergeRuns 的一种变体)，然后将其替换为 mergeList 中的标准缺点功能。这将使关于内联的推理更容易一些。这是一些演示该解决方案的代码(再次未经测试):

mergeCons x@(s1,e1) (x'@(s2,e2):xs) 
    | e1 < s2   = x : (x':xs) -- x is less than and nonoverlapping
    | otherwise = (s1, max e1 e2) `mergeCons` xs -- there is overlap
mergeCons x [] = [x]

merge' (x@(s1,_):xs) (y@(s2,_):ys) = case compare s1 s2 of
      LT -> x `mergeCons` merge xs (y:ys)
      GT -> y `mergeCons` merge (x:xs) ys
      EQ -> x `mergeCons` y `mergeCons` merge xs ys
merge' xs ys = xs ++ ys