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