haskell - 如何使这个算法更加懒惰而不重复自己？

Question

(受到我对 this question 的回答的启发。)

考虑这段代码(它应该找到小于或等于给定输入的最大元素):

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing where
  precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
  precise closestSoFar Leaf = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise closestSoFar l
    EQ -> Just (k, v)
    GT -> precise (Just (k, v)) r

这并不是很懒。一旦GT输入 case 后，我们确定最终的返回值将是 Just一些东西而不是Nothing ，但是Just直到最后仍然无法使用。我想让这个变得更懒，这样 Just立即可用 GT输入案例。我对此的测试用例是我想要 Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)评估为 True而不是触底。这是我可以想到的一种方法:

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess _ Leaf = Nothing
closestLess i (Node k v l r) = case i `compare` k of
  LT -> closestLess i l
  EQ -> Just (k, v)
  GT -> Just (precise (k, v) r)
  where
    precise :: (Integer, v) -> TreeMap v -> (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> (k, v)
      GT -> precise (k, v) r

但是，我现在重复一遍:核心逻辑现在都在 closestLess 中。并在 precise 。我怎样才能写得既懒惰又不重复自己？

Answer 1

您可以利用类型系统，而不是使用显式包装器。请注意，使用 Maybe 作为第一个代码片段的 precise 版本:

precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Just (k, v)
  GT -> precise (Just (k, v)) r

与第二个代码片段中没有 Maybe 的 precise 版本几乎完全相同，可以将其写入 Identity仿函数为:

precise :: Identity (Integer, v) -> TreeMap v -> Identity (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Identity (k, v)
  GT -> precise (Identity (k, v)) r

这些可以在Applicative中统一为一个版本多态:

precise :: (Applicative f) => f (Integer, v) -> TreeMap v -> f (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> pure (k, v)
  GT -> precise (pure (k, v)) r

这本身并没有多大作用，但是如果我们知道 GT 分支将始终返回一个值，我们可以强制它在 Identity 中运行仿函数，无论起始仿函数如何。也就是说，我们可以从 Maybe 仿函数开始，但递归到 GT 分支中的 Identity 仿函数:

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing
  where
    precise :: (Applicative t) => t (Integer, v) -> TreeMap v -> t (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> pure (k, v)
      GT -> pure . runIdentity $ precise (Identity (k, v)) r

这适用于您的测试用例:

> isJust $ closestLess 5 (Node 3 () Leaf undefined)
True

这是多态递归的一个很好的例子。

从性能角度来看，这种方法的另一个好处是 -ddump-simpl 显示没有包装器或字典。通过两个仿函数的专门函数，所有这些都在类型级别被删除了:

closestLess
  = \ @ v i eta ->
      letrec {
        $sprecise
        $sprecise
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise closestSoFar l;
                    EQ -> (k, v2) `cast` <Co:5>;
                    GT -> $sprecise ((k, v2) `cast` <Co:5>) r
                  }
              }; } in
      letrec {
        $sprecise1
        $sprecise1
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise1 closestSoFar l;
                    EQ -> Just (k, v2);
                    GT -> Just (($sprecise ((k, v2) `cast` <Co:5>) r) `cast` <Co:4>)
                  }
              }; } in
      $sprecise1 Nothing eta