"对称"函数的模式

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值,不重叠产生范围不变,一个包含在另一个中抛出包含范围,重叠创建合并范围并尝试将其与其余范围合并.

然而,每种情况都具有镜像变体,因此即使镜子4可以机械地推导出来也是8.不仅有两倍的错误空间,由于对称性,错误将不会被类型检查员捕获.这个模式有名字吗？一种分解重复的方法？我想我可以尝试为列表定义它然后写'mappend ab = mconcat [a,b]',但问题是我在一般形式中想的更难(例如,它让我受伤了试着想一下将合并后的区间放回去的列表.定义mappend然后从中获取mconcat要容易得多.也许有更好的方法来考虑列表版本,以避免头部受伤？

我认为我想做的是"关注"一个案例,所以我可以用"this"和"that"来写.这不仅比两个同等特权的'r1'和'r2'更容易想到,那个 - >这个案例应该隐含在这个 - >那一个.

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