I have some Run Length Encoding code that I wrote as an exercise
let rle s =
s
|> List.map (fun x -> (x, 1))
|> List.fold (fun acc x ->
match acc with
| [] -> [(x, 1)]
| h::(x, n) -> h::(x, n+1)
| h -> h::(x, 1)
)
|> List.map (fun (x, n) ->
match n with
| 1 -> x.ToString()
| _ -> x.ToString() + n.ToString()
)
The pattern h::(x, n) -> h::(x, n+1) fails to compile.
Does anyone know why?
RLE (for grins)
let rle (s: string) =
let bldr = System.Text.StringBuilder()
let rec start = function
| [] -> ()
| c :: s -> count (1, c) s
and count (n, c) = function
| c1 :: s when c1 = c -> count (n+1, c) s
| s -> Printf.bprintf bldr "%d%c" n c; start s
start (List.ofSeq s)
bldr.ToString()
let s1 = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
let s2 = "12W1B12W3B24W1B14W"
rle s1 = s2 |> printfn "%b" //"true"
It can't compile because the second argument for :: pattern match must be a list, but here it is a tuple. In general, you seem to just misunderstand head and tail. Head is the top element while tail is a list of following elements. Essentially swapping them does the trick:
|> List.fold (fun acc x ->
match acc with
| [] -> [(x, 1)]
| (x0, n)::t when x0=x -> (x0, n+1)::t
| t -> (x, 1)::t
)
[]
Note 1: As #pad noticed, List.fold requires one more argument, a "bootstrap" accumulator to start with. Obviously, it should be just an empty list, [].
Note 2: you can't directly match x. Instead, you bind it to x0 and compare x0 with x.
Note 3: matching empty list [] is not necessary as it would happily work with the last pattern.
This doesn't answer your question, but I was bored and wrote an implementation you might find a bit more instructive -- just step through it with the debugger in Visual Studio or MonoDevelop.
let rec private rleRec encoded lastChar count charList =
match charList with
| [] ->
// No more chars left to process, but we need to
// append the current run before returning.
let encoded' = (count, lastChar) :: encoded
// Reverse the encoded list so it's in the correct
// order, then return it.
List.rev encoded'
| currentChar :: charList' ->
// Does the current character match the
// last character to be processed?
if currentChar = lastChar then
// Just increment the count and recurse.
rleRec encoded currentChar (count + 1) charList'
else
// The current character is not the same as the last.
// Append the character and run-length for the previous
// character to the 'encoded' list, then start a new run
// with the current character.
rleRec ((count, lastChar) :: encoded) currentChar 1 charList'
let rle charList =
// If the list is empty, just return an empty list
match charList with
| [] -> []
| hd :: tl ->
// Call the implementation of the RLE algorithm.
// The initial run starts with the first character in the list.
rleRec [] hd 1 tl
let rleOfString (str : string) =
rle (List.ofSeq str)
let rec printRle encoded =
match encoded with
| [] ->
printfn ""
| (length, c) :: tl ->
printf "%i%O" length c
printRle tl
let printRleOfString = rleOfString >> printRle
Pasting the code into F# interactive and using the Wikipedia example for run-length encoding:
> printRleOfString "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";;
12W1B12W3B24W1B14W
val it : unit = ()
Related
I have a list of lists, where each inner list has the same length, and I need to project that as its inverse (that is, I need the dimensions flipped).
In other words, take the first item of each sublist and put that in a new list, take the second item of each sublist and put it in a new list etc. Then return a list of all these new lists.
Example: if input is:
let ls = [[1;2;3];[4;5;6];[7;8;9];[0;0;0]];;
Then output is supposed to be:
val it : int list list = [[1; 4; 7; 0]; [2; 5; 8; 0]; [3; 6; 9; 0]]
I have working code, but it doesn't feel right. It traverses multiple times over the lists, needs to do a List.rev multiple times and has to check for empty on the inner lists:
let rec getInnerHeads acc skipped lst =
match lst with
| [] -> List.rev acc, List.rev skipped
| item::rest ->
match item with
| [] -> [], skipped
| innerHead::skip1 ->
getInnerHeads (innerHead::acc) (skip1::skipped) rest
let rec flipDimensions acc lst =
match lst with
| [] -> acc |> List.rev
| z when (z |> List.forall List.isEmpty) -> acc |> List.rev
| rest ->
let (elem, skip1Elems) = getInnerHeads [] [] rest
flipDimensions (elem::acc) skip1Elems
The only upside of above code is that it is rail-recursive (at least I think it is).
Anybody has a more efficient, or succinct, or both algorithm? I checked F# Snippets and SO, figured this would've been asked before, it seems so common, but I didn't find any examples.
Maybe something with List.unfold?
let transpose matrix =
let rec loop acc = function
| (_::_)::_ as m -> loop (List.map List.head m :: acc) (List.map List.tail m)
| _ -> List.rev acc
loop [] matrix
I have a list and I want to remove an element matching some criteria but remove only one element.
let items = [1;2;3]
let predicate x =
x >= 2
let result = items |> List.fold ...
// result = [1;3]
How to achieve method returning list with [1;3]?
You can use a generic recursive function
let rec removeFirst predicate = function
| [] -> []
| h :: t when predicate h -> t
| h :: t -> h :: removeFirst predicate t
or a tail recursive one (if you fear a stack overflow)
let removeFirst predicate list =
let rec loop acc = function
| [] -> List.rev acc
| h :: t when predicate h -> (List.rev acc) # t
| h :: t -> loop (h :: acc) t
loop [] list
let result =
items
|>List.scan (fun (removed, _) item ->
if removed then true, Some(item) //If already removed, just propagate
elif predicate item then true, None //If not removed but predicate matches, don't propagate
else false, Some(item)) //If not removed and predicate doesn't match, propagate
(false, None)
|>List.choose snd
The state is a tuple. The first element is a Boolean flag indicating whether we already have removed some item from the list. The second element is an option: Some when we want to emit the item, None otherwise.
The last line takes the second elements from the states and for each of them emits the wrapped value (in case of Some) or does nothing (in case of None).
Here is a short alternative, which in my testing was faster than the others proposed so far:
let removeFirst p xs =
match List.tryFindIndex p xs with
| Some i -> List.take i xs # List.skip (i+1) xs
| None -> xs
Aiming for an intuitive solution.
let removeAt index list =
let left, right = List.splitAt index list
left # (List.skip 1 right)
let removeFirst predicate list =
match List.tryFindIndex predicate list with
| Some index -> removeAt index list
| None -> list
For performance (long lists).
let removeFirst predicate list =
let rec finish acc rem =
match rem with
| [] -> acc
| x::xs -> finish (x::acc) xs
and find l p acc rem =
match rem with
| [] -> l
| x::xs ->
if p x then finish xs acc
else find l p (x::acc) xs
find list predicate [] list
Here is quite a typical make a century problem.
We have a natural number list [1;2;3;4;5;6;7;8;9].
We have a list of possible operators [Some '+'; Some '*';None].
Now we create a list of operators from above possibilities and insert each operator into between each consecutive numbers in the number list and compute the value.
(Note a None b = a * 10 + b)
For example, if the operator list is [Some '+'; Some '*'; None; Some '+'; Some '+'; Some '+'; Some '+'; Some '+'], then the value is 1 + 2 * 34 + 5 + 6 + 7 + 8 + 9 = 104.
Please find all possible operator lists, so the value = 10.
The only way I can think of is brute-force.
I generate all possible operator lists.
Compute all possible values.
Then filter so I get all operator lists which produce 100.
exception Cannot_compute
let rec candidates n ops =
if n = 0 then [[]]
else
List.fold_left (fun acc op -> List.rev_append acc (List.map (fun x -> op::x) (candidates (n-1) ops))) [] ops
let glue l opl =
let rec aggr acc_l acc_opl = function
| hd::[], [] -> (List.rev (hd::acc_l), List.rev acc_opl)
| hd1::hd2::tl, None::optl -> aggr acc_l acc_opl (((hd1*10+hd2)::tl), optl)
| hd::tl, (Some c)::optl -> aggr (hd::acc_l) ((Some c)::acc_opl) (tl, optl)
| _ -> raise Cannot_glue
in
aggr [] [] (l, opl)
let compute l opl =
let new_l, new_opl = glue l opl in
let rec comp = function
| hd::[], [] -> hd
| hd::tl, (Some '+')::optl -> hd + (comp (tl, optl))
| hd1::hd2::tl, (Some '-')::optl -> hd1 + (comp ((-hd2)::tl, optl))
| hd1::hd2::tl, (Some '*')::optl -> comp (((hd1*hd2)::tl), optl)
| hd1::hd2::tl, (Some '/')::optl -> comp (((hd1/hd2)::tl), optl)
| _, _ -> raise Cannot_compute
in
comp (new_l, new_opl)
let make_century l ops =
List.filter (fun x -> fst x = 100) (
List.fold_left (fun acc x -> ((compute l x), x)::acc) [] (candidates ((List.length l)-1) ops))
let rec print_solution l opl =
match l, opl with
| hd::[], [] -> Printf.printf "%d\n" hd
| hd::tl, (Some op)::optl -> Printf.printf "%d %c " hd op; print_solution tl optl
| hd1::hd2::tl, None::optl -> print_solution ((hd1*10+hd2)::tl) optl
| _, _ -> ()
I believe my code is ugly. So I have the following questions
computer l opl is to compute using the number list and operator list. Basically it is a typical math evaluation. Is there any nicer implementation?
I have read Chapter 6 in Pearls of Functional Algorithm Design. It used some techniques to improve the performance. I found it really really obscurity and hard to understand. Anyone who read it can help?
Edit
I refined my code. Basically, I will scan the operator list first to glue all numbers where their operator is None.
Then in compute, if I meet a '-' I will simply negate the 2nd number.
A classic dynamic programming solution (which finds the = 104
solution instantly) that does not risk any problem with operators
associativity or precedence. It only returns a boolean saying whether
it's possible to come with the number; modifying it to return the
sequences of operations to get the solution is an easy but interesting
exercise, I was not motivated to go that far.
let operators = [ (+); ( * ); ]
module ISet = Set.Make(struct type t = int let compare = compare end)
let iter2 res1 res2 f =
res1 |> ISet.iter ## fun n1 ->
res2 |> ISet.iter ## fun n2 ->
f n1 n2
let can_make input target =
let has_zero = Array.fold_left (fun acc n -> acc || (n=0)) false input in
let results = Array.make_matrix (Array.length input) (Array.length input) ISet.empty in
for imax = 0 to Array.length input - 1 do
for imin = imax downto 0 do
let add n =
(* OPTIMIZATION: if the operators are known to be monotonous, we need not store
numbers above the target;
(Handling multiplication by 0 requires to be a bit more
careful, and I'm not in the mood to think hard about this
(I think one need to store the existence of a solution,
even if it is above the target), so I'll just disable the
optimization in that case)
*)
if n <= target && not has_zero then
results.(imin).(imax) <- ISet.add n results.(imin).(imax) in
let concat_numbers =
(* concatenates all number from i to j:
i=0, j=2 -> (input.(0)*10 + input.(1))*10 + input.(2)
*)
let rec concat acc k =
let acc = acc + input.(k) in
if k = imax then acc
else concat (10 * acc) (k + 1)
in concat 0 imin
in add concat_numbers;
for k = imin to imax - 1 do
let res1 = results.(imin).(k) in
let res2 = results.(k+1).(imax) in
operators |> List.iter (fun op ->
iter2 res1 res2 (fun n1 n2 -> add (op n1 n2););
);
done;
done;
done;
let result = results.(0).(Array.length input - 1) in
ISet.mem target result
Here is my solution, which evaluates according to the usual rules of precedence. It finds 303 solutions to find [1;2;3;4;5;6;7;8;9] 100 in under 1/10 second on my MacBook Pro.
Here are two interesting ones:
# 123 - 45 - 67 + 89;;
- : int = 100
# 1 * 2 * 3 - 4 * 5 + 6 * 7 + 8 * 9;;
- : int = 100
This is a brute force solution. The only slightly clever thing is that I treat concatenation of digits as simply another (high precedence) operation.
The eval function is the standard stack-based infix expression evaluation that you will find described many places. Here is an SO article about it: How to evaluate an infix expression in just one scan using stacks? The essence is to postpone evaulating by pushing operators and operands onto stacks. When you find that the next operator has lower precedence you can go back and evaluate what you pushed.
type op = Plus | Minus | Times | Divide | Concat
let prec = function
| Plus | Minus -> 0
| Times | Divide -> 1
| Concat -> 2
let succ = function
| Plus -> Minus
| Minus -> Times
| Times -> Divide
| Divide -> Concat
| Concat -> Plus
let apply op stack =
match op, stack with
| _, [] | _, [_] -> [] (* Invalid input *)
| Plus, a :: b :: tl -> (b + a) :: tl
| Minus, a :: b :: tl -> (b - a) :: tl
| Times, a :: b :: tl -> (b * a) :: tl
| Divide, a :: b :: tl -> (b / a) :: tl
| Concat, a :: b :: tl -> (b * 10 + a) :: tl
let rec eval opstack numstack ops nums =
match opstack, numstack, ops, nums with
| [], sn :: _, [], _ -> sn
| sop :: soptl, _, [], _ ->
eval soptl (apply sop numstack) ops nums
| [], _, op :: optl, n :: ntl ->
eval [op] (n :: numstack) optl ntl
| sop :: soptl, _, op :: _, _ when prec sop >= prec op ->
eval soptl (apply sop numstack) ops nums
| _, _, op :: optl, n :: ntl ->
eval (op :: opstack) (n :: numstack) optl ntl
| _ -> 0 (* Invalid input *)
let rec incr = function
| [] -> []
| Concat :: rest -> Plus :: incr rest
| x :: rest -> succ x :: rest
let find nums tot =
match nums with
| [] -> []
| numhd :: numtl ->
let rec try1 ops accum =
let accum' =
if eval [] [numhd] ops numtl = tot then
ops :: accum
else
accum
in
if List.for_all ((=) Concat) ops then
accum'
else try1 (incr ops) accum'
in
try1 (List.map (fun _ -> Plus) numtl) []
I came up with a slightly obscure implementation (for a variant of this problem) that is a bit better than brute force. It works in place, rather than generating intermediate data structures, keeping track of the combined values of the operators that have already been evaluated.
The trick is to keep track of a pending operator and value so that you can evaluate the "none" operator easily. That is, if the algorithm had just progressed though 1 + 23, the pending operator would be +, and the pending value would be 23, allowing you to easily generate either 1 + 23 + 4 or 1 + 234 as necessary.
type op = Add | Sub | Nothing
let print_ops ops =
let len = Array.length ops in
print_char '1';
for i = 1 to len - 1 do
Printf.printf "%s%d" (match ops.(i) with
| Add -> " + "
| Sub -> " - "
| Nothing -> "") (i + 1)
done;
print_newline ()
let solve k target =
let ops = Array.create k Nothing in
let rec recur i sum pending_op pending_value =
let sum' = match pending_op with
| Add -> sum + pending_value
| Sub -> if sum = 0 then pending_value else sum - pending_value
| Nothing -> pending_value in
if i = k then
if sum' = target then print_ops ops else ()
else
let digit = i + 1 in
ops.(i) <- Add;
recur (i + 1) sum' Add digit;
ops.(i) <- Sub;
recur (i + 1) sum' Sub digit;
ops.(i) <- Nothing;
recur (i + 1) sum pending_op (pending_value * 10 + digit) in
recur 0 0 Nothing 0
Note that this will generate duplicates - I didn't bother to fix that. Also, if you are doing this exercise to gain strength in functional programming, it might be beneficial to reject the imperative approach taken here and search for a similar solution that doesn't make use of assignments.
So this is a merge sort function I'm playing with in OCaml. The funny thing is the code delivers what I expect, which means, it sorts the list. But then raises some errors. So can someone please check my code and tell me what's going on and why these errors? And how do I eliminate them? I'm a OCaml newbie but I really want to get what's going on:
(* Merge Sort *)
(* This works but produces some extra error. Consult someone!! *)
let rec length_inner l n =
match l with
[] -> n
| h::t -> length_inner t (n + 1)
;;
let length l = length_inner l 0;;
let rec take n l =
if n = 0 then [] else
match l with
h::t -> h :: take (n - 1) t
;;
let rec drop n l =
if n = 0 then l else
match l with
h::t -> drop (n - 1) t
;;
let rec merge x y =
match x, y with
[], l -> l
| l, [] -> l
| hx::tx, hy::ty ->
if hx < hy
then hx :: merge tx (hy :: ty)
else hy :: merge (hx :: tx) ty
;;
let rec msort l =
match l with
[] -> []
| [x] -> [x]
| _ ->
let left = take (length l/2) l in
let right = drop (length l/2) l in
merge (msort left) (msort right)
;;
msort [53; 9; 2; 6; 19];;
In the terminal, I get:
OCaml version 4.00.1
# #use "prac.ml";;
val length_inner : 'a list -> int -> int = <fun>
val length : 'a list -> int = <fun>
File "prac.ml", line 13, characters 2-44:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
[]
val take : int -> 'a list -> 'a list = <fun>
File "prac.ml", line 19, characters 2-39:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
[]
val drop : int -> 'a list -> 'a list = <fun>
val merge : 'a list -> 'a list -> 'a list = <fun>
val msort : 'a list -> 'a list = <fun>
- : int list = [2; 6; 9; 19; 53]
#
The compiler is telling you that your pattern matches aren't exhaustive. In fact it's telling exactly what to try to see the problem. For example, you might try:
drop 2 []
To fix the problem you need to decide what to do with empty lists in your functions. Here's a definition of drop with exhaustive matches:
let rec drop n l =
if n = 0 then l
else
match l with
| [] -> []
| h::t -> drop (n - 1) t
If this isn't clear: your code doesn't say what to do with an empty list. Your matches only say what to do if the list has the form h :: t. But an empty list doesn't have this form. You need to add a case for [] to your matches.
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