F# elegance needed for Master-Detail scenario - f#

The master-detail scenario. Been around forever. OK, if not forever, at least I was doing master-detail with FORTRAN on punch cards in the 70's. It's still around - plenty of master-detail questions here on STO.
I looked for a good way to do a master-detail recognizer in F#, didn't find it. Apologies if I missed it, and if so, can someone just reply with the sto thread or url? thanks
Here's my F#-newbie take on doing a master-detail recognizer in F#. That is: Reducing a raw/flat list of master-detail strings to a list of F#-records, where the master-strings are paired with their detail string-list.
Not looking for code golf here folks. Elegance. I had hoped to end up with something elegant, but the below is just a straight-forward recursive list walk. My F#-newbie brain failed to see how to make good use here of folds, comprehensions, fold-backs, maps, active patterns, computation expressions, etc.
Let's keep it to what can be done in F#. If there is a pre-built flat-file master-detail XML-data loader in .Net that makes master-detail .txt files into .Net XML in a one-line .Net call, that's quite interesting because it can be used in F#.
As someone with a long imperative programming history, I was trying to stick to immutable F# for practice. But if dipping into imperative or mutable code is really the best way for this in F#, please explain away. The output could be a list of tuples, a sequence of records, an array of tuples, etc.
Any comments/feedback.... thanks
let testInput =
["master Homer" ; "Doh.."; "Doh!!" ;
"master Has none" ;
"master JoyJoyJoy"; "Yaa!" ; "Yaa!!!"; "Yaa!!!!!!"]
type md = {m: string; d: string list}
member x.addDetail newd = {m = x.m; d = x.d # [newd]}
static member noMaster = {m = "" ; d = []} // master records can never be null-strings, so "" works here
static member isMaster (L:string) = L.StartsWith("master ")
static member isDetail (L:string) = not (md.isMaster L) // There is no third kind of record - if not a master then it is a detail
let rec masterDetails flatList currentMaster =
if md.noMaster = currentMaster then
match flatList with
| [] -> [] // If no master and no more input: input list was empty and the empty list is the overall result
| h :: t -> if md.isMaster h then // If no master, then head becomes the first master of the run
masterDetails t {m = h; d = []}
else
failwith "Bad input: First record must be a master record"
else
match flatList with
| [] -> [currentMaster] // End of input; return current master as a one-entry-list
| h :: t -> if md.isMaster h then // Head will now replace the current master as the new master
[currentMaster] # masterDetails t {m = h; d = []}
else // Keep current master; and add detail record to current master's detail list
masterDetails t (currentMaster.addDetail h)
let testSolution = // Required: 1) Preserve order of the master sets. 2) Preserve sort order of details-within-masters.
[{m = "master Homer" ; d = ["Doh.."; "Doh!!" ]};
{m = "master Has none" ; d = [ ]};
{m = "master JoyJoyJoy"; d = ["Yaa!"; "Yaa!!!"; "Yaa!!!!!!"]} ]
let tryIt = masterDetails testInput md.noMaster
let testTry = (tryIt = testSolution)

This sounds like a job for takeDrop.
// split a list into a prefix of elements that all
// meet predicate 'p', and the suffix remainder
let takeDrop p l =
let rec loop acc l =
match l with
| h::t when p h -> loop (h::acc) t
| _ -> List.rev acc, l
loop [] l
let rec masterDetail input =
[match input with
| [] -> ()
| h::t ->
assert(md.isMaster h)
let det, rest = takeDrop (not << md.isMaster) t
yield { m = h; d = det }
yield! masterDetail rest]
Full test code below.
let testInput =
["master Homer" ; "Doh.."; "Doh!!" ;
"master Has none" ;
"master JoyJoyJoy"; "Yaa!" ; "Yaa!!!"; "Yaa!!!!!!"]
type md = {m: string; d: string list}
static member isMaster (s:string) = s.StartsWith("master ")
let testSolution = // Required: 1) Preserve order of the master sets.
// 2) Preserve sort order of details-within-masters.
[{m = "master Homer" ; d = ["Doh.."; "Doh!!" ]};
{m = "master Has none" ; d = [ ]};
{m = "master JoyJoyJoy"; d = ["Yaa!"; "Yaa!!!"; "Yaa!!!!!!"]} ]
// split a list into a prefix of elements that all
// meet predicate 'p', and the suffix remainder
let takeDrop p l =
let rec loop acc l =
match l with
| h::t when p h -> loop (h::acc) t
| _ -> List.rev acc, l
loop [] l
let rec masterDetail input =
[match input with
| [] -> ()
| h::t ->
assert(md.isMaster h)
let det, rest = takeDrop (not << md.isMaster) t
yield { m = h; d = det }
yield! masterDetail rest]
let briSol = masterDetail testInput
printfn "%A" (briSol = testSolution)

As far as I know, there is no built-in function that would automatically split a list in this fashion. In the real-world, you would probably use a different representation of the data in the first place, so you wouldn't need to solve this problem (when loading data from XML, you'd already have hierarchical structure and when grouping data using LINQ, you'd also get hierarchical data). However, your function may still be needed, for example when loading data from a text-file.
Here is a slightly simpler version that uses sequence expression to generate the outer collection (of master-details records). The inner collection is accumulated in a parameter in the usual way:
let rec groupMasterDetails l acc master = seq {
match l with
// No master found yet, if the first element isn't master, we throw
| x::xs when not (md.isMaster x) && master = None ->
failwith "The first element must be master"
// Starting a new group, yield the previous group
| x::xs when md.isMaster x ->
if master <> None then yield { m = master.Value; d = List.rev acc }
yield! groupMasterDetails xs [] (Some x)
// Continue the current group
| x:: xs ->
yield! groupMasterDetails xs (x::acc) master
// End of processing, yield the last group
| [] ->
if master <> None then yield { m = master.Value; d = List.rev acc } }
let masterDetails l = l [] None
Note that the elements are accumulated in the reversed order (as opposed to using [el]#rest and then reversed, because this is a lot more efficient - using # involves copying of the entire list, so it is a bad practice to use it often). This also means that the implementation doesn't need your addDetail member.
However, this is still relatively long piece of code - I'm interested to see if this can be implemented by composing standard F# functions (I didn't find any good way to do this).

Here's an example, building off of Brain's answer, that takes separation too far however it does show the power of functional programming.
let takeDrop p l =
let rec loop acc l =
match l with
| h::t when p h -> loop (h::acc) t
| _ -> List.rev acc, l
loop [] l
let rec listSplit spliter neo l =
[match l with
| [] -> ()
| h::t ->
let det, rest = spliter t
yield neo h det
yield! listSplit spliter neo rest]
let masterDetail =
listSplit
(takeDrop (not << md.isMaster))
(fun h det -> { m = h; d = det })

Related

How to write an F# union type chooser?

Is there a better way to do this if F#?
type T =
| A of int
| B of string
static member chooseA x = match x with A i -> Some i | _ -> None
static member chooseB x = match x with B s -> Some s | _ -> None
The usecase is the following:
let collection = [A 10; B "abc"]
let aItems = collection |> Seq.choose T.chooseA
let bItems = collection |> Seq.choose T.chooseB
Thanks!
Use List.partition to split your source elements:
type T =
| A of int
| B of string
let collection = [A 10; B "abc"; A 40; B "120"]
let result = List.partition (function | A _ -> true | _ -> false) collection
val result : T list * T list = ([A 10; A 40], [B "abc"; B "120"])
Then you can use fst and snd to select the relevant lists.
This is awkward, but I can see why it is not an important case F#'s design. Usually, there is a solution that allows for a complete pattern match instead of multiple, somewhat incomplete ones. For example, the two concrete item sequences can be constructed like this:
let aItems, bItems =
let accA, accB = ResizeArray(), ResizeArray()
collection |> Seq.iter (function A i -> accA.Add i | B s -> accB.Add s)
seq accA, seq accB
A similar solution without mutation can be made if you dislike it, but I see little reason to worry about encapsulated mutation. Note that the results are cast to seq.
This uses pattern matching in the manner it is designed for:
If another case is added to T, a warning will appear in the handling function, which is exactly where editing should continue: determining how to treat the new input case.
The program doesn't needlessly iterate the input multiple times for each kind of input, but rather goes over it once and handles each item when first encountered.
If the above isn't suitable, you can still shorten the question's code a bit by using the function keyword and declaring the chooser function as a lambda. For example:
let aItems = collection |> Seq.choose (function A i -> Some i | _ -> None)
Note that this is lazy, just like the proposal in the question: here, every iteration over aItems will needlessly iterate over all the B cases in the input.
I can offer the following variant:
open System.Reflection
type T =
| A of int
| B of string
let collection = [A 10; B "abc"; A 40; B "120"]
let sp (col: T list) (str:string) =
if col=[] then []
else
let names = "Is" + str
col |> List.filter(fun x-> let t = x.GetType()
if t.GetProperty(names) = null then false
else
t.InvokeMember(names, BindingFlags.GetProperty, null, x, null) :?> bool)
|> List.map(fun y ->
y.GetType().InvokeMember("get_Item", BindingFlags.InvokeMethod, null, y, null))
sp collection "A" |> printfn "%A\n"
sp collection "B" |> printfn "%A\n"
sp collection "C" |> printfn "%A\n"
Print:
[10; 40]
["abc"; "120"]
[]
http://ideone.com/yAytQk
I'm new to F#, so I think that can be done easier

Remove a single non-unique value from a sequence in F#

I have a sequence of integers representing dice in F#.
In the game in question, the player has a pool of dice and can choose to play one (governed by certain rules) and keep the rest.
If, for example, a player rolls a 6, 6 and a 4 and decides to play one the sixes, is there a simple way to return a sequence with only one 6 removed?
Seq.filter (fun x -> x != 6) dice
removes all of the sixes, not just one.
Non-trivial operations on sequences are painful to work with, since they don't support pattern matching. I think the simplest solution is as follows:
let filterFirst f s =
seq {
let filtered = ref false
for a in s do
if filtered.Value = false && f a then
filtered := true
else yield a
}
So long as the mutable implementation is hidden from the client, it's still functional style ;)
If you're going to store data I would use ResizeArray instead of a Sequence. It has a wealth of functions built in such as the function you asked about. It's simply called Remove. Note: ResizeArray is an abbreviation for the CLI type List.
let test = seq [1; 2; 6; 6; 1; 0]
let a = new ResizeArray<int>(test)
a.Remove 6 |> ignore
Seq.toList a |> printf "%A"
// output
> [1; 2; 6; 1; 0]
Other data type options could be Array
let removeOneFromArray v a =
let i = Array.findIndex ((=)v) a
Array.append a.[..(i-1)] a.[(i+1)..]
or List
let removeOneFromList v l =
let rec remove acc = function
| x::xs when x = v -> List.rev acc # xs
| x::xs -> remove (x::acc) xs
| [] -> acc
remove [] l
the below code will work for a list (so not any seq but it sounds like the sequence your using could be a List)
let rec removeOne value list =
match list with
| head::tail when head = value -> tail
| head::tail -> head::(removeOne value tail)
| _ -> [] //you might wanna fail here since it didn't find value in
//the list
EDIT: code updated based on correct comment below. Thanks P
EDIT: After reading a different answer I thought that a warning would be in order. Don't use the above code for infite sequences but since I guess your players don't have infite dice that should not be a problem but for but for completeness here's an implementation that would work for (almost) any
finite sequence
let rec removeOne value seq acc =
match seq.Any() with
| true when s.First() = value -> seq.Skip(1)
| true -> seq.First()::(removeOne value seq.Skip(1))
| _ -> List.rev acc //you might wanna fail here since it didn't find value in
//the list
However I recommend using the first solution which Im confident will perform better than the latter even if you have to turn a sequence into a list first (at least for small sequences or large sequences with the soughtfor value in the end)
I don't think there is any function that would allow you to directly represent the idea that you want to remove just the first element matching the specified criteria from the list (e.g. something like Seq.removeOne).
You can implement the function in a relatively readable way using Seq.fold (if the sequence of numbers is finite):
let removeOne f l =
Seq.fold (fun (removed, res) v ->
if removed then true, v::res
elif f v then true, res
else false, v::res) (false, []) l
|> snd |> List.rev
> removeOne (fun x -> x = 6) [ 1; 2; 6; 6; 1 ];
val it : int list = [1; 2; 6; 1]
The fold function keeps some state - in this case of type bool * list<'a>. The Boolean flag represents whether we already removed some element and the list is used to accumulate the result (which has to be reversed at the end of processing).
If you need to do this for (possibly) infinite seq<int>, then you'll need to use GetEnumerator directly and implement the code as a recursive sequence expression. This is a bit uglier and it would look like this:
let removeOne f (s:seq<_>) =
// Get enumerator of the input sequence
let en = s.GetEnumerator()
let rec loop() = seq {
// Move to the next element
if en.MoveNext() then
// Is this the element to skip?
if f en.Current then
// Yes - return all remaining elements without filtering
while en.MoveNext() do
yield en.Current
else
// No - return this element and continue looping
yield en.Current
yield! loop() }
loop()
You can try this:
let rec removeFirstOccurrence item screened items =
items |> function
| h::tail -> if h = item
then screened # tail
else tail |> removeFirstOccurrence item (screened # [h])
| _ -> []
Usage:
let updated = products |> removeFirstOccurrence product []

F#: How do i split up a sequence into a sequence of sequences

Background:
I have a sequence of contiguous, time-stamped data. The data-sequence has gaps in it where the data is not contiguous. I want create a method to split the sequence up into a sequence of sequences so that each subsequence contains contiguous data (split the input-sequence at the gaps).
Constraints:
The return value must be a sequence of sequences to ensure that elements are only produced as needed (cannot use list/array/cacheing)
The solution must NOT be O(n^2), probably ruling out a Seq.take - Seq.skip pattern (cf. Brian's post)
Bonus points for a functionally idiomatic approach (since I want to become more proficient at functional programming), but it's not a requirement.
Method signature
let groupContiguousDataPoints (timeBetweenContiguousDataPoints : TimeSpan) (dataPointsWithHoles : seq<DateTime * float>) : (seq<seq< DateTime * float >>)= ...
On the face of it the problem looked trivial to me, but even employing Seq.pairwise, IEnumerator<_>, sequence comprehensions and yield statements, the solution eludes me. I am sure that this is because I still lack experience with combining F#-idioms, or possibly because there are some language-constructs that I have not yet been exposed to.
// Test data
let numbers = {1.0..1000.0}
let baseTime = DateTime.Now
let contiguousTimeStamps = seq { for n in numbers ->baseTime.AddMinutes(n)}
let dataWithOccationalHoles = Seq.zip contiguousTimeStamps numbers |> Seq.filter (fun (dateTime, num) -> num % 77.0 <> 0.0) // Has a gap in the data every 77 items
let timeBetweenContiguousValues = (new TimeSpan(0,1,0))
dataWithOccationalHoles |> groupContiguousDataPoints timeBetweenContiguousValues |> Seq.iteri (fun i sequence -> printfn "Group %d has %d data-points: Head: %f" i (Seq.length sequence) (snd(Seq.hd sequence)))
I think this does what you want
dataWithOccationalHoles
|> Seq.pairwise
|> Seq.map(fun ((time1,elem1),(time2,elem2)) -> if time2-time1 = timeBetweenContiguousValues then 0, ((time1,elem1),(time2,elem2)) else 1, ((time1,elem1),(time2,elem2)) )
|> Seq.scan(fun (indexres,(t1,e1),(t2,e2)) (index,((time1,elem1),(time2,elem2))) -> (index+indexres,(time1,elem1),(time2,elem2)) ) (0,(baseTime,-1.0),(baseTime,-1.0))
|> Seq.map( fun (index,(time1,elem1),(time2,elem2)) -> index,(time2,elem2) )
|> Seq.filter( fun (_,(_,elem)) -> elem <> -1.0)
|> PSeq.groupBy(fst)
|> Seq.map(snd>>Seq.map(snd))
Thanks for asking this cool question
I translated Alexey's Haskell to F#, but it's not pretty in F#, and still one element too eager.
I expect there is a better way, but I'll have to try again later.
let N = 20
let data = // produce some arbitrary data with holes
seq {
for x in 1..N do
if x % 4 <> 0 && x % 7 <> 0 then
printfn "producing %d" x
yield x
}
let rec GroupBy comp (input:LazyList<'a>) : LazyList<LazyList<'a>> =
LazyList.delayed (fun () ->
match input with
| LazyList.Nil -> LazyList.cons (LazyList.empty()) (LazyList.empty())
| LazyList.Cons(x,LazyList.Nil) ->
LazyList.cons (LazyList.cons x (LazyList.empty())) (LazyList.empty())
| LazyList.Cons(x,(LazyList.Cons(y,_) as xs)) ->
let groups = GroupBy comp xs
if comp x y then
LazyList.consf
(LazyList.consf x (fun () ->
let (LazyList.Cons(firstGroup,_)) = groups
firstGroup))
(fun () ->
let (LazyList.Cons(_,otherGroups)) = groups
otherGroups)
else
LazyList.cons (LazyList.cons x (LazyList.empty())) groups)
let result = data |> LazyList.of_seq |> GroupBy (fun x y -> y = x + 1)
printfn "Consuming..."
for group in result do
printfn "about to do a group"
for x in group do
printfn " %d" x
You seem to want a function that has signature
(`a -> bool) -> seq<'a> -> seq<seq<'a>>
I.e. a function and a sequence, then break up the input sequence into a sequence of sequences based on the result of the function.
Caching the values into a collection that implements IEnumerable would likely be simplest (albeit not exactly purist, but avoiding iterating the input multiple times. It will lose much of the laziness of the input):
let groupBy (fun: 'a -> bool) (input: seq) =
seq {
let cache = ref (new System.Collections.Generic.List())
for e in input do
(!cache).Add(e)
if not (fun e) then
yield !cache
cache := new System.Collections.Generic.List()
if cache.Length > 0 then
yield !cache
}
An alternative implementation could pass cache collection (as seq<'a>) to the function so it can see multiple elements to chose the break points.
A Haskell solution, because I don't know F# syntax well, but it should be easy enough to translate:
type TimeStamp = Integer -- ticks
type TimeSpan = Integer -- difference between TimeStamps
groupContiguousDataPoints :: TimeSpan -> [(TimeStamp, a)] -> [[(TimeStamp, a)]]
There is a function groupBy :: (a -> a -> Bool) -> [a] -> [[a]] in the Prelude:
The group function takes a list and returns a list of lists such that the concatenation of the result is equal to the argument. Moreover, each sublist in the result contains only equal elements. For example,
group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
It is a special case of groupBy, which allows the programmer to supply their own equality test.
It isn't quite what we want, because it compares each element in the list with the first element of the current group, and we need to compare consecutive elements. If we had such a function groupBy1, we could write groupContiguousDataPoints easily:
groupContiguousDataPoints maxTimeDiff list = groupBy1 (\(t1, _) (t2, _) -> t2 - t1 <= maxTimeDiff) list
So let's write it!
groupBy1 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy1 _ [] = [[]]
groupBy1 _ [x] = [[x]]
groupBy1 comp (x : xs#(y : _))
| comp x y = (x : firstGroup) : otherGroups
| otherwise = [x] : groups
where groups#(firstGroup : otherGroups) = groupBy1 comp xs
UPDATE: it looks like F# doesn't let you pattern match on seq, so it isn't too easy to translate after all. However, this thread on HubFS shows a way to pattern match sequences by converting them to LazyList when needed.
UPDATE2: Haskell lists are lazy and generated as needed, so they correspond to F#'s LazyList (not to seq, because the generated data is cached (and garbage collected, of course, if you no longer hold a reference to it)).
(EDIT: This suffers from a similar problem to Brian's solution, in that iterating the outer sequence without iterating over each inner sequence will mess things up badly!)
Here's a solution that nests sequence expressions. The imperitave nature of .NET's IEnumerable<T> is pretty apparent here, which makes it a bit harder to write idiomatic F# code for this problem, but hopefully it's still clear what's going on.
let groupBy cmp (sq:seq<_>) =
let en = sq.GetEnumerator()
let rec partitions (first:option<_>) =
seq {
match first with
| Some first' -> //'
(* The following value is always overwritten;
it represents the first element of the next subsequence to output, if any *)
let next = ref None
(* This function generates a subsequence to output,
setting next appropriately as it goes *)
let rec iter item =
seq {
yield item
if (en.MoveNext()) then
let curr = en.Current
if (cmp item curr) then
yield! iter curr
else // consumed one too many - pass it on as the start of the next sequence
next := Some curr
else
next := None
}
yield iter first' (* ' generate the first sequence *)
yield! partitions !next (* recursively generate all remaining sequences *)
| None -> () // return an empty sequence if there are no more values
}
let first = if en.MoveNext() then Some en.Current else None
partitions first
let groupContiguousDataPoints (time:TimeSpan) : (seq<DateTime*_> -> _) =
groupBy (fun (t,_) (t',_) -> t' - t <= time)
Okay, trying again. Achieving the optimal amount of laziness turns out to be a bit difficult in F#... On the bright side, this is somewhat more functional than my last attempt, in that it doesn't use any ref cells.
let groupBy cmp (sq:seq<_>) =
let en = sq.GetEnumerator()
let next() = if en.MoveNext() then Some en.Current else None
(* this function returns a pair containing the first sequence and a lazy option indicating the first element in the next sequence (if any) *)
let rec seqStartingWith start =
match next() with
| Some y when cmp start y ->
let rest_next = lazy seqStartingWith y // delay evaluation until forced - stores the rest of this sequence and the start of the next one as a pair
seq { yield start; yield! fst (Lazy.force rest_next) },
lazy Lazy.force (snd (Lazy.force rest_next))
| next -> seq { yield start }, lazy next
let rec iter start =
seq {
match (Lazy.force start) with
| None -> ()
| Some start ->
let (first,next) = seqStartingWith start
yield first
yield! iter next
}
Seq.cache (iter (lazy next()))
Below is some code that does what I think you want. It is not idiomatic F#.
(It may be similar to Brian's answer, though I can't tell because I'm not familiar with the LazyList semantics.)
But it doesn't exactly match your test specification: Seq.length enumerates its entire input. Your "test code" calls Seq.length and then calls Seq.hd. That will generate an enumerator twice, and since there is no caching, things get messed up. I'm not sure if there is any clean way to allow multiple enumerators without caching. Frankly, seq<seq<'a>> may not be the best data structure for this problem.
Anyway, here's the code:
type State<'a> = Unstarted | InnerOkay of 'a | NeedNewInner of 'a | Finished
// f() = true means the neighbors should be kept together
// f() = false means they should be split
let split_up (f : 'a -> 'a -> bool) (input : seq<'a>) =
// simple unfold that assumes f captured a mutable variable
let iter f = Seq.unfold (fun _ ->
match f() with
| Some(x) -> Some(x,())
| None -> None) ()
seq {
let state = ref (Unstarted)
use ie = input.GetEnumerator()
let innerMoveNext() =
match !state with
| Unstarted ->
if ie.MoveNext()
then let cur = ie.Current
state := InnerOkay(cur); Some(cur)
else state := Finished; None
| InnerOkay(last) ->
if ie.MoveNext()
then let cur = ie.Current
if f last cur
then state := InnerOkay(cur); Some(cur)
else state := NeedNewInner(cur); None
else state := Finished; None
| NeedNewInner(last) -> state := InnerOkay(last); Some(last)
| Finished -> None
let outerMoveNext() =
match !state with
| Unstarted | NeedNewInner(_) -> Some(iter innerMoveNext)
| InnerOkay(_) -> failwith "Move to next inner seq when current is active: undefined behavior."
| Finished -> None
yield! iter outerMoveNext }
open System
let groupContigs (contigTime : TimeSpan) (holey : seq<DateTime * int>) =
split_up (fun (t1,_) (t2,_) -> (t2 - t1) <= contigTime) holey
// Test data
let numbers = {1 .. 15}
let contiguousTimeStamps =
let baseTime = DateTime.Now
seq { for n in numbers -> baseTime.AddMinutes(float n)}
let holeyData =
Seq.zip contiguousTimeStamps numbers
|> Seq.filter (fun (dateTime, num) -> num % 7 <> 0)
let grouped_data = groupContigs (new TimeSpan(0,1,0)) holeyData
printfn "Consuming..."
for group in grouped_data do
printfn "about to do a group"
for x in group do
printfn " %A" x
Ok, here's an answer I'm not unhappy with.
(EDIT: I am unhappy - it's wrong! No time to try to fix right now though.)
It uses a bit of imperative state, but it is not too difficult to follow (provided you recall that '!' is the F# dereference operator, and not 'not'). It is as lazy as possible, and takes a seq as input and returns a seq of seqs as output.
let N = 20
let data = // produce some arbitrary data with holes
seq {
for x in 1..N do
if x % 4 <> 0 && x % 7 <> 0 then
printfn "producing %d" x
yield x
}
let rec GroupBy comp (input:seq<_>) = seq {
let doneWithThisGroup = ref false
let areMore = ref true
use e = input.GetEnumerator()
let Next() = areMore := e.MoveNext(); !areMore
// deal with length 0 or 1, seed 'prev'
if not(e.MoveNext()) then () else
let prev = ref e.Current
while !areMore do
yield seq {
while not(!doneWithThisGroup) do
if Next() then
let next = e.Current
doneWithThisGroup := not(comp !prev next)
yield !prev
prev := next
else
// end of list, yield final value
yield !prev
doneWithThisGroup := true }
doneWithThisGroup := false }
let result = data |> GroupBy (fun x y -> y = x + 1)
printfn "Consuming..."
for group in result do
printfn "about to do a group"
for x in group do
printfn " %d" x

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

Merge/join seq of seqs

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

Resources