Merge/join seq of seqs - f#

Slowly getting the hang of List matching and tail recursion, I needed a function which 'stitches' a list of lists together leaving off intermediate values (easier to show than explain):
merge [[1;2;3];[3;4;5];[5;6;7]] //-> [1;2;3;4;5;6;7]
The code for the List.merge function looks like this:
///Like concat, but removes first value of each inner list except the first one
let merge lst =
let rec loop acc lst =
match lst with
| [] -> acc
| h::t ->
match acc with
| [] -> loop (acc # h) t
| _ -> loop (acc # (List.tl h)) t //first time omit first value
loop [] lst
(OK, it's not quite like concat, because it only handles two levels of list)
Question: How to do this for a Seq of Seqs (without using a mutable flag)?
UPDATE (re comment from Juliet):
My code creates 'paths' composed of 'segments' which are based on an option type:
type SegmentDef = Straight of float | Curve of float * float
let Project sampleinterval segdefs = //('clever' code here)
When I do a List.map (Project 1.) ListOfSegmentDefs, I get back a list where each segment begins on the same point where the previous segment ends. I want to join these lists together to get a Path, keeping only the 'top/tail' of each overlap - but I don't need to do a 'Set', because I know that I don't have any other duplicates.

This is essentially the same as your first solution, but a little more succinct:
let flatten l =
seq {
yield Seq.hd (Seq.hd l) (* first item of first list *)
for a in l do yield! (Seq.skip 1 a) (* other items *)
}
[Edit to add]:
If you need a List version of this code, use append |> Seq.to_list at the end of your method:
let flatten l =
seq {
yield Seq.hd (Seq.hd l) (* first item of first list *)
for a in l do yield! (Seq.skip 1 a) (* other items *)
} |> Seq.to_list

let merge = function
| [] -> []
| xs::xss -> xs # [for _::xs in xss do yield! xs]
or:
let merge = function
| [] -> []
| xs::xss -> xs # List.collect List.tail xss

Related

F# Generating all possible combinations between two lists

I want to generate all possible combinations between two lists. For example, if I had list1: [1,2] and list2: [a,b]. It would produce a list that contains [(1,a),(1,b),(2,a),(2,b)].
I am trying to figure out how to do this with recursion and match expressions.
I am currently stuck with this:
let rec combo (a1: 'a list) (a2: 'b list) =
match a1,a2 with
| [],[] -> []
Divide your task. First, write a function that returns a list of pairs formed from a single value and the items in a list (it'll be your second list).
let rec makePairs x lst acc =
match lst with
| [] -> acc
| _ -> makePairs x (List.tail lst) (acc # [(x, List.head lst)])
// makePairs 'a' [5;7] [] yields [('a',5), ('a',7)]
Then, by the same pattern as in makePairs, write a function makeAllPairs lst1 lst2 acc that enumerates the items of the first list and collects the pairs for the item returned from makePairs.
A simpler version of makePairs:
let makePairs2 x lst = List.map (fun b -> (x, b)) lst

Take N elements from sequence with N different indexes in F#

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

Avoiding code duplication in F#

I have two snippets of code that tries to convert a float list to a Vector3 or Vector2 list. The idea is to take 2/3 elements at a time from the list and combine them as a vector. The end result is a sequence of vectors.
let rec vec3Seq floatList =
seq {
match floatList with
| x::y::z::tail -> yield Vector3(x,y,z)
yield! vec3Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 3?"
}
let rec vec2Seq floatList =
seq {
match floatList with
| x::y::tail -> yield Vector2(x,y)
yield! vec2Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 2?"
}
The code looks very similiar and yet there seems to be no way to extract a common portion. Any ideas?
Here's one approach. I'm not sure how much simpler this really is, but it does abstract some of the repeated logic out.
let rec mkSeq (|P|_|) x =
seq {
match x with
| P(p,tail) ->
yield p
yield! mkSeq (|P|_|) tail
| [] -> ()
| _ -> failwith "List length mismatch" }
let vec3Seq =
mkSeq (function
| x::y::z::tail -> Some(Vector3(x,y,z), tail)
| _ -> None)
As Rex commented, if you want this only for two cases, then you probably won't have any problem if you leave the code as it is. However, if you want to extract a common pattern, then you can write a function that splits a list into sub-list of a specified length (2 or 3 or any other number). Once you do that, you'll only use map to turn each list of the specified length into Vector.
The function for splitting list isn't available in the F# library (as far as I can tell), so you'll have to implement it yourself. It can be done roughly like this:
let divideList n list =
// 'acc' - accumulates the resulting sub-lists (reversed order)
// 'tmp' - stores values of the current sub-list (reversed order)
// 'c' - the length of 'tmp' so far
// 'list' - the remaining elements to process
let rec divideListAux acc tmp c list =
match list with
| x::xs when c = n - 1 ->
// we're adding last element to 'tmp',
// so we reverse it and add it to accumulator
divideListAux ((List.rev (x::tmp))::acc) [] 0 xs
| x::xs ->
// add one more value to 'tmp'
divideListAux acc (x::tmp) (c+1) xs
| [] when c = 0 -> List.rev acc // no more elements and empty 'tmp'
| _ -> failwithf "not multiple of %d" n // non-empty 'tmp'
divideListAux [] [] 0 list
Now, you can use this function to implement your two conversions like this:
seq { for [x; y] in floatList |> divideList 2 -> Vector2(x,y) }
seq { for [x; y; z] in floatList |> divideList 3 -> Vector3(x,y,z) }
This will give a warning, because we're using an incomplete pattern that expects that the returned lists will be of length 2 or 3 respectively, but that's correct expectation, so the code will work fine. I'm also using a brief version of sequence expression the -> does the same thing as do yield, but it can be used only in simple cases like this one.
This is simular to kvb's solution but doesn't use a partial active pattern.
let rec listToSeq convert (list:list<_>) =
seq {
if not(List.isEmpty list) then
let list, vec = convert list
yield vec
yield! listToSeq convert list
}
let vec2Seq = listToSeq (function
| x::y::tail -> tail, Vector2(x,y)
| _ -> failwith "float array not multiple of 2?")
let vec3Seq = listToSeq (function
| x::y::z::tail -> tail, Vector3(x,y,z)
| _ -> failwith "float array not multiple of 3?")
Honestly, what you have is pretty much as good as it can get, although you might be able to make a little more compact using this:
// take 3 [1 .. 5] returns ([1; 2; 3], [4; 5])
let rec take count l =
match count, l with
| 0, xs -> [], xs
| n, x::xs -> let res, xs' = take (count - 1) xs in x::res, xs'
| n, [] -> failwith "Index out of range"
// split 3 [1 .. 6] returns [[1;2;3]; [4;5;6]]
let rec split count l =
seq { match take count l with
| xs, ys -> yield xs; if ys <> [] then yield! split count ys }
let vec3Seq l = split 3 l |> Seq.map (fun [x;y;z] -> Vector3(x, y, z))
let vec2Seq l = split 2 l |> Seq.map (fun [x;y] -> Vector2(x, y))
Now the process of breaking up your lists is moved into its own generic "take" and "split" functions, its much easier to map it to your desired type.

F# Split list into sublists based on comparison of adjacent elements

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

F# permutations

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

Resources