F#中的组合和排列

时间:2010-12-21 01:29:31

标签: f# permutation combinatorics combinations

我最近为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

3 个答案:

答案 0 :(得分:14)

如果要编写有效的功能代码,那么最好避免使用@运算符,因为列表的连接效率非常低。

以下是如何编写函数以生成所有组合的示例:

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),因此有更多选项可以做什么。

答案 1 :(得分:5)

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

编辑:好笑,我没看过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  

答案 2 :(得分:3)

如果您真的需要速度,我建议您首先找到解决问题的最快算法,如果算法本身就是必要的(例如冒泡排序或Eratosthenes的筛子),请务必使用F#内部实施的必要功能,同时保持您的API纯粹适合图书馆消费者(更多的工作和风险,但图书馆消费者的优秀成果)。

根据您的问题,我已经调整了我的快速实现,以按字典顺序(最初显示here)生成所有排列,以生成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长度排列是非常不合适的(即,是否有针对此问题的更好的命令式或功能性算法),但它的平均执行速度几乎是最新的两倍集合getPerms的{​​{1}}实现,并具有以字典方式产生r长度排列的附加功能(还注意到[1;2;3;4;5;6;7;8;9]如何作为r的函数不是单调的:)< / p>

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