the question in short: What is the most idiomatic way to do "recursive List comprehension" in F#?
more detailed: As I have learned so far (I am new to F#) we have essentially the following tools to "build up" lists: List.map and list comprehension. Imho they both do more or less the same thing, they generate a list by "altering" the elements of a given list (in case of comprehension the given list is of the form [k..n]).
What I want to do is to inductively build up lists (before people ask: for no other reason than curiosity) i.e. is there any built in function with the behavior one would expect from a function called something like "List.maplist" that might take as arguments
a function f : 'a List -> 'a and an n : int,
returning the list
[... ; f (f []) ; f [] ] of length n.
To illustrate what I mean I wrote such a function on my own (as an exercise)
let rec recListComprehension f n =
if n=0 then []
else
let oldList = recListComprehension f (n-1)
f (oldList) :: oldList
or a bit less readable but in turn tail recursive:
let rec tailListComprehension f n list =
if n=0 then list
else tailListComprehension f (n-1) ((f list)::list)
let trecListComprehension f n = tailListComprehension f n []
for example, a list containing the first 200 fibonacci numbers can be generated by
let fiboGen =
function
| a::b::tail -> a+b
| _ -> 1UL
trecListComprehension (fiboGen) 200
to sum up the question: Is there a build in function in F# that behaves more or less like "trecListComprehension" and if not what is the most idiomatic way to achieve this sort of functionality?
PS: sorry for being a bit verbose..
What is the most idiomatic way to do "recursive List comprehension" in F#?
It's the matter of style. You will encounter high-order functions more often. For certain situations e.g. expressing nested computation or achieving laziness, using sequence expression seems more natural.
To illustrate, your example is written in sequence expression:
let rec recListComprehension f n = seq {
if n > 0 then
let oldList = recListComprehension f (n-1)
yield f oldList
yield! oldList }
recListComprehension fiboGen 200 |> Seq.toList
You have a very readable function with both laziness and tail-recursiveness which you can't easily achieve by using Seq.unfold.
Similarly, nested computation of cartesian product is more readable to use sequence expression / list comprehension:
let cartesian xs ys =
[ for x in xs do
for y in ys do
yield (x, y) ]
than to use high-order functions:
let cartesian xs ys =
List.collect (fun x -> List.map (fun y -> (x, y)) ys) xs
I once asked about differences between list comprehension and high-order functions which might be of your interest.
You're basically folding over the numeric range. So it could be written:
let listComp f n = List.fold (fun xs _ -> f xs :: xs) [] [1 .. n]
This has the added benefit of gracefully handling negative values of n.
You could do a Seq.unfold and then do Seq.toList.
See the example from here:
let seq1 = Seq.unfold (fun state -> if (state > 20) then None else Some(state, state + 1)) 0
printfn "The sequence seq1 contains numbers from 0 to 20."
for x in seq1 do printf "%d " x
let fib = Seq.unfold (fun state ->
if (snd state > 1000) then None
else Some(fst state + snd state, (snd state, fst state + snd state))) (1,1)
printfn "\nThe sequence fib contains Fibonacci numbers."
for x in fib do printf "%d " x
Related
I've been solving a few combinatoric problems on Haskell, so I wrote down those 2 functions:
permutations :: (Eq a) => [a] -> [[a]]
permutations [] = [[]]
permutations list = do
x <- list
xs <- permutations (filter (/= x) list)
return (x : xs)
combinations :: (Eq a, Ord a) => Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations n list = do
x <- list
xs <- combinations (n-1) (filter (> x) list)
return (x : xs)
Which works as follows:
*Main> permutations [1,2,3]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
*Main> combinations 2 [1,2,3,4]
[[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]]
Those were uncomfortably similar, so I had to abstract it. I wrote the following abstraction:
combinatoric next [] = [[]]
combinatoric next list = do
x <- list
xs <- combinatoric next (next x list)
return (x : xs)
Which receives a function that controls how to filter the elements of the list. It can be used to easily define permutations:
permutations :: (Eq a) => [a] -> [[a]]
permutations = combinatoric (\ x ls -> filter (/= x) ls)
But I couldn't define combinations this way since it carries an state (n). I could extend the combinatoric with an additional state argument, but that'd become too clunky and I remember such approach was not necessary in a somewhat similar situation. Thus, I wonder: is it possible to define combinations using combinatorics? If not, what is a better abstraction of combinatorics which successfully subsumes both functions?
This isn't a direct answer to your question (sorry), but I don't think your code is correct. The Eq and Ord constraints tipped me off - they shouldn't be necessary - so I wrote a couple of QuickCheck properties.
prop_numberOfPermutations xs = length (permutations xs) === factorial (length xs)
where _ = (xs :: [Int]) -- force xs to be instantiated to [Int]
prop_numberOfCombinations (Positive n) (NonEmpty xs) = n <= length xs ==>
length (combinations n xs) === choose (length xs) n
where _ = (xs :: [Int])
factorial :: Int -> Int
factorial x = foldr (*) 1 [1..x]
choose :: Int -> Int -> Int
choose n 0 = 1
choose 0 r = 0
choose n r = choose (n-1) (r-1) * n `div` r
The first property checks that the number of permutations of a list of length n is n!. The second checks that the number of r-combinations of a list of length n is C(n, r). Both of these properties fail when I run them against your definitions:
ghci> quickCheck prop_numberOfPermutations
*** Failed! Falsifiable (after 5 tests and 4 shrinks):
[0,0,0]
3 /= 6
ghci> quickCheck prop_numberOfCombinations
*** Failed! Falsifiable (after 4 tests and 1 shrink):
Positive {getPositive = 2}
NonEmpty {getNonEmpty = [3,3]}
0 /= 1
It looks like your functions fail when the input list contains duplicate elements. Writing an abstraction for an incorrect implementation isn't a good idea - don't try and run before you can walk! You might find it helpful to read the source code for the standard library's definition of permutations, which does not have an Eq constraint.
First let's improve the original functions. You assume that all elements are distinct wrt their equality for permutations, and that they're distinct and have an ordering for combinations. These constraints aren't necessary and as described in the other answer, the code can produce wrong results. Following the robustness principle, let's accept just unconstrained lists. For this we'll need a helper function that produces all possible splits of a list:
split :: [a] -> [([a], a, [a])]
split = loop []
where
loop _ [] = []
loop rs (x:xs) = (rs, x, xs) : loop (x:rs) xs
Note that the implementation causes prefixes returned by this function to be reversed, but it's nothing we require.
This allows us to write generic permutations and combinations.
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations list = do
(pre, x, post) <- split list
-- reversing 'pre' isn't really necessary, but makes the output
-- order natural
xs <- permutations (reverse pre ++ post)
return (x : xs)
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations n list = do
(_, x, post) <- split list
xs <- combinations (n-1) post
return (x : xs)
Now what they have in common:
At each step they pick an element to output,
update the list of elements to pick from and
stop after some condition is met.
The last point is a bit problematic, as for permutations we end once the list to choose from is empty, while for combinations we have a counter. This is probably the reason why it was difficult to generalize. We can work around this by realizing that for permutations the number of steps is equal to the length of the input list, so we can express the condition in the number of repetitions.
For such problems it's often very convenient to express them using StateT s [] monad, where s is the state we're working with. In our case it'll be the list of elements to choose from. The core of our combinatorial functions can be then expressed with StateT [a] [] a: pick an element from the state and update the state for the next step. Since the stateful computations all happen in the [] monad, we automatically branch all possibilities. With that, we can define a generic function:
import Control.Monad.State
combinatoric :: Int -> StateT [a] [] b -> [a] -> [[b]]
combinatoric n k = evalStateT $ replicateM n k
And then define permutations and combinations by specifying the appropriate number of repetitions and what's the core StateT [a] [] a function:
permutations' :: [a] -> [[a]]
permutations' xs = combinatoric (length xs) f xs
where
f = StateT $ map (\(pre, x, post) -> (x, reverse pre ++ post)) . split
combinations' :: Int -> [a] -> [[a]]
combinations' n xs = combinatoric n f xs
where
f = StateT $ map (\(_, x, post) -> (x, post)) . split
for simple problems like fibonacci, writing CPS is relatively straightforward
let fibonacciCPS n =
let rec fibonacci_cont a cont =
if a <= 2 then cont 1
else
fibonacci_cont (a - 2) (fun x ->
fibonacci_cont (a - 1) (fun y ->
cont(x + y)))
fibonacci_cont n (fun x -> x)
However, in the case of the rod-cutting exemple from here (or the book intro to algo), the number of closure is not always equal to 2, and can't be hard coded.
I imagine one has to change the intermediate variables to sequences.
(I like to think of the continuation as a contract saying "when you have the value, pass it on to me, then i'll pass it on to my boss after treatment" or something along those line, which defers the actual execution)
For the rod cutting, we have
//rod cutting
let p = [|1;5;8;9;10;17;17;20;24;30|]
let rec r n = seq { yield p.[n-1]; for i in 1..(n-1) -> (p.[i-1] + r (n-i)) } |> Seq.max
[1 .. 10] |> List.map (fun i -> i, r i)
In this case, I will need to attached the newly created continuation
let cont' = fun (results: _ array) -> cont(seq { yield p.[n-1]; for i in 1..(n-1) -> (p.[i-1] + ks.[n-i]) } |> Seq.max)
to the "cartesian product" continuation made by the returning subproblems.
Has anyone seen a CPS version of rod-cutting / has any tips on this ?
I assume you want to explicitly CPS everything, which means some nice stuff like the list comprehension will be lost (maybe using async blocks can help, I don't know F# very well) -- so starting from a simple recursive function:
let rec cutrod (prices: int[]) = function
| 0 -> 0
| n -> [1 .. min n (prices.Length - 1)] |>
List.map (fun i -> prices.[i] + cutrod prices (n - i)) |>
List.max
It's clear that we need CPS versions of the list functions used (map, max and perhaps a list-building function if you want to CPS the [1..(blah)] expression too). map is quite interesting since it's a higher-order function, so its first parameter needs to be modified to take a CPS-ed function instead. Here's an implementation of a CPS List.map:
let rec map_k f list k =
match list with
| [] -> k []
| x :: xs -> f x (fun y -> map_k f xs (fun ys -> k (y :: ys)))
Note that map_k invokes its argument f like any other CPS function, and puts the recursion in map_k into the continuation. With map_k, max_k, gen_k (which builds a list from 1 to some value), the cut-rod function can be CPS-ed:
let rec cutrod_k (prices: int[]) n k =
match n with
| 0 -> k 0
| n -> gen_k (min n (prices.Length - 1)) (fun indices ->
map_k (fun i k -> cutrod_k prices (n - i) (fun ret -> k (prices.[i] + ret)))
indices
(fun totals -> max_k totals k))
I need a very efficient way to find duplicates in an unsorted sequence. This is what I came up with, but it has a few shortcomings, namely it
unnecessarily counts occurrences beyond 2
consumes the entire sequence before yielding duplicates
creates several intermediate sequences
module Seq =
let duplicates items =
items
|> Seq.countBy id
|> Seq.filter (snd >> ((<) 1))
|> Seq.map fst
Regardless of the shortcomings, I don't see a reason to replace this with twice the code. Is it possible to improve this with comparably concise code?
A more elegant functional solution:
let duplicates xs =
Seq.scan (fun xs x -> Set.add x xs) Set.empty xs
|> Seq.zip xs
|> Seq.choose (fun (x, xs) -> if Set.contains x xs then Some x else None)
Uses scan to accumulate sets of all elements seen so far. Then uses zip to combine each element with the set of elements before it. Finally, uses choose to filter out the elements that are in the set of previously-seen elements, i.e. the duplicates.
EDIT
Actually my original answer was completely wrong. Firstly, you don't want duplicates in your outputs. Secondly, you want performance.
Here is a purely functional solution that implements the algorithm you're after:
let duplicates xs =
(Map.empty, xs)
||> Seq.scan (fun xs x ->
match Map.tryFind x xs with
| None -> Map.add x false xs
| Some false -> Map.add x true xs
| Some true -> xs)
|> Seq.zip xs
|> Seq.choose (fun (x, xs) ->
match Map.tryFind x xs with
| Some false -> Some x
| None | Some true -> None)
This uses a map to track whether each element has been seen before once or many times and then emits the element if it is seen having only been seen once before, i.e. the first time it is duplicated.
Here is a faster imperative version:
let duplicates (xs: _ seq) =
seq { let d = System.Collections.Generic.Dictionary(HashIdentity.Structural)
let e = xs.GetEnumerator()
while e.MoveNext() do
let x = e.Current
let mutable seen = false
if d.TryGetValue(x, &seen) then
if not seen then
d.[x] <- true
yield x
else
d.[x] <- false }
This is around 2× faster than any of your other answers (at the time of writing).
Using a for x in xs do loop to enumerate the elements in a sequence is substantially slower than using GetEnumerator directly but generating your own Enumerator is not significantly faster than using a computation expression with yield.
Note that the TryGetValue member of Dictionary allows me to avoid allocation in the inner loop by mutating a stack allocated value whereas the TryGetValue extension member offered by F# (and used by kvb in his/her answer) allocates its return tuple.
Here's an imperative solution (which is admittedly slightly longer):
let duplicates items =
seq {
let d = System.Collections.Generic.Dictionary()
for i in items do
match d.TryGetValue(i) with
| false,_ -> d.[i] <- false // first observance
| true,false -> d.[i] <- true; yield i // second observance
| true,true -> () // already seen at least twice
}
This is the best "functional" solution I could come up with that doesn't consume the entire sequence up front.
let duplicates =
Seq.scan (fun (out, yielded:Set<_>, seen:Set<_>) item ->
if yielded.Contains item then
(None, yielded, seen)
else
if seen.Contains item then
(Some(item), yielded.Add item, seen.Remove item)
else
(None, yielded, seen.Add item)
) (None, Set.empty, Set.empty)
>> Seq.Choose (fun (x,_,_) -> x)
Assuming your sequence is finite, this solution requires one run on the sequence:
open System.Collections.Generic
let duplicates items =
let dict = Dictionary()
items |> Seq.fold (fun acc item ->
match dict.TryGetValue item with
| true, 2 -> acc
| true, 1 -> dict.[item] <- 2; item::acc
| _ -> dict.[item] <- 1; acc) []
|> List.rev
You can provide length of the sequence as the capacity of Dictionary, but it requires to enumerate the whole sequence once more.
EDIT:
To resolve 2nd problem, one could generate duplicates on demand:
open System.Collections.Generic
let duplicates items =
seq {
let dict = Dictionary()
for item in items do
match dict.TryGetValue item with
| true, 2 -> ()
| true, 1 -> dict.[item] <- 2; yield item
| _ -> dict.[item] <- 1
}
Functional solution:
let duplicates items =
let test (unique, result) v =
if not(unique |> Set.contains v) then (unique |> Set.add v ,result)
elif not(result |> Set.contains v) then (unique,result |> Set.add v)
else (unique, result)
items |> Seq.fold test (Set.empty, Set.empty) |> snd |> Set.toSeq
Here is my failed attempt at the problem any help would be appreciated.
I tried to come up with the best algo for the power set that worked on eager lists. This part seems to be working fine. The part I'm having trouble with is translating it to work with Sequences so it can run it on streaming\infinite lists. I really don't like the yield syntax maybe because I don't understand it well but I would rather have it without using the yield syntax as well.
//All Combinations of items in a list
//i.e. the Powerset given each item is unique
//Note: lists are eager so can't be used for infinite
let listCombinations xs =
List.fold (fun acc x ->
List.collect (fun ys -> ys::[x::ys]) acc) [[]] xs
//This works fine (Still interested if it could be faster)
listCombinations [1;2;3;4;5] |> Seq.iter (fun x -> printfn "%A" x)
//All Combinations of items in a sequence
//i.e. the Powerset given each item is unique
//Note: Not working
let seqCombinations xs =
Seq.fold (fun acc x ->
Seq.collect (fun ys ->
seq { yield ys
yield seq { yield x
yield! ys} }) acc) Seq.empty xs
//All Combinations of items in a sequence
//i.e. the Powerset given each item is unique
//Note: Not working (even wrong type signature)
let seqCombinations2 xs =
Seq.fold (fun acc x ->
Seq.collect (fun ys ->
Seq.append ys (Seq.append x ys)) acc) Seq.empty xs
//Sequences to test on
let infiniteSequence = Seq.initInfinite (fun i -> i + 1)
let finiteSequence = Seq.take 5 infiniteSequence
//This should work easy since its in a finite sequence
//But it does not, so their must be a bug in 'seqCombinations' above
for xs in seqCombinations finiteSequence do
for y in xs do
printfn "%A" y
//This one is much more difficult to get to work
//since its the powerset on the infinate sequence
//None the less If someone could help me find a way to make this work
//This is my ultimate goal
let firstFew = Seq.take 20 (seqCombinations infiniteSequence)
for xs in firstFew do
for y in xs do
printfn "%A" y
Your seqCombinations is almost correct, but you didn't translate it from lists to sequences properly. The equivalent of [[]] is not Seq.empty, but Seq.singleton Seq.empty:
let seqCombinations xs =
Seq.fold (fun acc x ->
Seq.collect (fun ys ->
seq { yield ys
yield seq { yield x
yield! ys} }) acc) (Seq.singleton Seq.empty) xs
The code above works for finite sequences. But for infinite ones, it doesn't work, because it first tries to reach the end, which it obviously never does for infinite sequences.
If you want a function that will work with infinite sequences I managed to figure out two ways, but neither of them is particularly nice. One of them uses mutable state:
let seqCombinations xs =
let combs = ref [[]]
seq {
yield! !combs
for x in xs do
let added = List.map (fun ys -> x::ys) !combs
yield! added
combs := !combs # added
}
The other is too much about dealing with details of seq<T>:
open System.Collections.Generic
let seqCombinations (xs : seq<_>) =
let rec combs acc (e : IEnumerator<_>) =
seq {
if (e.MoveNext()) then
let added = List.map (fun ys -> (e.Current)::ys) acc
yield! added
yield! combs (acc # added) e }
use enumerator = xs.GetEnumerator()
seq {
yield []
yield! combs [[]] enumerator
}
I think this would be much easier if you could treat infinite sequences as head and tail, like finite lists in F# or any sequence in Haskell. But it's certainly possible there is a nice way to express this in F#, and I just didn't find it.
I've asked a similar question recently at Generate powerset lazily and got some nice answers.
For powerset of finite sets, the answer by #Daniel in the above link is an efficient solution and probably suits your purpose. You can come up with a test case to compare between his approach and yours.
Regarding powerset of infinite sets, here is a bit of maths. According to Cantor's theorem, the power set of a countably infinite set is uncountably infinite. It means there is no way to enumerate powerset of all integers (which is countably infinite) even in a lazy way. The intuition is the same for real numbers; since real number is uncountably infinite, we can't actually model them using infinite sequences.
Therefore, there is no algorithm to enumerate powerset of a countably infinite set. Or that kind of algorithm just doesn't make sense.
This is sort of a joke, but will actually generate the correct result for an infinite sequence (it's just that it can't be proven--empirically, not mathematically).
let powerset s =
seq {
yield Seq.empty
for x in s -> seq [x]
}
Inspired by this question and answer, how do I create a generic permutations algorithm in F#? Google doesn't give any useful answers to this.
EDIT: I provide my best answer below, but I suspect that Tomas's is better (certainly shorter!)
you can also write something like this:
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 }
The 'list' argument contains all the numbers that you want to permute and 'taken' is a set that contains numbers already used. The function returns empty list when all numbers all taken.
Otherwise, it iterates over all numbers that are still available, gets all possible permutations of the remaining numbers (recursively using 'permutations') and appends the current number to each of them before returning (l::perm).
To run this, you'll give it an empty set, because no numbers are used at the beginning:
permutations [1;2;3] Set.empty;;
I like this implementation (but can't remember the source of it):
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))
Tomas' solution is quite elegant: it's short, purely functional, and lazy. I think it may even be tail-recursive. Also, it produces permutations lexicographically. However, we can improve performance two-fold using an imperative solution internally while still exposing a functional interface externally.
The function permutations takes a generic sequence e as well as a generic comparison function f : ('a -> 'a -> int) and lazily yields immutable permutations lexicographically. The comparison functional allows us to generate permutations of elements which are not necessarily comparable as well as easily specify reverse or custom orderings.
The inner function permute is the imperative implementation of the algorithm described here. The conversion function let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } allows us to use the System.Array.Sort overload which does in-place sub-range custom sorts using an 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' }
Now for convenience we have the following where let flip f x y = f y x:
let permutationsAsc e = permutations compare e
let permutationsDesc e = permutations (flip compare) e
My latest best answer
//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
The permutations function works by constructing an n-ary tree representing all possible permutations of the list of 'things' passed in, then traversing the tree to construct a list of lists. Using 'Seq' dramatically improves performance as it makes everything lazy.
The second parameter of the permutations function allows the caller to define a filter for 'pruning' the tree before generating the paths (see my example below, where I don't want any leading zeros).
Some example usage: Node<'a> is generic, so we can do permutations of 'anything':
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]
(Special thanks to Tomas Petricek, any comments welcome)
If you need distinct permuations (when the original set has duplicates), you can use this:
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
}
This is a straight-forward translation from this C# code. I am open to suggestions for a more functional look-and-feel.
Take a look at this one:
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))
If you need permutations with repetitions, this is the "by the book" approach using List.indexed instead of element comparison to filter out elements while constructing a permutation.
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