如何使此函数延迟地消耗其输入比特流？

Question

我想象一个函数，形如

takeChunkUntil :: [a] -> ([a] -> Bool) -> ([a], [a])

希望是惰性的。

它从第一个列表中取出元素，直到它们满足谓词，然后返回该子列表以及剩余的元素。

回答一些问题：

最终目标是制作一个可以懒惰地读取Huffman codes的东西。因此，如果您有一个位字符串，这里表示为Bool，bs，您可以编写take n $ decode huffmanTree bs来获取前n个编码值，同时只消耗必要的bs。如果您愿意，我会发布更多详细信息和我的尝试解决方案。这可能会很长：）（请注意，我是一名导师，是一位学生给我提出了这个问题，但我没有帮助他，因为这超出了我的能力，但现在我非常好奇。）

继续：

Huffman树的定义：

data BTree a = Leaf a | Fork (BTree a) (BTree a) deriving (Show, Eq)

目标：编写一个懒解码函数，它返回已解码值的一对和一个布尔值，指示是否有任何剩余值未完全解码为值。注意：我们使用Bool表示一个位：True = 1，False = 0。

decode :: BTree a -> [Bool] -> ([a], Bool)

这是要点：我写的第一个函数是解码一个值的函数。如果输入列表为空，则返回“Nothing”，否则返回已解码的值和剩余的“位”。

decode1 :: BTree a -> [Bool] -> Maybe (a, [Bool])
decode1 (Leaf v) bs = Just (v, bs)
decode1 _ [] = Nothing
decode1 (Fork left right) (b:bs) 
  | b         = decode1 right bs
  | otherwise = decode1 left bs

首先，我认为我需要一些尾递归才能使其变得懒惰。这里是不起作用的东西。我认为它不起作用。注意它是递归的，但我正在传递“到目前为止解码的符号”的列表并附加新符号。低效，也许（如果我的理解是正确的）不会导致尾递归。

decodeHelp :: BTree a -> [a] -> [Bool] -> ([a],Bool)
decodeHelp t symSoFar bs = case decode1 t bs of
    Nothing -> (symSoFar,False)
    Just (s,remain) -> decodeHelp t (symSoFar ++ [s]) remain

所以我想，我怎样才能写出一种更好的递归方式，在其中解码一个符号并将其附加到下一个调用中？关键是返回一个 [Maybe a] 列表，其中 Just a 是成功解码的符号，Nothing 表示无法解码符号（即剩余布尔值不足）

decodeHelp2 :: BTree a -> [Bool] -> [Maybe a]
decodeHelp2 t bs = case decode1 t bs of
    Nothing -> [Nothing]
    Just (s, remain) -> case remain of
        [] -> []
        -- in the following line I can just cons Just s onto the
        -- recursive call. My understand is that's what make tail
        -- recursion work and lazy.
        _  -> Just s : decodeHelp2 t remain 

但是显然这不是问题集想要的结果。我该如何将所有这些[Maybe a]转换为([a], Bool)？我的第一个想法是应用scanl

这是扫描函数。它将Maybe a累积成([a], Bool)

sFunc :: ([a], Bool) -> Maybe a -> ([a], Bool)
sFunc (xs, _) Nothing = (xs, False)
sFunc (xs, _) (Just x) = (xs ++ [x], True)

然后你可以写

decodeSortOf :: BTree a -> [Bool] -> [([a], Bool)]
decodeSortOf t bs = scanl sFunc ([],True) (decodeHelp2 t bs)

我验证了这个方法是可行的且很懒：

take 3 $ decodeSortOf xyz_code [True,False,True,True,False,False,False,error "foo"] 的输出为 [("",True),("y",True),("yz",True)]

但这不是期望的结果。求助，我被卡住了！

- composerMike

---

你能展示其中一种尴尬的实现吗？ - Willem Van Onsem

@WillemVanOnsem，它是满足谓词的组。这是一个本质上低效的函数。 - dfeuer

@dfeuer: 是的，但并不是非惰性的 :) - Willem Van Onsem

@WillemVanOnsem 我从来没有让它们工作过，因此也没打算复制进去。但这可能是有益的。 - composerMike

@composerMike：这些（并不完全）工作的事实并不那么重要。通常它有助于展示可以改进的地方 :) - Willem Van Onsem

如果 takeChunkUntil 的谓词从未被满足，它应该返回什么？ - chepner

Answer 1

这里有一个提示。我已经交换了参数顺序，以得到更具惯用性的内容，并改变了结果类型以反映您可能找不到可接受块的事实。

import Data.List (inits, tails)

takeChunkUntil :: ([a] -> Bool) -> [a] -> Maybe ([a], [a])
takeChunkUntil p as = _ $ zip (inits as) (tails as)

- dfeuer

---

感谢您提出的关于压缩inits和tails的好主意。inits和tails是惰性的吗？它们必须是的。我认为您把find (p . fst)放到了空洞中，对此表示感谢。这样做更有趣！ - composerMike

你真的不需要 Maybe，是吗？我认为对于输入列表 x，(x, []) 和 Nothing 没有任何区别。 - chepner

@chepner，这两者显然是有区别的，即：Just (x, []) 表示 x 满足谓词，而 Nothing 则表示不满足。 - Daniel Wagner

我认为这个函数更像是 take，即 take n == fst . takeChunkUntil (\ys -> length ys == n)；如果你在不满足谓词的情况下到达列表的末尾，你只需取整个列表。 - chepner

@chepner，我想看看这个函数的用例，以确定使用这两个边界选项中的哪一个。 - luqui

@luqui同意。问题描述模糊，暗示着存在一个令人满意的前缀。 - chepner

Answer 2

我们可以在这里使用显式递归，如果满足谓词，我们就将其添加到元组的第一个项中。否则，我们将剩余列表放入2元组的第二个项中。例如：

import Control.Arrow(first)

takeChunkUntil :: ([a] -> Bool) -> [a] -> ([a], [a])
takeChunkUntil p = go []
    where go _ [] = ([], [])
          go gs xa@(x:xs) | not (p (x:gs)) = first (x:) (go (x:gs) xs)
                          | otherwise = ([], xa)

我们这里假设元素在群组中的顺序对谓词不相关（因为我们每次都是以相反的顺序传递列表）。如果这很重要，我们可以使用差异列表。我将其留作练习。

这也适用于无限列表，例如：

Prelude Control.Arrow> take 10 (fst (takeChunkUntil (const False) (repeat 1)))
[1,1,1,1,1,1,1,1,1,1]

- Willem Van Onsem