F# 中的组合和排列

Question

我最近为 F# 项目编写了以下组合和排列函数，但我很清楚它们还远未优化。

/// Rotates a list by one place forward.
let rotate lst =
    List.tail lst @ [List.head lst]

/// Gets all rotations of a list.
let getRotations lst =
    let rec getAll lst i = if i = 0 then [] else lst :: (getAll (rotate lst) (i - 1))
    getAll lst (List.length lst)

/// Gets all permutations (without repetition) of specified length from a list.
let rec getPerms n lst = 
    match n, lst with
    | 0, _ -> seq [[]]
    | _, [] -> seq []
    | k, _ -> lst |> getRotations |> Seq.collect (fun r -> Seq.map ((@) [List.head r]) (getPerms (k - 1) (List.tail r)))

/// Gets all permutations (with repetition) of specified length from a list.
let rec getPermsWithRep n lst = 
    match n, lst with
    | 0, _ -> seq [[]]
    | _, [] -> seq []
    | k, _ -> lst |> Seq.collect (fun x -> Seq.map ((@) [x]) (getPermsWithRep (k - 1) lst))
    // equivalent: | k, _ -> lst |> getRotations |> Seq.collect (fun r -> List.map ((@) [List.head r]) (getPermsWithRep (k - 1) r))

/// Gets all combinations (without repetition) of specified length from a list.
let rec getCombs n lst = 
    match n, lst with
    | 0, _ -> seq [[]]
    | _, [] -> seq []
    | k, (x :: xs) -> Seq.append (Seq.map ((@) [x]) (getCombs (k - 1) xs)) (getCombs k xs)

/// Gets all combinations (with repetition) of specified length from a list.
let rec getCombsWithRep n lst = 
    match n, lst with
    | 0, _ -> seq [[]]
    | _, [] -> seq []
    | k, (x :: xs) -> Seq.append (Seq.map ((@) [x]) (getCombsWithRep (k - 1) lst)) (getCombsWithRep k xs)

有人对如何加速这些函数（算法）有任何建议吗？我对如何改进排列（有重复和没有重复）特别感兴趣。回想起来，涉及列表轮换的业务在我看来效率不太高。

更新

这是我对 getPerms 函数的新实现，灵感来自 Tomas 的答案。

不幸的是，它并不比现有的快。建议？

let getPerms n lst =
    let rec getPermsImpl acc n lst = seq {
        match n, lst with
        | k, x :: xs ->
            if k > 0 then
                for r in getRotations lst do
                    yield! getPermsImpl (List.head r :: acc) (k - 1) (List.tail r)
            if k >= 0 then yield! getPermsImpl acc k []
        | 0, [] -> yield acc
        | _, [] -> ()
        }
    getPermsImpl List.empty n lst

Answer 1

如果您想编写高效的函数代码，那么最好避免使用 @ 运算符，因为列表的串联效率非常低。

下面是如何编写一个函数来生成所有组合的示例：

let rec combinations acc size set = seq {
  match size, set with 
  | n, x::xs -> 
      if n > 0 then yield! combinations (x::acc) (n - 1) xs
      if n >= 0 then yield! combinations acc n xs 
  | 0, [] -> yield acc 
  | _, [] -> () }

combinations [] 3 [1 .. 4]

该函数的参数为​​：

• acc 用于记住已选择要包含在组合中的元素（最初是一个空列表）
• size 是我们需要添加到 acc 的元素的剩余数量（最初这是组合所需的大小）
• set 是可供选择的集合元素

该功能是使用简单的递归实现的。如果我们需要生成大小为 n 的组合，那么我们可以添加或不添加当前元素，因此我们尝试使用这两个选项（第一种情况）生成组合并将它们全部添加到使用 yield! 生成序列。如果我们还需要 0 个元素，那么我们成功生成了一个组合（第二种情况），如果我们以其他数字结尾但没有任何剩余元素可供使用，那么我们无法返回任何内容（最后一种情况）。

与重复的组合是类似的 - 不同之处在于您不需要从列表中删除元素（通过在递归调用中仅使用 xs ），因此有更多的选择。

Answer 2

我注意到您更新的 getPerms 函数包含重复项。这是我对无欺骗版本的破解。希望这些评论不言而喻。最难的部分是编写一个高效的 distrib 函数，因为必须在某个地方使用串联运算符。幸运的是，它仅用于小型子列表，因此性能仍然合理。下面的 getAllPerms 代码在大约四分之一秒内生成 [1..9] 的所有排列，在大约 2.5 秒内生成所有 10 元素排列。

编辑：有趣，我没有看 Tomas 的代码，但他的组合函数和我的选择函数几乎相同。

// All ordered picks {x_i1, x_i2, .. , x_ik} of k out of n elements {x_1,..,x_n}
// where i1 < i2 < .. < ik
let picks n L = 
    let rec aux nleft acc L = seq {
        match nleft,L with
        | 0,_ -> yield acc
        | _,[] -> ()
        | nleft,h::t -> yield! aux (nleft-1) (h::acc) t
                        yield! aux nleft acc t }
    aux n [] L

// Distribute an element y over a list:
// {x1,..,xn} --> {y,x1,..,xn}, {x1,y,x2,..,xn}, .. , {x1,..,xn,y}
let distrib y L =
    let rec aux pre post = seq {
        match post with
        | [] -> yield (L @ [y])
        | h::t -> yield (pre @ y::post)
                  yield! aux (pre @ [h]) t }
    aux [] L

// All permutations of a single list = the head of a list distributed
// over all permutations of its tail
let rec getAllPerms = function
    | [] -> Seq.singleton []
    | h::t -> getAllPerms t |> Seq.collect (distrib h)

// All k-element permutations out of n elements = 
// all permutations of all ordered picks of length k combined
let getPerms2 n lst = picks n lst |> Seq.collect getAllPerms

编辑：响应评论的更多代码

// Generates the cartesian outer product of a list of sequences LL
let rec outerProduct = function
    | [] -> Seq.singleton []
    | L::Ls -> L |> Seq.collect (fun x -> 
                outerProduct Ls |> Seq.map (fun L -> x::L))

// Generates all n-element combination from a list L
let getPermsWithRep2 n L = 
    List.replicate n L |> outerProduct  

Answer 3

如果您确实需要速度，我鼓励您首先为您的问题找到最快的算法，并且如果该算法本质上是命令式的（例如冒泡排序或埃拉托斯特尼筛法），请务必使用 F# 的命令式功能用于您的内部实现，同时保持您的 API 对于库使用者来说是纯粹的（您需要做更多的工作和风险，但对于库使用者来说效果很好）。

针对您的问题，我已经调整了我的快速实现，用于按字典顺序生成一组排列的所有排列（最初提出此处）生成 r 长度排列：

open System
open System.Collections.Generic

let flip f x y = f y x

///Convert the given function to an IComparer<'a>
let comparer f = { new IComparer<_> with member self.Compare(x,y) = f x y }

///generate r-length lexicographical permutations of e using the comparison function f.
///permutations start with e and continue until the last lexicographical permutation of e:
///if you want all permuations for a given set, make sure to order e before callings this function.
let lexPerms f r e =
    if r < 0 || r > (Seq.length e) then
        invalidArg "e" "out of bounds" |> raise

    //only need to compute IComparers used for Array.Sort in-place sub-range overload once
    let fComparer = f |> comparer
    let revfComparer = f |> flip |> comparer

    ///Advances (mutating) perm to the next lexical permutation.
    let lexPermute perm =
        //sort last perm.Length - r elements in decreasing order,
        //thereby avoiding duplicate permutations of the first r elements
        //todo: experiment with eliminate this trick and instead concat all
        //lex perms generated from ordered combinations of length r of e (like cfern)
        Array.Sort(perm, r, Array.length perm - r, revfComparer)

        //Find the index, call it s, just before the longest "tail" that is
        //ordered  in decreasing order ((s+1)..perm.Length-1).
        let rec tryFind i =
            if i = 0 then
                None
            elif (f perm.[i] perm.[i-1]) >= 0 then
                Some(i-1)
            else
                tryFind (i-1)

        match tryFind (perm.Length-1) with
        | Some s ->
            let sValue = perm.[s]

            //Change the value just before the tail (sValue) to the
            //smallest number bigger than it in the tail (perm.[t]).
            let rec find i imin =
                if i = perm.Length then
                    imin
                elif (f perm.[i] sValue) > 0 && (f perm.[i] perm.[imin]) < 0 then
                    find (i+1) i
                else
                    find (i+1) imin

            let t = find (s+1) (s+1)

            perm.[s] <- perm.[t]
            perm.[t] <- sValue

            //Sort the tail in increasing order.
            Array.Sort(perm, s+1, perm.Length - s - 1, fComparer)
            true
        | None ->
            false

    //yield copies of each perm
    seq {
        let e' = Seq.toArray e
        yield e'.[..r-1]
        while lexPermute e' do
            yield e'.[..r-1]
    }

let lexPermsAsc r e = lexPerms compare r e
let lexPermsDesc r e = lexPerms (flip compare) r e

我不确定将此算法适应 r 长度排列是否非常不合适（即是否有更好的命令式或函数式算法）对于这个问题），但平均而言，它的执行速度几乎是 [1;2;3;4;5;6;7; 集合的最新 getPerms 实现的两倍。 8;9]，并且具有按字典顺序生成 r 长度排列的附加功能（还有趣地注意 lexPermsAsc 作为 r 的函数如何不是单调的）：

r       lexPermsAsc(s)  getPerms(s)
1       0.002           0.002
2       0.004           0.002
3       0.019           0.007
4       0.064           0.014
5       0.264           0.05
6       0.595           0.307
7       1.276           0.8
8       1.116           2.247
9       1.107           4.235
avg.:   0.494           0.852