Расчет перестановок в F#
6 ответов
Вы также можете написать что-то вроде этого:
let rec permutations list taken =
seq { if Set.count taken = List.length list then yield [] else
for l in list do
if not (Set.contains l taken) then
for perm in permutations list (Set.add l taken) do
yield l::perm }
Аргумент "список" содержит все числа, которые вы хотите переставить, а "взятый" является набором, который содержит номера уже используются. Функция возвращает пустой список, когда все числа заняты. В противном случае он выполняет итерацию по всем числам, которые все еще доступны, получает все возможные перестановки оставшихся чисел (рекурсивно, используя "перестановки") и добавляет текущее число к каждому из них перед возвратом (l::perm).
Чтобы запустить это, вы дадите ему пустой набор, потому что в начале номера не используются:
permutations [1;2;3] Set.empty;;
Мне нравится эта реализация (но я не могу вспомнить ее источник):
let rec insertions x = function
| [] -> [[x]]
| (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
let rec permutations = function
| [] -> seq [ [] ]
| x :: xs -> Seq.concat (Seq.map (insertions x) (permutations xs))
Решение Томаса довольно элегантно: оно короткое, чисто функциональное и ленивое. Я думаю, что это может быть даже хвостовой рекурсии. Кроме того, он производит перестановки лексикографически. Тем не менее, мы можем улучшить производительность в два раза, используя императивное решение внутри, при этом оставляя внешний интерфейс функциональным.
Функция permutations занимает общую последовательность e а также общая функция сравнения f : ('a -> 'a -> int) и лениво дает неизменные перестановки лексикографически. Функциональность сравнения позволяет нам генерировать перестановки элементов, которые не обязательно comparable а также легко указать обратный или пользовательские заказы.
Внутренняя функция permute является императивной реализацией алгоритма, описанного здесь. Функция преобразования let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } позволяет нам использовать System.Array.Sort перегрузка, которая делает на месте под-диапазон пользовательских сортировок, используя IComparer,
let permutations f e =
///Advances (mutating) perm to the next lexical permutation.
let permute (perm:'a[]) (f: 'a->'a->int) (comparer:System.Collections.Generic.IComparer<'a>) : bool =
try
//Find the longest "tail" that is ordered in decreasing order ((s+1)..perm.Length-1).
//will throw an index out of bounds exception if perm is the last permuation,
//but will not corrupt perm.
let rec find i =
if (f perm.[i] perm.[i-1]) >= 0 then i-1
else find (i-1)
let s = find (perm.Length-1)
let s' = perm.[s]
//Change the number just before the tail (s') 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] s') > 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] <- s'
//Sort the tail in increasing order.
System.Array.Sort(perm, s+1, perm.Length - s - 1, comparer)
true
with
| _ -> false
//permuation sequence expression
let c = f |> comparer
let freeze arr = arr |> Array.copy |> Seq.readonly
seq { let e' = Seq.toArray e
yield freeze e'
while permute e' f c do
yield freeze e' }
Теперь для удобства имеем следующее где let flip f x y = f y x:
let permutationsAsc e = permutations compare e
let permutationsDesc e = permutations (flip compare) e
Мой последний лучший ответ
//mini-extension to List for removing 1 element from a list
module List =
let remove n lst = List.filter (fun x -> x <> n) lst
//Node type declared outside permutations function allows us to define a pruning filter
type Node<'a> =
| Branch of ('a * Node<'a> seq)
| Leaf of 'a
let permutations treefilter lst =
//Builds a tree representing all possible permutations
let rec nodeBuilder lst x = //x is the next element to use
match lst with //lst is all the remaining elements to be permuted
| [x] -> seq { yield Leaf(x) } //only x left in list -> we are at a leaf
| h -> //anything else left -> we are at a branch, recurse
let ilst = List.remove x lst //get new list without i, use this to build subnodes of branch
seq { yield Branch(x, Seq.map_concat (nodeBuilder ilst) ilst) }
//converts a tree to a list for each leafpath
let rec pathBuilder pth n = // pth is the accumulated path, n is the current node
match n with
| Leaf(i) -> seq { yield List.rev (i :: pth) } //path list is constructed from root to leaf, so have to reverse it
| Branch(i, nodes) -> Seq.map_concat (pathBuilder (i :: pth)) nodes
let nodes =
lst //using input list
|> Seq.map_concat (nodeBuilder lst) //build permutations tree
|> Seq.choose treefilter //prune tree if necessary
|> Seq.map_concat (pathBuilder []) //convert to seq of path lists
nodes
Функция перестановок работает путем построения n-арного дерева, представляющего все возможные перестановки списка переданных "вещей", а затем обхода дерева для создания списка списков. Использование Seq значительно повышает производительность, поскольку делает все ленивым.
Второй параметр функции перестановок позволяет вызывающей стороне определить фильтр для "обрезки" дерева перед созданием путей (см. Мой пример ниже, где я не хочу никаких начальных нулей).
Пример использования: Node<'a> является универсальным, поэтому мы можем сделать перестановки' any ':
let myfilter n = Some(n) //i.e., don't filter
permutations myfilter ['A';'B';'C';'D']
//in this case, I want to 'prune' leading zeros from my list before generating paths
let noLeadingZero n =
match n with
| Branch(0, _) -> None
| n -> Some(n)
//Curry myself an int-list permutations function with no leading zeros
let noLZperm = permutations noLeadingZero
noLZperm [0..9]
(Особая благодарность Tomas Petricek, любые комментарии приветствуются)
Если вам нужны отличные перестановки (когда исходный набор имеет дубликаты), вы можете использовать это:
let rec insertions pre c post =
seq {
if List.length post = 0 then
yield pre @ [c]
else
if List.forall (fun x->x<>c) post then
yield pre@[c]@post
yield! insertions (pre@[post.Head]) c post.Tail
}
let rec permutations l =
seq {
if List.length l = 1 then
yield l
else
let subperms = permutations l.Tail
for sub in subperms do
yield! insertions [] l.Head sub
}
Это прямой перевод из этого кода C#. Я открыт для предложений для более функционального внешнего вида.
Посмотрите на это:
http://fsharpcode.blogspot.com/2010/04/permutations.html
let length = Seq.length
let take = Seq.take
let skip = Seq.skip
let (++) = Seq.append
let concat = Seq.concat
let map = Seq.map
let (|Empty|Cons|) (xs:seq<'a>) : Choice<Unit, 'a * seq<'a>> =
if (Seq.isEmpty xs) then Empty else Cons(Seq.head xs, Seq.skip 1 xs)
let interleave x ys =
seq { for i in [0..length ys] ->
(take i ys) ++ seq [x] ++ (skip i ys) }
let rec permutations xs =
match xs with
| Empty -> seq [seq []]
| Cons(x,xs) -> concat(map (interleave x) (permutations xs))
Если вам нужны перестановки с повторениями, это подход "по книге" с использованием List.indexed вместо сравнения элементов для фильтрации элементов при построении перестановки.
let permutations s =
let rec perm perms carry rem =
match rem with
| [] -> carry::perms
| l ->
let li = List.indexed l
let permutations =
seq { for ci in li ->
let (i, c) = ci
(perm
perms
(c::carry)
(li |> List.filter (fun (index, _) -> i <> index) |> List.map (fun (_, char) -> char))) }
permutations |> Seq.fold List.append []
perm [] [] s