如何在不重复自己的情况下使该算法变得更懒惰？

（受到我对这个问题的回答的启发。）

考虑下面的代码（它应该找到小于或等于给定输入的最大元素）：

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被输入的情况下，我们可以肯定，最终返回值将是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。我该怎么写，以免偷懒，却又不重复自己？

您可以使用类型系统，而不是使用显式包装器。需要注意的是版本 precise使用Maybe你的第一个代码片段：

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

与您的第二个代码段中precise没有的版本几乎完全相同的算法Maybe，可以在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函子开始，但是递归到分支中的Identity函子GT：

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

从我的非懒惰实现开始，我首先重构precise为接收Just作为参数，并相应地概括其类型：

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 Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> precise wrap (wrap (k, v)) r

然后，我将其更改为wrap尽早使用，并id在这种GT情况下自行调用：

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 Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> wrap (precise id (k, v) r)

除了增加了懒惰的好处外，这仍然与以前完全一样。

我认为您自己回答的CPS版本是最好的，但是为了完整起见，这里还有其他一些建议。（编辑：Buhr的回答现在表现最好。）

第一个想法是摆脱“ closestSoFar”累加器，而让GT案例处理所有逻辑，以选择比参数最小的最右边的值。以这种形式，GT案例可以直接返回Just：

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

这比较简单，但是在遇到很多GT情况时，会在堆栈上占用更多的空间。从技术上讲，您甚至可以fromMaybe以累加器形式使用它（即，替换fromJustluqui的答案中的隐式），但这将是一个冗余的，无法访问的分支。

另一个想法是算法实际上有两个“阶段”，一个在敲击a之前，一个在敲击a之后GT，因此您可以通过布尔值对它进行参数化以表示这两个阶段，并使用相关类型来编码始终存在a的不变量。进入第二阶段。

data SBool (b :: Bool) where
  STrue :: SBool 'True
  SFalse :: SBool 'False

type family MaybeUnless (b :: Bool) a where
  MaybeUnless 'True a = a
  MaybeUnless 'False a = Maybe a

ret :: SBool b -> a -> MaybeUnless b a
ret SFalse = Just
ret STrue = id

closestLess2 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess2 i = precise SFalse Nothing where
  precise :: SBool b -> MaybeUnless b (Integer, v) -> TreeMap v -> MaybeUnless b (Integer, v)
  precise _ closestSoFar Leaf = closestSoFar
  precise b closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise b closestSoFar l
    EQ -> ret b (k, v)
    GT -> ret b (precise STrue (k, v) r)

怎么样

GT -> let Just v = precise (Just (k,v) r) in Just v

？

我们不仅一直都知道Just，经过了第一次的发现，我们也总是知道Nothing ，直到然后。这实际上是两个不同的“逻辑”。

所以，我们去首先离开，所以要的是明确的：

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 = goLeft 
  where
  goLeft :: TreeMap v -> Maybe (Integer, v)
  goLeft n@(Node k v l _) = case i `compare` k of
          LT -> goLeft l
          _  -> Just (precise (k, v) n)
  goLeft Leaf = Nothing

  -- no more maybe if we're here
  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

价格是我们最多重复一个步骤最多一次。