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]
Related
I'm attempting to rewrite List.filter manually
so far I have this:
let rec filter f = function
|[] -> []
|x::xs -> if f x = true then x # filter f xs
else filter f xs;;
I'd add to the accepted answer that recognizing and applying functional patterns may be as important as mastery of recursion and pattern matching. And probably the first of such patterns is folding.
Implementing your task with folding takes a terse:
let filter p ls = List.foldBack (fun l acc -> if p l then l::acc else acc) ls []
Operator # appends 2 lists so x in if ... then ... else expression is supposed to be of type list.
You probably meant to use list cons operator ::. Also you don't need to compare the result of function f application to true.
let rec filter f = function
|[] -> []
|x::xs -> if f x then x :: filter f xs
else filter f xs
[1;2;3;4;5;6;7;8;9] |> filter (fun x -> x % 2 = 0)
val it : int list = [2; 4; 6; 8]
Note: this function is not tail recursive so you'll get stack overflow exception with big lists.
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 want to find the longest of two lists. Consider the following code sample:
let xs = ['B']
let ys = ['A'; 'B']
let longest = max xs ys
printfn "%A" longest
Contrary to my expectation the output of this program is ['B'] rather than ['A'; 'B'].
Why does List<'T> implement max this way? How/where exactly is this implementation defined?
I can see that max requires comparison, which I believe implies the implementation of IComparable. List<'T> does that automatically by making use of the StructuralComparison attribute. But how does this automatic implementation look like?
What is the most concise alternative I can use to get the longest of two lists?
F# compares lists element by element. As 'B' > 'A' so it considers first list > second (lexicographic order) and breaks further comparison. You can use .Length property on list to compare lengths.
Like this for example;
let longest = if xs.Length > ys.Length then xs else ys
Result:
val longest : char list = ['A'; 'B']
Here is a reusable function for checking the greater length of any 2 sequences:
let longest x y = match (Seq.length x > Seq.length y) with
|true -> x
|false -> y
If you want a general way to compare two objects by some property you could create a maxBy function:
let maxBy f x y = Array.maxBy f [|x; y|]
then you can do:
let longest = maxBy List.length xs ys
or directly:
let longest = Array.maxBy List.length [|xs; ys|]
You can write a maxBy function:
let maxBy f a b = if f b > f a then b else a
Then call it thus:
let longestList = maxBy List.length xs ys
Since List.length is O(N), performance will suffer if the lists are very long. The operation will be O(N1 + N2), where N1 and N2 are the lengths of the lists.
Performance will suffer needlessly if one is long and the other is short. To avoid that, you could write a more specific function. This function is O(min(N1, N2)):
let getLongest list1 list2 =
let rec helper = function
| [], _ -> list2
| _, [] -> list1
| _ :: t1, _ :: t2 -> helper (t1, t2)
helper (list1, list2)
let longestList = getLongest xs ys
Here's a reusable function that will return the longest list from a list of lists:
let longest ll = ll |> List.sortBy List.length |> List.rev |> List.head
Examples:
> longest [xs; ys];;
val it : char list = ['A'; 'B']
> let zs = ['A' .. 'D'];;
val zs : char list = ['A'; 'B'; 'C'; 'D']
> longest [xs; zs; ys];;
val it : char list = ['A'; 'B'; 'C'; 'D']
However, it doesn't work if you input the empty list, as it'd be up to you do define exactly what you'd want the behaviour to be in that case.
I want a way to get rid of repeating pairs in an array. For my problem, the pairs will be consecutive, and there will be at most one repeating pair.
My current implementation seems too complicated. The elements 3 and 4 form what I'm calling a repeating pair in arr1 below. As a pair, they only appear once in the desired output, arr2. What are some more efficient ways?
let arr1=[|4; 2; 3; 4; 3; 4; 1|]
let n=arr1.Length
let iPlus2IsEqual=Array.map2 (fun x y -> x=y) arr1.[2..] arr1.[..(n-3)]
let consecutive=Array.map2 (fun x y -> x && y) iPlus2IsEqual.[1..] iPlus2IsEqual.[..(n-4)] |> Array.tryFindIndex (fun x -> x)
let dup=if consecutive.IsSome then consecutive.Value+1 else n-1
let arr2=if dup>=n-3 then arr1.[..dup] else Array.append arr1.[..dup] arr1.[(dup+3)..]
>
val arr2 : int [] = [|4; 2; 3; 4; 1|]
We can use recursion like so (it will get multiple repeats for free too)
let rec filterrepeats l =
match l with
|a::b::c::d::t when a=c && b=d -> a::b::(filterrepeats t)
|h::t ->h::(filterrepeats t)
|[] -> []
> filterrepeats [4;2;3;4;3;4;1];;
val it : int list = [4; 2; 3; 4; 1]
This works on lists, so you will need to add a call to Array.toList before you run it.
The above is not tail recursive as the compiler doesn't know what goes on the right hand side of h::(filterrepeats t) until after the function call. You can solve this by using an accumulator like so:
let rec filterrepeats l =
let rec loop l acc =
match l with
|a::b::c::d::t when a=c && b=d ->loop t (b::a::acc)
|h::t ->loop t (h::acc)
|[] -> acc
loop (List.rev l) []
For large arrays this is around 13x faster than your solution:
let inline tryFindDuplicatedPairIndex (xs: _ []) =
let rec loop i x0 x1 x2 =
if i < xs.Length-4 then
let x3 = xs.[i+3]
if x0=x2 && x1=x3 then Some i else
loop (i+1) x1 x2 x3
else None
if xs.Length < 4 then None else
loop 0 xs.[0] xs.[1] xs.[2]
let inline removeDuplicatedPair (xs: _ []) =
match tryFindDuplicatedPairIndex xs with
| None -> Array.copy xs
| Some i ->
let ys = Array.zeroCreate (xs.Length-2)
for j=0 to i-1 do
ys.[j] <- xs.[j]
for j=i+2 to xs.Length-1 do
ys.[j-2] <- xs.[j]
ys
I use inline and test elements individually (i.e. rather than as a tuple: (x0,x1) = (x2,x3)) to try to prevent = from being a generic equality test because that is very slow. I've reused previous array lookups from one iteration to the next. I copy the input array if the output is identical to the input and pre-allocate an array with n-2 elements otherwise. I've hand-rolled the copying to my pre-allocated array to avoid creating any garbage (e.g. instead of Array.append of two slices).
No stack overflow with large list (length >= 100K) and remove all duplicate pairs
let rec distinctPairs list =
List.foldBack (fun x (l,r) -> x::r, l) list ([],[])
|> fun (odds, evens) -> List.zip odds evens
|> Seq.distinct
Not very fast, 1M list take 500ms, anyway faster ?
Only work for list with even length
This is how I implemented merge-sort in F# using imperative style:
let merge (l1: List<string>, l2: List<string>) =
let r: List<string> = new List<string>()
let mutable (i,j, cnt1, cnt2) = (0,0, l1.Count, l2.Count)
while i < cnt1 && j < cnt2 do
if l1.[i] <= l2.[j] then
r.Add (l1.[i])
i <- i + 1
else
r.Add (l2.[j])
j <- j + 1
if i = cnt1 then
while j < cnt2 do
r.Add (l2.[j])
j <- j + 1
else
while i < cnt1 do
r.Add (l1.[i])
i <- i + 1
r
Can you convert this to alternate 'functional' styled implementation and explain how it works, if possible? Even though I am studying list comprehensions and all that at the moment, I can't come up with an idea to use it here.
You're using .NET List<'T> which is renamed to ResizeArray<'T> in F# to avoid confusion. If you use functional list, merge function would look like this:
let merge(xs, ys) =
let rec loop xs ys acc =
match xs, ys with
| [], [] -> List.rev acc (* 1 *)
| [], y::ys' -> loop xs ys' (y::acc) (* 2 *)
| x::xs', [] -> loop xs' ys (x::acc) (* 3 *)
| x::xs', y::_ when x <= y -> loop xs' ys (x::acc) (* 4 *)
| _::_, y::ys' -> loop xs ys' (y::acc) (* 5 *)
loop xs ys []
To explain this function in terms of your imperative version:
The 4th and 5th patterns are corresponding to the first while loop where you compare two current elements and add the smaller one into a resulting list.
The 2nd and 3rd patterns are similar to your 2nd and 3rd while loops.
The first pattern is the case where i = cnt1 and j = cnt2 and we should return results. Since a new element is always prepended to the accumulator, we need to reverse it to get a list in the increasing order.
To be precise, your merge function is just one part of merge-sort algorithm. You need a function to split a list in two halves, call merge-sort on two halves and merge two sorted halves into one. The split function below is left for you as an exercise.
let rec mergeSort ls =
match ls with
| [] | [_] -> ls
| _ -> let xs, ys = split ls
let xs', ys' = mergeSort xs, mergeSort ys
merge(xs', ys')
To add a more simple but naive alternative to pad's:
let rec merge x y =
match (x, y) with
| ([], []) -> []
| ([], rest) -> rest
| (rest, []) -> rest
| (fx :: xs, fy :: _) when fx <= fy -> fx :: merge xs y
| (fx :: _, fy :: ys) -> fy :: merge x ys
Similarly to pad's, we're pattern matching over the function parameters.
I first put them into a tuple so that I can pattern match them both at the same time.
I then take care of the base cases with both or either of the parameters being empty.
I then use when guard to check which first item is smaller
I finally take the first item and cons it to the result of another call to merge with the rest of the items the smaller item was taken from and the whole of the other list. So if the first item of x is smaller, I append the first item of x (fx in this case) to the result of a call to merge passing in the rest of x (xs) and the whole of y (because the first item of y was larger).