I'm facing with the generation of all the k-combinations (without repetition) of a list of elements. Beside the possible optimization in the code I wrote this function which I was almost sure it should work:
// comb :: int -> 'a list -> seq<'a list>
// Generates a sequence of all combinations (no repetition)
let comb k xs =
// subs :: 'a list -> seq<'a list>
// Splits a list in its subsequent non-empty tails
let rec subs xs =
seq {
match xs with
| _::ys -> yield xs
yield! subs ys
| _ -> yield! []
}
let rec comb' k xs rs =
seq {
for zs in subs xs do
match k, zs with
| 0, _ -> yield rs // Solution reached
| _ when k > List.length zs -> yield! [] // Safety (and optimizing) guard
| _, y::ys -> yield! comb' (k - 1) ys (y::rs) // Let's go deeper
| _ -> yield! [] // Not a solution
}
comb' k xs []
The idea behind this algorithm is to "traverse" the tree of all possible combinations and select only the ones with k elements; the subs function is used to generate the sub-sets of elements to generate the sub-trees in the same level; that is, calling:
Seq.toList <| subs [1..3];;
produces:
[[1;2;3];[2;3];[3]]
Maybe this part is a bit confusing, but it shouldn't be part of the problem and I don't think the issue is there.
The algorithm doesn't keep the order of the elements, but it's not necessary for my purpose.
Making a simple test case:
Seq.toList <| comb 2 [1..3];;
I was expecting the three solutions:
[[2;1];[3;1];[3;2]]
but actually it returns only:
[[2;1]]
I debug a little with VS Code, but I didn't really understand how the execution flows.
Does anybody see where the problem is?
Update
I realized that I badly exposed the concept behind the algorithm.
I visualized the solution to the problem like a search tree; at every level the root of a subtree contains the solution obtained by the concatenation of the head of all the remaining tails (subs results) and the list of the parent node.
Comparing the size of the tails and the current value of k I am able to understand which branches can actually contain solutions.
Your code is nearly right. The only issue is that when xs is empty in comb', then subs will be empty (since there are no non-empty tails) even when k is 0, but you should be yielding rs in that case, too.
This can easily be fixed by testing if k is 0 outside of the for loop and yielding rs there, and then putting the for loop into the else branch (where now you only need to match on zs):
let rec comb' k xs rs =
seq {
if k = 0 then yield rs
elif k <= List.length xs then
for zs in subs xs do
match zs with
| y::ys -> yield! comb' (k - 1) ys (y::rs) // Let's go deeper
| [] -> yield! [] // Not a solution
}
Well, your solution is very confusing, and it's no wonder that it produces incorrect results. Very hard to understand, very hard to follow.
Problem 1: subs doesn't actually produce all possible subsets. Look: in your very own experiment you're saying that subs [1..3] produces [[1;2;3]; [2;3]; [3]]. But this is incorrect: [1;3] is also a possible subset, but it's missing!
If you look carefully at what subs is actually doing, you'll see that at every iteration it emits the current value of xs, and then calls itself passing the tail of xs as argument. This, very predictably, leads to a sequence of all tails of the original list.
One obvious way to produce all possible subsets is by, at every iteration level, to produce a sequence of lists with one element removed:
let rec subs xs =
if List.isEmpty xs then Seq.empty
else
seq {
yield xs
for i in 0..(List.length xs - 1) do
let xsWithoutI = (List.take i xs) # (List.skip (i+1) xs)
yield! subs xsWithoutI
}
But of course, this will generate repetitions:
> subs [1..3] |> Seq.toList
val it : int list list =
[[1; 2; 3]; [2; 3]; [3]; [2]; [1; 3]; [3]; [1]; [1; 2]; [2]; [1]]
I will leave it as an exercise to come up with a way to exclude repetitions.
Problem 2 the function comb' doesn't make sense at all. At every iteration, zs is one of the possible subsequences (from subs), which you then match with y::ys, thus making y the first element of that subsequence, and ys - its tail. Then you prepend the first element of the subsequence to the result, and recur. This means that you're gradually building up the result out of first elements of every subsequence, but in reverse order (because you're prepending). So naturally, the result is [2;1]: 2 is the first element of the second subsequence, and 1 is the first element of the first subsequence.
The approach doesn't make sense to me at all. I don't see what the thought process could have been that lead to this implementation.
If you have a sequence of all posisble subsequences (from subs), and you want only those that are k elements long, why not just filter by that?
let comb' k xs = subs xs |> Seq.filter (fun s -> List.length s = k)
> comb' 2 [1..3]
val it : seq<int list> = seq [[2; 3]; [1; 3]; [1; 2]]
Related
I'm trying to write a function in F# to get the powersets of a set. So far I have written :
let rec powerset = function
|[] -> [[]]
| [x] -> [[x]; []]
|x::xs -> [x] :: (List.map (fun n -> [x; n]) xs) # powerset xs;;
but this isn't returning the cases that have 3 or more elements, only the pairs, the single elements, and the empty set.
You are on the right track, here is a working solution:
let rec powerset =
function
| [] -> [[]]
| (x::xs) ->
let xss = powerset xs
List.map (fun xs' -> x::xs') xss # xss
See you only have to use this trick:
for each element x you there half of the elements of the powerset will include x and half will not
so you recursively generate the powerset of the remaining elements xss and concat the two parts (List.map (fun xs' -> x::xs') xss will prepend the x to each of those)
But please note that this is not tail recursive and will blow the stack for bigger lists - you can take this idea and try to implement it with seq or make a tail-recursive version if you like
Using seq
Here is a version that uses seq and the bijection between the binary representation of natural numbers (a subset of those) and the subsets of a set (you map the elements to digits and set 1 if the corresponding element is in the subset and 0 if not):
let powerset (xs : 'a seq) : 'a seq seq =
let digits (n : bigint) : bool seq =
Seq.unfold (fun n ->
if n <= 0I
then None
else Some (n &&& 1I = 1I, n >>> 1))
n
let subsetBy (i : bigint) : 'a seq =
Seq.zip xs (digits i)
|> Seq.choose (fun (x,b) -> if b then Some x else None)
seq { 0I .. 2I**(Seq.length xs)-1I }
|> Seq.map subsetBy
this will work for things like powerset [1..100] but it might take a long time to enumerate them all ;) (but it should not take to much memory...)
I have a list of numbers and want to get the list of distances between the numbers.
For example:
[1; 3; 8; 10; 12] → [2; 5; 2; 2]
Here is my code:
let rec diffs lst acc =
match List.length lst > 1 with
| true ->
let first = List.head lst
let second = List.head (List.tail lst)
diffs (List.tail lst) (List.append acc [second - first])
| false -> acc
I am just wondering if there is any better solution ?
Probably the most straightforward way using what F# gives you out of the box:
let diffs =
Seq.pairwise
>> Seq.map (fun (a,b) -> b - a)
>> List.ofSeq
In general, calls to List.head, tail or append, particularly if they appear in a recursive function, are mild code smells in my book. They usually mean that the function can be written in a different, more streamlined way (case in point - #John's approach in the other answer, which you can easier map to the code you started with).
One more tip - you extend your accumulator using (List.append acc [second - first]), which is very wasteful. You need to traverse and copy the entire list to add elements at the end. The usual pattern is to add the elements from the head ((second - first) :: acc) and reverse the accumulator when you return.
A translation to something more idiomatic
let rec diffs lst =
match lst with
| head::head2::tail -> (head2-head)::(diffs (head2::tail)
| _ -> []
I'm new to F# and looking for a function which take N*indexes and a sequence and gives me N elements. If I have N indexes it should be equal to concat Seq.nth index0, Seq.nth index1 .. Seq.nth indexN but it should only scan over indexN elements (O(N)) in the sequence and not index0+index1+...+indexN (O(N^2)).
To sum up, I'm looking for something like:
//For performance, the index-list should be ordered on input, be padding between elements instead of indexes or be ordered when entering the function
seq {10 .. 20} |> Seq.takeIndexes [0;5;10]
Result: 10,15,20
I could make this by using seq { yield... } and have a index-counter to tick when some element should be passed out but if F# offers a nice standard way I would rather use that.
Thanks :)...
Addition: I have made the following. It works but ain't pretty. Suggestions is welcomed
let seqTakeIndexes (indexes : int list) (xs : seq<int>) =
seq {
//Assume indexes is sorted
let e = xs.GetEnumerator()
let i = ref indexes
let curr = ref 0
while e.MoveNext() && not (!i).IsEmpty do
if !curr = List.head !i then
i := (!i).Tail
yield e.Current
curr := !curr + 1
}
When you want to access elements by index, then using sequences isn't as good idea. Sequences are designed to allow sequential iteration. I would convert the necessary part of the sequence to an array and then pick the elements by index:
let takeIndexes ns input =
// Take only elements that we need to access (sequence could be infinite)
let arr = input |> Seq.take (1 + Seq.max ns) |> Array.ofSeq
// Simply pick elements at the specified indices from the array
seq { for index in ns -> arr.[index] }
seq [10 .. 20] |> takeIndexes [0;5;10]
Regarding your implementation - I don't think it can be made significantly more elegant. This is a general problem when implementing functions that need to take values from multiple sources in an interleaved fashion - there is just no elegant way of writing those!
However, you can write this in a functional way using recursion like this:
let takeIndexes indices (xs:seq<int>) =
// Iterates over the list of indices recursively
let rec loop (xe:IEnumerator<_>) idx indices = seq {
let next = loop xe (idx + 1)
// If the sequence ends, then end as well
if xe.MoveNext() then
match indices with
| i::indices when idx = i ->
// We're passing the specified index
yield xe.Current
yield! next indices
| _ ->
// Keep waiting for the first index from the list
yield! next indices }
seq {
// Note: 'use' guarantees proper disposal of the source sequence
use xe = xs.GetEnumerator()
yield! loop xe 0 indices }
seq [10 .. 20] |> takeIndexes [0;5;10]
When you need to scan a sequence and accumulate results in O(n), you can always fall back to Seq.fold:
let takeIndices ind sq =
let selector (idxLeft, currIdx, results) elem =
match idxLeft with
| [] -> (idxLeft, currIdx, results)
| idx::moreIdx when idx = currIdx -> (moreIdx, currIdx+1, elem::results)
| idx::_ when idx <> currIdx -> (idxLeft, currIdx+1, results)
| idx::_ -> invalidOp "Can't get here."
let (_, _, results) = sq |> Seq.fold selector (ind, 0, [])
results |> List.rev
seq [10 .. 20] |> takeIndices [0;5;10]
The drawback of this solution is that it will enumerate the sequence to the end, even if it has accumulated all the desired elements already.
Here is my shot at this. This solution will only go as far as it needs into the sequence and returns the elements as a list.
let getIndices xs (s:_ seq) =
let enum = s.GetEnumerator()
let rec loop i acc = function
| h::t as xs ->
if enum.MoveNext() then
if i = h then
loop (i+1) (enum.Current::acc) t
else
loop (i+1) acc xs
else
raise (System.IndexOutOfRangeException())
| _ -> List.rev acc
loop 0 [] xs
[10..20]
|> getIndices [2;4;8]
// Returns [12;14;18]
The only assumption made here is that the index list you supply is sorted. The function won't work properly otherwise.
Is it a problem, that the returned result is sorted?
This algorithm will work linearly over the input sequence. Just the indices need to be sorted. If the sequence is large, but indices are not so many - it'll be fast.
Complexity is: N -> Max(indices), M -> count of indices: O(N + MlogM) in the worst case.
let seqTakeIndices indexes =
let rec gather prev idxs xs =
match idxs with
| [] -> Seq.empty
| n::ns -> seq { let left = xs |> Seq.skip (n - prev)
yield left |> Seq.head
yield! gather n ns left }
indexes |> List.sort |> gather 0
Here is a List.fold variant, but is more complex to read. I prefer the first:
let seqTakeIndices indices xs =
let gather (prev, xs, res) n =
let left = xs |> Seq.skip (n - prev)
n, left, (Seq.head left)::res
let _, _, res = indices |> List.sort |> List.fold gather (0, xs, [])
res
Appended: Still slower than your variant, but a lot faster than mine older variants. Because of not using Seq.skip that is creating new enumerators and was slowing down things a lot.
let seqTakeIndices indices (xs : seq<_>) =
let enum = xs.GetEnumerator()
enum.MoveNext() |> ignore
let rec gather prev idxs =
match idxs with
| [] -> Seq.empty
| n::ns -> seq { if [1..n-prev] |> List.forall (fun _ -> enum.MoveNext()) then
yield enum.Current
yield! gather n ns }
indices |> List.sort |> gather 0
I've found this question on hubFS, but that handles a splitting criteria based on individual elements. I'd like to split based on a comparison of adjacent elements, so the type would look like this:
val split = ('T -> 'T -> bool) -> 'T list -> 'T list list
Currently, I am trying to start from Don's imperative solution, but I can't work out how to initialize and use a 'prev' value for comparison. Is fold a better way to go?
//Don's solution for single criteria, copied from hubFS
let SequencesStartingWith n (s:seq<_>) =
seq { use ie = s.GetEnumerator()
let acc = new ResizeArray<_>()
while ie.MoveNext() do
let x = ie.Current
if x = n && acc.Count > 0 then
yield ResizeArray.to_list acc
acc.Clear()
acc.Add x
if acc.Count > 0 then
yield ResizeArray.to_list acc }
This is an interesting problem! I needed to implement exactly this in C# just recently for my article about grouping (because the type signature of the function is pretty similar to groupBy, so it can be used in LINQ query as the group by clause). The C# implementation was quite ugly though.
Anyway, there must be a way to express this function using some simple primitives. It just seems that the F# library doesn't provide any functions that fit for this purpose. I was able to come up with two functions that seem to be generally useful and can be combined together to solve this problem, so here they are:
// Splits a list into two lists using the specified function
// The list is split between two elements for which 'f' returns 'true'
let splitAt f list =
let rec splitAtAux acc list =
match list with
| x::y::ys when f x y -> List.rev (x::acc), y::ys
| x::xs -> splitAtAux (x::acc) xs
| [] -> (List.rev acc), []
splitAtAux [] list
val splitAt : ('a -> 'a -> bool) -> 'a list -> 'a list * 'a list
This is similar to what we want to achieve, but it splits the list only in two pieces (which is a simpler case than splitting the list multiple times). Then we'll need to repeat this operation, which can be done using this function:
// Repeatedly uses 'f' to take several elements of the input list and
// aggregate them into value of type 'b until the remaining list
// (second value returned by 'f') is empty
let foldUntilEmpty f list =
let rec foldUntilEmptyAux acc list =
match f list with
| l, [] -> l::acc |> List.rev
| l, rest -> foldUntilEmptyAux (l::acc) rest
foldUntilEmptyAux [] list
val foldUntilEmpty : ('a list -> 'b * 'a list) -> 'a list -> 'b list
Now we can repeatedly apply splitAt (with some predicate specified as the first argument) on the input list using foldUntilEmpty, which gives us the function we wanted:
let splitAtEvery f list = foldUntilEmpty (splitAt f) list
splitAtEvery (<>) [ 1; 1; 1; 2; 2; 3; 3; 3; 3 ];;
val it : int list list = [[1; 1; 1]; [2; 2]; [3; 3; 3; 3]]
I think that the last step is really nice :-). The first two functions are quite straightforward and may be useful for other things, although they are not as general as functions from the F# core library.
How about:
let splitOn test lst =
List.foldBack (fun el lst ->
match lst with
| [] -> [[el]]
| (x::xs)::ys when not (test el x) -> (el::(x::xs))::ys
| _ -> [el]::lst
) lst []
the foldBack removes the need to reverse the list.
Having thought about this a bit further, I've come up with this solution. I'm not sure that it's very readable (except for me who wrote it).
UPDATE Building on the better matching example in Tomas's answer, here's an improved version which removes the 'code smell' (see edits for previous version), and is slightly more readable (says me).
It still breaks on this (splitOn (<>) []), because of the dreaded value restriction error, but I think that might be inevitable.
(EDIT: Corrected bug spotted by Johan Kullbom, now works correctly for [1;1;2;3]. The problem was eating two elements directly in the first match, this meant I missed a comparison/check.)
//Function for splitting list into list of lists based on comparison of adjacent elements
let splitOn test lst =
let rec loop lst inner outer = //inner=current sublist, outer=list of sublists
match lst with
| x::y::ys when test x y -> loop (y::ys) [] (List.rev (x::inner) :: outer)
| x::xs -> loop xs (x::inner) outer
| _ -> List.rev ((List.rev inner) :: outer)
loop lst [] []
splitOn (fun a b -> b - a > 1) [1]
> val it : [[1]]
splitOn (fun a b -> b - a > 1) [1;3]
> val it : [[1]; [3]]
splitOn (fun a b -> b - a > 1) [1;2;3;4;6;7;8;9;11;12;13;14;15;16;18;19;21]
> val it : [[1; 2; 3; 4]; [6; 7; 8; 9]; [11; 12; 13; 14; 15; 16]; [18; 19]; [21]]
Any thoughts on this, or the partial solution in my question?
"adjacent" immediately makes me think of Seq.pairwise.
let splitAt pred xs =
if Seq.isEmpty xs then
[]
else
xs
|> Seq.pairwise
|> Seq.fold (fun (curr :: rest as lists) (i, j) -> if pred i j then [j] :: lists else (j :: curr) :: rest) [[Seq.head xs]]
|> List.rev
|> List.map List.rev
Example:
[1;1;2;3;3;3;2;1;2;2]
|> splitAt (>)
Gives:
[[1; 1; 2; 3; 3; 3]; [2]; [1; 2; 2]]
I would prefer using List.fold over explicit recursion.
let splitOn pred = function
| [] -> []
| hd :: tl ->
let (outer, inner, _) =
List.fold (fun (outer, inner, prev) curr ->
if pred prev curr
then (List.rev inner) :: outer, [curr], curr
else outer, curr :: inner, curr)
([], [hd], hd)
tl
List.rev ((List.rev inner) :: outer)
I like answers provided by #Joh and #Johan as these solutions seem to be most idiomatic and straightforward. I also like an idea suggested by #Shooton. However, each solution had their own drawbacks.
I was trying to avoid:
Reversing lists
Unsplitting and joining back the temporary results
Complex match instructions
Even Seq.pairwise appeared to be redundant
Checking list for emptiness can be removed in cost of using Unchecked.defaultof<_> below
Here's my version:
let splitWhen f src =
if List.isEmpty src then [] else
src
|> List.foldBack
(fun el (prev, current, rest) ->
if f el prev
then el , [el] , current :: rest
else el , el :: current , rest
)
<| (List.head src, [], []) // Initial value does not matter, dislike using Unchecked.defaultof<_>
|> fun (_, current, rest) -> current :: rest // Merge temporary lists
|> List.filter (not << List.isEmpty) // Drop tail element
I need to generate permutations on a given list. I managed to do it like this
let rec Permute (final, arr) =
if List.length arr > 0 then
for x in arr do
let n_final = final # [x]
let rest = arr |> List.filter (fun a -> not (x = a))
Permute (n_final, rest)
else
printfn "%A" final
let DoPermute lst =
Permute ([], lst)
DoPermute lst
There are obvious issues with this code. For example, list elements must be unique. Also, this is more-less a same approach that I would use when generating straight forward implementation in any other language. Is there any better way to implement this in F#.
Thanks!
Here's the solution I gave in my book F# for Scientists (page 166-167):
let rec distribute e = function
| [] -> [[e]]
| x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs]
let rec permute = function
| [] -> [[]]
| e::xs -> List.collect (distribute e) (permute xs)
For permutations of small lists, I use the following code:
let distrib e L =
let rec aux pre post =
seq {
match post with
| [] -> yield (L # [e])
| h::t -> yield (List.rev pre # [e] # post)
yield! aux (h::pre) t
}
aux [] L
let rec perms = function
| [] -> Seq.singleton []
| h::t -> Seq.collect (distrib h) (perms t)
It works as follows: the function "distrib" distributes a given element over all positions in a list, example:
distrib 10 [1;2;3] --> [[10;1;2;3];[1;10;2;3];[1;2;10;3];[1;2;3;10]]
The function perms works (recursively) as follows: distribute the head of the list over all permutations of its tail.
The distrib function will get slow for large lists, because it uses the # operator a lot, but for lists of reasonable length (<=10), the code above works fine.
One warning: if your list contains duplicates, the result will contain identical permutations. For example:
perms [1;1;3] = [[1;1;3]; [1;1;3]; [1;3;1]; [1;3;1]; [3;1;1]; [3;1;1]]
The nice thing about this code is that it returns a sequence of permutations, instead of generating them all at once.
Of course, generating permutations with an imperative array-based algorithm will be (much) faster, but this algorithm has served me well in most cases.
Here's another sequence-based version, hopefully more readable than the voted answer.
This version is similar to Jon's version in terms of logic, but uses computation expressions instead of lists. The first function computes all ways to insert an element x in a list l. The second function computes permutations.
You should be able to use this on larger lists (e.g. for brute force searches on all permutations of a set of inputs).
let rec inserts x l =
seq { match l with
| [] -> yield [x]
| y::rest ->
yield x::l
for i in inserts x rest do
yield y::i
}
let rec permutations l =
seq { match l with
| [] -> yield []
| x::rest ->
for p in permutations rest do
yield! inserts x p
}
It depends on what you mean by "better". I'd consider this to be slightly more elegant, but that may be a matter of taste:
(* get the list of possible heads + remaining elements *)
let rec splitList = function
| [x] -> [x,[]]
| x::xs -> (x, xs) :: List.map (fun (y,l) -> y,x::l) (splitList xs)
let rec permutations = function
| [] -> [[]]
| l ->
splitList l
|> List.collect (fun (x,rest) ->
(* permute remaining elements, then prepend head *)
permutations rest |> List.map (fun l -> x::l))
This can handle lists with duplicate elements, though it will result in duplicated permutations.
In the spirit of Cyrl's suggestion, here's a sequence comprehension version
let rec permsOf xs =
match xs with
| [] -> List.toSeq([[]])
| _ -> seq{ for x in xs do
for xs' in permsOf (remove x xs) do
yield (x::xs')}
where remove is a simple function that removes a given element from a list
let rec remove x xs =
match xs with [] -> [] | (x'::xs')-> if x=x' then xs' else x'::(remove x xs')
IMHO the best solution should alleviate the fact that F# is a functional language so imho the solution should be as close to the definition of what we mean as permutation there as possible.
So the permutation is such an instance of list of things where the head of the list is somehow added to the permutation of the rest of the input list.
The erlang solution shows that in a pretty way:
permutations([]) -> [[]];
permutations(L) -> [[H|T] H<- L, T <- permutations( L--[H] ) ].
taken fron the "programming erlang" book
There is a list comprehension operator used, in solution mentioned here by the fellow stackoverflowers there is a helper function which does the similar job
basically I'd vote for the solution without any visible loops etc, just pure function definition
I'm like 11 years late, but still in case anyone needs permutations like I did recently. Here's Array version of permutation func, I believe it's more performant:
[<RequireQualifiedAccess>]
module Array =
let private swap (arr: _[]) i j =
let buf = arr.[i]
arr.[i] <- arr.[j]
arr.[j] <- buf
let permutations arr =
match arr with
| null | [||] -> [||]
| arr ->
let last = arr.Length - 1
let arr = Array.copy arr
let rec perm arr k =
let arr = Array.copy arr
[|
if k = last then
yield arr
else
for i in k .. last do
swap arr k i
yield! perm arr (k + 1)
|]
perm arr 0