How to match multiple copies of a value? - f#

F#'s pattern matching is very powerful so it felt natural to write:
match (tuple1, tuple2) with
| ((a, a), (a, a)) -> "all values are the same"
| ((a, b), (a, b)) -> "tuples are the same"
| ((a, b), (a, c)) -> "first values are the same"
// etc
However, the first pattern match gives a compiler error:
'a' is bound twice in this pattern
Is there a cleaner way to do it than the following?
match (tuple1, tuple2) with
| ((a, b), (c, d)) when a = b && b = c && c = d -> "all values are the same"
| ((a, b), (c, d)) when a = c && b = d -> "tuples are the same"
| ((a, b), (c, d)) when a = c -> "first values are the same"
// etc

This is a perfect use case for F#'s "active patterns". You can define a couple of them like this:
let (|Same|_|) (a, b) =
if a = b then Some a else None
let (|FstEqual|_|) ((a, _), (c, _)) =
if a = c then Some a else None
And then clean up your pattern matching with them; note how the first case (where all values are equal) uses the nested Same pattern to check that the first and second elements of the tuple are equal:
match tuple1, tuple2 with
| Same (Same x) ->
"all values are the same"
| Same (x, y) ->
"tuples are the same"
| FstEqual a ->
"first values are the same"
| _ ->
failwith "TODO"
Performance tip: I like to mark simple active patterns like these with inline -- since the logic within the active patterns is simple (just a few IL instructions), it makes sense to inline them and avoid the overhead of a function call.

You can use parameterized active patterns to remedy the issue.
let (|TuplePairPattern|_|) ((p1, p2), (p3, p4)) ((a, b), (c, d)) =
let matched =
[(p1, a); (p2, b); (p3, c); (p4, d)]
|> Seq.groupBy fst
|> Seq.map (snd >> Set.ofSeq)
|> Seq.forall (fun s -> Set.count s = 1)
if matched then Some () else None
Particularly, you should define a pattern in a form of literals (chars, strings, etc).
match tuple1, tuple2 with
| TuplePairPattern(('a', 'a'), ('a', 'a')) -> "all values are the same"
| TuplePairPattern(('a', 'b'), ('a', 'b')) -> "tuples are the same"
| TuplePairPattern(("a", "b"), ("a", "c")) -> "first values are the same"
// etc

I think, the most elegant way can be accomplished by combining two excellent answers provided by #Stephen Swensen and #pad.
The first idea is that the structure (a tuple containing two tuples) can be unpacked once, instead of doing it in every match case.
The second idea is working with sequences of values, all of which must be equal to each other.
Here's the code:
let comparer ((a,b),(c,d)) =
let same = Set.ofSeq >> Set.count >> ((=) 1)
if same[a; b; c; d] then "all values are the same"
elif same[a; c] && same[b; d] then "tuples are the same"
elif same[a; c] then "first values are the same"
else "none of above"
You may change elif's into a match, but does not seem feasible to me.

In practice, I would probably unpack the tuples up-front and then do a series of if / then / else expressions:
let a,b = tuple1
let c,d = tuple2
if a = b && b = c && c = d then "all values are the same"
elif a = c && b = d then "tuples are the same"
elif a = c then "first values are the same"
...
If you find yourself doing this frequently, an active pattern might be warranted (and in the case of 2-tuples, a complete active pattern would be doable and likely preferable - exhaustive matches are "safer" than non-exhaustive matches). Or, perhaps you need a more sophisticated data structure.

Related

F# computation expressions: Can one be used to simplify this code?

I have recently started using computation expressions to simplify my code. So far the only useful one for me is the MaybeBuilder, defined thusly:
type internal MaybeBuilder() =
member this.Bind(x, f) =
match x with
| None -> None
| Some a -> f a
member this.Return(x) =
Some x
member this.ReturnFrom(x) = x
But I would like to explore other uses. One possibility is in the situation I am currently facing. I have some data supplied by a vendor that defines a symmetric matrix. To save space, only a triangular portion of the matrix is given, as the other side is just the transpose. So if I see a line in the csv as
abc, def, 123
this means that the value for row abc and column def is 123. But I will not see a line such as
def, abc, 123
because this information has already been given due to the symmetrical nature of the matrix.
I have loaded all this data in a Map<string,Map<string,float>> and I have a function that gets me the value for any entry that looks like this:
let myLookupFunction (m:Map<string,Map<string,float>>) s1 s2 =
let try1 =
match m.TryFind s1 with
|Some subMap -> subMap.TryFind s2
|_ -> None
match try1 with
|Some f -> f
|_ ->
let try2 =
match m.TryFind s2 with
|Some subMap -> subMap.TryFind s1
|_ -> None
match try2 with
|Some f -> f
|_ -> failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
Now that I know about computation expressions, I suspect that the match statements can be hidden.
I can clean it up slightly using the MaybeBuilder like so
let myFunction2 (m:Map<string,Map<string,float>>) s1 s2 =
let maybe = new MaybeBuilder()
let try1 = maybe{
let! subMap = m.TryFind s1
return! subMap.TryFind s2
}
match try1 with
|Some f -> f
|_ ->
let try2 = maybe{
let! subMap = m.TryFind s2
return! subMap.TryFind s1
}
match try2 with
|Some f -> f
|_ -> failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
Doing so, I have gone from 4 match statements to 2. Is there a (not contrived) way of cleaning this up even further by using computation expressions?
First of all, creating a new MaybeBuilder every time you need it is kinda wasteful. You should do that once, preferably right next to the definition of MaybeBuilder itself, and then just use the same instance everywhere. This is how most computation builders work.
Second: you can cut down on the amount of clutter if you just define the "try" logic as a function and reuse it:
let myFunction2 (m:Map<string,Map<string,float>>) s1 s2 =
let try' (x1, x2) = maybe{
let! subMap = m.TryFind x1
return! subMap.TryFind x2
}
match try' (s1, s2) with
|Some f -> f
|_ ->
match try' (s2, s1) with
|Some f -> f
|_ -> failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
Third, notice the pattern you're using: try this, if not try that, if not try another, etc. Patterns can be abstracted as functions (that's the whole gig!), so let's do that:
let orElse m f = match m with
| Some x -> Some x
| None -> f()
let myFunction2 (m:Map<string,Map<string,float>>) s1 s2 =
let try' (x1, x2) = maybe{
let! subMap = m.TryFind x1
return! subMap.TryFind x2
}
let result =
try' (s1, s2)
|> orElse (fun() -> try' (s2, s1))
match result with
|Some f -> f
|_ -> failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
And finally, I think you're going about it the wrong way. What you really seem to be after is a dictionary with two-part symmetric key. So why not just do that?
module MyMatrix =
type MyKey = private MyKey of string * string
type MyMatrix = Map<MyKey, float>
let mkMyKey s1 s2 = if s1 < s2 then MyKey (s1, s2) else MyKey (s2, s1)
let myFunction2 (m:MyMatrix.MyMatrix) s1 s2 =
match m.TryFind (MyMatrix.mkMyKey s1 s2) with
| Some f -> f
| None -> failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
Here, MyKey is a type that encapsulates a pair of strings, but guarantees that those strings are "in order" - i.e. the first one is lexicographically "less" than the second one. To guarantee this, I made the constructor of the type private, and instead exposed a function mkMyKey that properly constructs the key (sometimes referred to as "smart constructor").
Now you can freely use MyKey to both construct and lookup the map. If you put in (a, b, 42), you will get out both (a, b, 42) and (b, a, 42).
Some aside: the general mistake I see in your code is failure to use abstraction. You don't have to handle every piece of the data at the lowest level. The language allows you to define higher-level concepts and then program in terms of them. Use that ability.
I understand this might be just a simplification for the purpose of asking the question here - but what do you actually want to do when none of the keys is found and how often do you expect that the first lookup will fails?
There are good reasons to avoid exceptions in F# - they are slower (I don't know how much exactly and it probably depends on your use case) and they are supposed to be used in "exceptional circumstances", but the language does have a nice support for them.
Using exceptions, you can write it as a pretty readable three-liner:
let myLookupFunction (m:Map<string,Map<string,float>>) s1 s2 =
try m.[s1].[s2] with _ ->
try m.[s2].[s1] with _ ->
failwith (sprintf "Unable to locate a value between %s and %s" s1 s2)
That said, I completely agree with Fyodor that it would make a lot of sense to define your own data structure for keeping the data rather than using a map of maps (with possibly switched keys).

F#, implement fold3, fold4, fold_n

I am interested to implement fold3, fold4 etc., similar to List.fold and List.fold2. e.g.
// TESTCASE
let polynomial (x:double) a b c = a*x + b*x*x + c*x*x*x
let A = [2.0; 3.0; 4.0; 5.0]
let B = [1.5; 1.0; 0.5; 0.2]
let C = [0.8; 0.01; 0.001; 0.0001]
let result = fold3 polynomial 0.7 A B C
// 2.0 * (0.7 ) + 1.5 * (0.7 )^2 + 0.8 * (0.7 )^3 -> 2.4094
// 3.0 * (2.4094) + 1.0 * (2.4094)^2 + 0.01 * (2.4094)^3 -> 13.173
// 4.0 * (13.173) + 0.5 * (13.173)^2 + 0.001 * (13.173)^3 -> 141.75
// 5.0 * (141.75) + 0.2 * (141.75)^2 + 0.0001 * (141.75)^3 -> 5011.964
//
// Output: result = 5011.964
My first method is grouping the 3 lists A, B, C, into a list of tuples, and then apply list.fold
let fold3 f x A B C =
List.map3 (fun a b c -> (a,b,c)) A B C
|> List.fold (fun acc (a,b,c) -> f acc a b c) x
// e.g. creates [(2.0,1.5,0.8); (3.0,1.0,0.01); ......]
My second method is to declare a mutable data, and use List.map3
let mutable result = 0.7
List.map3 (fun a b c ->
result <- polynomial result a b c // Change mutable data
// Output intermediate data
result) A B C
// Output from List.map3: [2.4094; 13.17327905; 141.7467853; 5011.963942]
// result mutable: 5011.963942
I would like to know if there are other ways to solve this problem. Thank you.
For fold3, you could just do zip3 and then fold:
let polynomial (x:double) (a, b, c) = a*x + b*x*x + c*x*x*x
List.zip3 A B C |> List.fold polynomial 0.7
But if you want this for the general case, then you need what we call "applicative functors".
First, imagine you have a list of functions and a list of values. Let's assume for now they're of the same size:
let fs = [ (fun x -> x+1); (fun x -> x+2); (fun x -> x+3) ]
let xs = [3;5;7]
And what you'd like to do (only natural) is to apply each function to each value. This is easily done with List.map2:
let apply fs xs = List.map2 (fun f x -> f x) fs xs
apply fs xs // Result = [4;7;10]
This operation "apply" is why these are called "applicative functors". Not just any ol' functors, but applicative ones. (the reason for why they're "functors" is a tad more complicated)
So far so good. But wait! What if each function in my list of functions returned another function?
let f1s = [ (fun x -> fun y -> x+y); (fun x -> fun y -> x-y); (fun x -> fun y -> x*y) ]
Or, if I remember that fun x -> fun y -> ... can be written in the short form of fun x y -> ...
let f1s = [ (fun x y -> x+y); (fun x y -> x-y); (fun x y -> x*y) ]
What if I apply such list of functions to my values? Well, naturally, I'll get another list of functions:
let f2s = apply f1s xs
// f2s = [ (fun y -> 3+y); (fun y -> 5+y); (fun y -> 7+y) ]
Hey, here's an idea! Since f2s is also a list of functions, can I apply it again? Well of course I can!
let ys = [1;2;3]
apply f2s ys // Result: [4;7;10]
Wait, what? What just happened?
I first applied the first list of functions to xs, and got another list of functions as a result. And then I applied that result to ys, and got a list of numbers.
We could rewrite that without intermediate variable f2s:
let f1s = [ (fun x y -> x+y); (fun x y -> x-y); (fun x y -> x*y) ]
let xs = [3;5;7]
let ys = [1;2;3]
apply (apply f1s xs) ys // Result: [4;7;10]
For extra convenience, this operation apply is usually expressed as an operator:
let (<*>) = apply
f1s <*> xs <*> ys
See what I did there? With this operator, it now looks very similar to just calling the function with two arguments. Neat.
But wait. What about our original task? In the original requirements we don't have a list of functions, we only have one single function.
Well, that can be easily fixed with another operation, let's call it "apply first". This operation will take a single function (not a list) plus a list of values, and apply this function to each value in the list:
let applyFirst f xs = List.map f xs
Oh, wait. That's just map. Silly me :-)
For extra convenience, this operation is usually also given an operator name:
let (<|>) = List.map
And now, I can do things like this:
let f x y = x + y
let xs = [3;5;7]
let ys = [1;2;3]
f <|> xs <*> ys // Result: [4;7;10]
Or this:
let f x y z = (x + y)*z
let xs = [3;5;7]
let ys = [1;2;3]
let zs = [1;-1;100]
f <|> xs <*> ys <*> zs // Result: [4;-7;1000]
Neat! I made it so I can apply arbitrary functions to lists of arguments at once!
Now, finally, you can apply this to your original problem:
let polynomial a b c (x:double) = a*x + b*x*x + c*x*x*x
let A = [2.0; 3.0; 4.0; 5.0]
let B = [1.5; 1.0; 0.5; 0.2]
let C = [0.8; 0.01; 0.001; 0.0001]
let ps = polynomial <|> A <*> B <*> C
let result = ps |> List.fold (fun x f -> f x) 0.7
The list ps consists of polynomial instances that are partially applied to corresponding elements of A, B, and C, and still expecting the final argument x. And on the next line, I simply fold over this list of functions, applying each of them to the result of the previous.
You could check the implementation for ideas:
https://github.com/fsharp/fsharp/blob/master/src/fsharp/FSharp.Core/array.fs
let fold<'T,'State> (f : 'State -> 'T -> 'State) (acc: 'State) (array:'T[]) =
checkNonNull "array" array
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)
let mutable state = acc
for i = 0 to array.Length-1 do
state <- f.Invoke(state,array.[i])
state
here's a few implementations for you:
let fold2<'a,'b,'State> (f : 'State -> 'a -> 'b -> 'State) (acc: 'State) (a:'a array) (b:'b array) =
let mutable state = acc
Array.iter2 (fun x y->state<-f state x y) a b
state
let iter3 f (a: 'a[]) (b: 'b[]) (c: 'c[]) =
let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)
if a.Length <> b.Length || a.Length <> c.Length then failwithf "length"
for i = 0 to a.Length-1 do
f.Invoke(a.[i], b.[i], c.[i])
let altIter3 f (a: 'a[]) (b: 'b[]) (c: 'c[]) =
if a.Length <> b.Length || a.Length <> c.Length then failwithf "length"
for i = 0 to a.Length-1 do
f (a.[i]) (b.[i]) (c.[i])
let fold3<'a,'b,'State> (f : 'State -> 'a -> 'b -> 'c -> 'State) (acc: 'State) (a:'a array) (b:'b array) (c:'c array) =
let mutable state = acc
iter3 (fun x y z->state<-f state x y z) a b c
state
NB. we don't have an iter3, so, implement that. OptimizedClosures.FSharpFunc only allow up to 5 (or is it 7?) params. There are a finite number of type slots available. It makes sense. You can go higher than this, of course, without using the OptimizedClosures stuff.
... anyway, generally, you don't want to be iterating too many lists / arrays / sequences at once. So I'd caution against going too high.
... the better way forward in such cases may be to construct a record or tuple from said lists / arrays, first. Then, you can just use map and iter, which are already baked in. This is what zip / zip3 are all about (see: "(array1.[i],array2.[i],array3.[i])")
let zip3 (array1: _[]) (array2: _[]) (array3: _[]) =
checkNonNull "array1" array1
checkNonNull "array2" array2
checkNonNull "array3" array3
let len1 = array1.Length
if len1 <> array2.Length || len1 <> array3.Length then invalidArg3ArraysDifferent "array1" "array2" "array3" len1 array2.Length array3.Length
let res = Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked len1
for i = 0 to res.Length-1 do
res.[i] <- (array1.[i],array2.[i],array3.[i])
res
I'm working with arrays at the moment, so my solution pertained to those. Sorry about that. Here's a recursive version for lists.
let fold3 f acc a b c =
let mutable state = acc
let rec fold3 f a b c =
match a,b,c with
| [],[],[] -> ()
| [],_,_
| _,[],_
| _,_,[] -> failwith "length"
| ahead::atail, bhead::btail, chead::ctail ->
state <- f state ahead bhead chead
fold3 f atail btail ctail
fold3 f a b c
i.e. we define a recursive function within a function which acts upon/mutates/changes the outer scoped mutable acc variable (a closure in functional speak). Finally, this gets returned.
It's pretty cool how much type information gets inferred about these functions. In the array examples above, mostly I was explicit with 'a 'b 'c. This time, we let type inference kick in. It knows we're dealing with lists from the :: operator. That's kind of neat.
NB. the compiler will probably unwind this tail-recursive approach so that it is just a loop behind-the-scenes. Generally, get a correct answer before optimising. Just mentioning this, though, as food for later thought.
I think the existing answers provide great options if you want to generalize folding, which was your original question. However, if I simply wanted to call the polynomial function on inputs specified in A, B and C, then I would probably do not want to introduce fairly complex constructs like applicative functors with fancy operators to my code base.
The problem becomes a lot easier if you transpose the input data, so that rather than having a list [A; B; C] with lists for individual variables, you have a transposed list with inputs for calculating each polynomial. To do this, we'll need the transpose function:
let rec transpose = function
| (_::_)::_ as M -> List.map List.head M :: transpose (List.map List.tail M)
| _ -> []
Now you can create a list with inputs, transpose it and calculate all polynomials simply using List.map:
transpose [A; B; C]
|> List.map (function
| [a; b; c] -> polynomial 0.7 a b c
| _ -> failwith "wrong number of arguments")
There are many ways to solve this problem. Few are mentioned like first zip3 all three list, then run over it. Using Applicate Functors like Fyodor Soikin describes means you can turn any function with any amount of arguments into a function that expects list instead of single arguments. This is a good general solution that works with any numbers of lists.
While this is a general good idea, i'm sometimes shocked that so few use more low-level tools. In this case it is a good idea to use recursion and learn more about recursion.
Recursion here is the right-tool because we have immutable data-types. But you could consider how you would implement it with mutable lists and looping first, if that helps. The steps would be:
You loop over an index from 0 to the amount of elements in the lists.
You check if every list has an element for the index
If every list has an element then you pass this to your "folder" function
If at least one list don't have an element, then you abort the loop
The recursive version works exactly the same. Only that you don't use an index to access the elements. You would chop of the first element from every list and then recurse on the remaining list.
Otherwise List.isEmpty is the function to check if a List is empty. You can chop off the first element with List.head and you get the remaining list with the first element removed by List.tail. This way you can just write:
let rec fold3 f acc l1 l2 l3 =
let h = List.head
let t = List.tail
let empty = List.isEmpty
if (empty l1) || (empty l2) && (empty l3)
then acc
else fold3 f (f acc (h l1) (h l2) (h l3)) (t l1) (t l2) (t l3)
The if line checks if every list has at least one element. If that is true
it executes: f acc (h l1) (h l2) (h l3). So it executes f and passes it the first element of every list as an argument. The result is the new accumulator of
the next fold3 call.
Now that you worked on the first element of every list, you must chop off the first element of every list, and continue with the remaining lists. You achieve that with List.tail or in the above example (t l1) (t l2) (t l3). Those are the next remaining lists for the next fold3 call.
Creating a fold4, fold5, fold6 and so on isn't really hard, and I think it is self-explanatory. My general advice is to learn a little bit more about recursion and try to write recursive List functions without Pattern Matching. Pattern Matching is not always easier.
Some code examples:
fold3 (fun acc x y z -> x + y + z :: acc) [] [1;2;3] [10;20;30] [100;200;300] // [333;222;111]
fold3 (fun acc x y z -> x :: y :: z :: acc) [] [1;2;3] [10;20;30] [100;200;300] // [3; 30; 300; 2; 20; 200; 1; 10; 100]

F# Traversing tree to make specific set

So I'm sitting with this problem that I can't seem to get my head around in a sensible way. What I'm trying to achieve here is that I have a function descriptionOf os t that takes an Outcome list, os, and a Tree, which ist, and returns a Description using the helper function descriptionOf'. That works quite alright and feeding it with the Outcome list: let outcomeTest = [F;S] and the tree:
let testTree = Branch(">2",0.67, Branch(">3",0.5, Leaf "A", Leaf "B"),Branch(">3",2.5, Leaf "C", Leaf "D")) gives me the following result:
([(F, ">2"); (S, ">3")], 0.825, "C").
Now, as you can see, I've begun making allDescriptions which should take a Tree and return a Set<Description> but I can't the for love of me figure out how to make this set. I've been fiddling with the idea of reusing descriptionOf but the problem the way I see it, is that I don't have an os to give it, but only a tree t. I'm imagining the expected outcome by making the Set<Description> on testTree would be something like this:
set: [([(S,">2");(S,">3")], 0.335, "A"); ([(S,">2");(F,">3")], 0.335, "B");
([(F,">2");(S,">3")], 0.165, "C"); ([(F,">2");(F,">3")], 0.165, "D")].
I hope my question makes sense! Any hints greatly appreciated.
type Outcome = | S | F
type Sample = Outcome list
type Tree = | Branch of string * float * Tree * Tree
| Leaf of string
type Description = ((Sample * string) list * float * string)
let rec descriptionOf' = function
| (os, Branch(ds, p, tl, tr), (dsl, dp, s)) when List.length os > 1 && os.Head = F -> descriptionOf' (os.Tail, tr, (dsl # [(os.Head, ds)], dp * (1.0 - p), ""))
| (os, Branch(ds, p, tl, tr), (dsl, dp, s)) when List.length os > 1 && os.Head = S -> descriptionOf' (os.Tail, tl, (dsl # [(os.Head, ds)], dp * (p), ""))
| (os, Branch(ds, p, Leaf l1, Leaf l2), (dsl, dp, s)) when List.length os = 1 && os.Head = F -> (dsl # [(os.Head, ds)], dp * (1.0 - p), l2)
| (os, Branch(ds, p, Leaf l1, Leaf l2), (dsl, dp, s)) when List.length os = 1 && os.Head = S -> (dsl # [(os.Head, ds)], dp * (p), l1)
| _ -> failwith "Not a correct sample"
let descriptionOf os t =
if isSample(os, t) = false then failwith "Not a correct sample" else
descriptionOf'(os, t, ([], 1.0, ""))
let allDescriptions = Set.empty.Add() // What should this do?

Is there a way to do a multiple value comparison inline?

I feel silly for even asking this because it seems so trivial but my brain is failing me. If I had the following:
let a, b, c = 1, 1, 1
Is there an eligant way to determine if a, b, and c all hold the same value. Something like:
let result = (a = b = c)
This fails because the expression a = b returns true and the next expression results in true = c and complains that it was expecting int, not bool. The only thing I can think of is:
a = b && a = c && b = c
which won't work when I want to add more variables.
Really what I'm trying to do is this:
let same (x: string * string * string) =
match x with
| (a, a, a) -> true
| _ -> false
I was hoping that I could match all the elements into one element and if they were different it would move on, but it says on the second element in the match that it has already been bound.
To check if every value in a list is the same:
let rec same = function
| x::y::_ when x <> y -> false
| _::xs -> same xs
| [] -> true
Usage
let a, b, c = 1, 1, 1
same [a; b; c] //true
let same (a, b, c) = a = b && b = c
I would try to use the forall function in order to determine if all of the numbers are same.
let list = [a; b; c;];;
List.forall (fun n -> n = a) list;;
val it : bool = true
This solution produces exactly the required syntax. Surprisingly to myself, is fairly fast. Also, is seems to be a good example of using monads, also known as Computation Expressions.
// Generic
let inline mOp1<'a> op sample x = op sample x, sample
let inline mOp2<'a> op1 op2 (b, sample) x = op1 b (op2 sample x), sample
// Implementation for (=) and (&&)
let (==) = mOp1 (=)
let (&=) = mOp2 (&&) (=)
// Use
let ret1 = a == b &= c &= d &= e |> fst
How it works
The approach is a very simplified State monad. The monadic type is a tuple of (bool, 'T). The first component is the boolean value of ongoing calculation, and the second is the sample value to compare with.
(==) would initialize the monad, similar to Delay operator.
(&=) is used for all subsequent comparisons. It is similar to Bind operator.
We don't need Return because fst would serve pretty fine.
mOp1 and mOp2 are abstractions over the logical operations. These allow defining your own operators. Here are examples of or-equal and and-greater-than:
let (|=) = mOp2 (||) (=)
let (.>) = mOp1 (>)
let (&>) = mOp2 (&&) (>)
// Use
let ret2 = a == b |= c |= d |= e |> fst // if any of b,c,d,e equals to a
let ret3 = 5 .> 3 &> 4 |> fst // true: 5>3 && 5>4
let ret4 = 5 .> 3 &> 8 &> 4 |> fst // false
Performance
I really enjoyed the beautiful solution by #ildjarn, but constructing List is quite slow, so my primary goal was performance.
Running a chain of 8 comparisons, 10 million times:
04972ms a=b && a=с && ...
23138ms List-based
12367ms monadic

F# elegance needed for Master-Detail scenario

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 })

Resources