一种更快地生成具有给定长度的组合的方法，保留顺序

Question

TL;DR：我想要filter ((== 4) . length) . subsequences 的确切行为。仅使用subsequences 也会创建可变长度的列表，这需要大量时间来处理。由于最后只需要长度为 4 的列表，因此我认为必须有更快的方法。

---

我有一个函数列表。该列表的类型为[Wor -> Wor]

列表看起来像这样

[f1, f2, f3 .. fn]

我想要的是n 函数列表，同时保持这样的顺序

输入：[f1, f2, f3 .. fn]

参数：4 个函数

输出：4 个函数的列表。

如果子列表中有f1，则预期输出将始终位于列表的head。

如果子列表中有f2，并且如果子列表没有f1，则f2 将位于head。如果fn 在子列表中，它将位于last。

一般来说，如果列表中有 fx，它永远不会在 f(x - 1) 前面。

在生成子列表时基本保持主列表的顺序。

可以假设列表的长度总是大于给定参数。

我刚刚开始学习 Haskell，所以我没有尝试过那么多，但到目前为止，我尝试过的是这样的：

使用subsequences 函数并在其上应用(filter (== 4) . length) 的生成排列似乎会生成正确的排列-但它不会保留顺序-（它保留了顺序，我将它与我自己的函数混淆了）。

那我该怎么办？

如果可能的话，Hackage 或 Stackage 中是否存在可以执行此操作的函数或函数组合？因为我想了解来源。

Answer 1

你描述了一个不确定的take：

ndtake :: Int -> [a] -> [[a]]
ndtake 0 _      = [[]]
ndtake n []     = []
ndtake n (x:xs) = map (x:) (ndtake (n-1) xs) ++ ndtake n xs

我们要么接受x，要么从xs 获得更多n-1；或者我们不使用x，而是从xs 中获取更多n 元素。

跑步：

> ndtake 3 [1..4]
[[1,2,3],[1,2,4],[1,3,4],[2,3,4]]

---

更新：您想要效率。如果我们确定输入列表是有限的，我们可以尽快停止：

ndetake n xs = go (length xs) n xs
    where
    go spare n _  | n >  spare = []
    go spare n xs | n == spare = [xs]
    go spare 0 _      =  [[]]
    go spare n []     =  []
    go spare n (x:xs) =  map (x:) (go (spare-1) (n-1) xs) 
                            ++     go (spare-1)  n   xs

尝试一下：

> length $ ndetake 443 [1..444]
444

前一个版本似乎卡在这个输入上，但后一个立即返回。

---

但是，正如 cmets 中的 @dfeuer 所指出的，它测量了整个列表的长度，而且是不必要的。我们可以在保持更多惰性的同时实现同样的效率提升：

ndzetake :: Int -> [a] -> [[a]]
ndzetake n xs | n > 0 = 
    go n (length (take n xs) == n) (drop n xs) xs
    where
    go n b p ~(x:xs)
         | n == 0 = [[]]
         | not b  = []
         | null p = [(x:xs)]
         | otherwise = map (x:) (go (n-1) b p xs)
                          ++ go n b (tail p) xs

现在最后一个测试也可以立即使用此代码。

这里还有改进的余地。与库函数subsequences 一样，可以更懒惰地探索搜索空间。现在我们有

> take 9 $ ndzetake 3 [1..]
[[1,2,3],[1,2,4],[1,2,5],[1,2,6],[1,2,7],[1,2,8],[1,2,9],[1,2,10],[1,2,11]]

但它可能会在将5 强制退出输入列表之前找到[2,3,4]。我们要把它留作练习吗？

Answer 2

这是我能想到的最好的。它回答了 Will Ness 提出的在输入中尽可能懒惰的挑战。特别是，ndtake m ([1..n]++undefined) 将在抛出异常之前生成尽可能多的条目。此外，它力求最大化结果列表之间的共享（注意end 在ndtakeEnding' 中的处理）。它避免了使用差异列表添加不平衡列表的问题。这个基于序列的版本比我想出的任何纯列表版本都要快得多，但我并没有解释为什么会这样。我觉得通过更好地了解正在发生的事情可能会做得更好，但这似乎效果很好。

这是总体思路。假设我们要求ndtake 3 [1..5]。我们首先生成所有以3 结尾的结果（其中有一个）。然后我们生成所有以4 结尾的结果。我们通过（基本上）调用ndtake 2 [1..3] 并将4 添加到每个结果中来做到这一点。我们以这种方式继续，直到我们没有更多的元素。

import qualified Data.Sequence as S
import Data.Sequence (Seq, (|>))
import Data.Foldable (toList)

我们将使用以下简单的实用函数。它与“安全”包中的splitAtExactMay 几乎相同，但希望更容易理解。由于我尚未调查的原因，当它的参数为否定时让它产生结果会导致ndtake 与否定参数等效于subsequences。如果需要，您可以轻松更改 ndtake 以针对否定参数执行其他操作。

-- to return an empty list in the negative case.
splitAtMay :: Int -> [a] -> Maybe ([a], [a])
splitAtMay n xs
  | n <= 0 = Just ([], xs)
splitAtMay _ [] = Nothing
splitAtMay n (x : xs) = flip fmap (splitAtMay (n - 1) xs) $
  \(front, rear) -> (x : front, rear)

现在我们真正开始了。 ndtake 是使用 ndtakeEnding 实现的，它会产生一种“差异列表”，从而可以廉价地连接所有部分结果。

ndtake :: Int -> [t] -> [[t]]
ndtake n xs = ndtakeEnding n xs []

ndtakeEnding :: Int -> [t] -> ([[t]] -> [[t]])
ndtakeEnding 0 _xs = ([]:)
ndtakeEnding n xs = case splitAtMay n xs of
    Nothing -> id -- Not enough elements
    Just (front, rear) ->
        (front :) . go rear (S.fromList front)
  where
    -- For each element, produce a list of all combinations
    -- *ending* with that element.
    go [] _front = id
    go (r : rs) front =
      ndtakeEnding' [r] (n - 1) front
        . go rs (front |> r)

ndtakeEnding 不递归调用自己。相反，它调用ndtakeEnding' 来计算前面部分的组合。 ndtakeEnding' 非常像 ndtakeEnding，但有一些不同：

1. 我们使用Seq 而不是列表来表示输入序列。这让我们可以廉价地拆分和 snoc，但我还不确定为什么在这种情况下，这似乎提供了更好的摊销性能。
2. 我们已经知道输入序列足够长，所以我们不需要检查。
3. 我们传递了一个尾部 (end) 以添加到每个结果中。这让我们在可能的情况下共享尾巴。共享尾巴的机会很多，因此可以预期这将是一个实质性的优化。
4. 我们使用foldr 而不是模式匹配。使用模式匹配手动执行此操作可提供更清晰的代码，但常数因子更差。这是因为从Data.Sequence 导出的:<| 和:|> 模式是不平凡的模式同义词，它们执行一些计算，包括摊销O(1) 分配，以构建尾部或初始段，而折叠不不需要构建这些。

注意：ndtakeEnding' 的这种实现适用于最近的 GHC 和容器；对于早期版本，它似乎效率较低。这可能是 Donnacha Kidney 在foldr 上为Data.Sequence 所做的工作。在早期版本中，手动模式匹配可能更有效，对不提供模式同义词的版本使用 viewl。

ndtakeEnding' :: [t] -> Int -> Seq t -> ([[t]] -> [[t]])
ndtakeEnding' end 0 _xs = (end:)
ndtakeEnding' end n xs = case S.splitAt n xs of
     (front, rear) ->
        ((toList front ++ end) :) . go rear front
  where
    go = foldr go' (const id) where
      go' r k !front = ndtakeEnding' (r : end) (n - 1) front . k (front |> r)
    -- With patterns, a bit less efficiently:
    -- go Empty _front = id
    -- go (r :<| rs) !front =
    --  ndtakeEnding' (r : end) (n - 1) front
    --    . go rs (front :|> r)