“对称”图案功能

Question

按照建议尝试这个新的 stackoverflow 东西:) 这并不是真正特定于 haskell 的，但它在 haskell 中是最清楚的。

这是一个时不时出现的模式：一个函数接受两个对称处理的参数。 mappend 经常具有此属性。示例：

-- | 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 ab = 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 函数中的标准 cons。这将使内联的推理变得更加容易。这是一些演示该解决方案的代码（再次未经测试）：

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

Answer 2

这不是针对您的特定情况的解决方案，但一般来说，对于交换函数，您可以在参数上定义一些任意顺序，然后让您的函数使用翻转的参数调用自身（如果它们处于“错误”顺序）。