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

Posted 2023-04-14

【中文标题】如何在不重复自己的情况下使该算法更懒惰？

【英文标题】：How do I make this algorithm lazier without repeating myself?

【发布时间】：2019-12-14 17:29:34

【问题描述】：

（灵感来自我对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 的情况，我们肯定知道最终的返回值将是Just，而不是Nothing，但Just 直到最后仍然不可用。我想让这个更懒惰，以便在输入GT 案例后立即使用Just。我对此的测试用例是我希望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 中。我怎样才能写出这样它是懒惰的，但又不重复自己？

【参考方案1】：

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

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

与第二个代码 sn-p 中没有 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

【参考方案2】：

从我的非惰性实现开始，我首先重构 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 并在 GT 案例中使用 id 调用自身：

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)

这仍然像以前一样工作，除了增加了懒惰的好处。

【讨论】：

是否所有位于Just 和最终(k,v) 之间的ids 都被编译器消除了？可能不是，函数应该是不透明的，并且您可以（类型可行）使用first (1+) 而不是id，因为编译器都知道。但它产生了一个 compact 代码...当然，我的代码是您在这里的分解和规范，并进行了额外的简化（消除了ids）。同样非常有趣的是，更通用的类型如何作为约束，所涉及的值之间的关系（虽然不够紧密，first (1+) 被允许作为wrap）。

（续）您的多态 precise 用于两种类型，直接对应于更详细变体中使用的两个专用函数。很好的互动。另外，我不会称此 CPS，wrap 不用作延续，它不是“在内部”构建的，而是通过递归堆叠在外部的。也许如果它被用作延续，你可以摆脱那些无关紧要的ids...顺便说一句，我们可以在这里再次看到旧的函数参数模式用作指示做什么，切换在两个行动方案之间（Just 或 id）。

【参考方案3】：

我认为您自己回答的 CPS 版本是最好的，但为了完整起见，这里还有一些想法。 （编辑：布尔的答案现在是最有效的。）

第一个想法是去掉“closestSoFar”累加器，而是让GT case 处理所有选择最右边值小于参数的逻辑。在这种形式下，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（即替换 luqui 答案中隐含的 fromJust），但这将是一个多余的、无法访问的分支。

另一种想法是算法实际上有两个“阶段”，一个在您点击GT 之前和之后一个，因此您通过布尔值对其进行参数化以表示这两个阶段，并使用依赖类型来编码不变量第二阶段总会有结果的。

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)

【讨论】：

在您指出之前，我并不认为我的答案是 CPS。我在想一些更接近工人包装转换的东西。我猜Raymond Chen strikes again!

【参考方案4】：

怎么样

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

?

【讨论】：

因为这是一个不完整的模式匹配。即使我的功能是一个整体，我也不喜欢它的部分是局部的。

所以你说“我们肯定知道”仍然有一些疑问。也许那是健康的。

我们确实知道，因为我在我的问题中的第二个代码块总是返回 Just 但是是总数。我知道您所写的解决方案实际上是完全的，但它很脆弱，因为看似安全的修改可能会导致它触底。

这也会稍微减慢程序的速度，因为 GHC 不能证明它总是Just，所以它会添加一个测试以确保它每次递归时都不是Nothing通过。

【参考方案5】：

我们不仅总是知道Just，在它第一次发现之后，我们也总是知道Nothing直到。这实际上是两种不同的“逻辑”。

所以，我们首先向左走，所以让 that 明确：

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

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