How to improve performance with F# idioms - performance

Question

I'm using this course on Machine-Learning to learn F# at the same time. I've done the following homework exercise which is the first exercise of the second week:
Run a computer simulation for flipping 1,000 virtual fair coins. Flip
each coin independently 10 times. Focus on 3 coins as follows: c1
is the first coin flipped, crand is a coin chosen randomly from
the 1,000, and cmin is the coin which had the minimum frequency of
heads (pick the earlier one in case of a tie).
Let ν1 , νrand
, and νmin be the fraction of heads obtained for the 3 respective
coins out of the 10 tosses. Run the experiment 100,000 times in order
to get a full distribution of ν1 , νrand, and νmin (note that c rand
and c min will change from run to run).
What is the average value of νmin?
I have produced the following code, which works fine and gives the correct answer:
let private rnd = System.Random()
let FlipCoin() = rnd.NextDouble() > 0.5
let FlipCoinNTimes N = List.init N (fun _ -> FlipCoin())
let FlipMCoinsNTimes M N = List.init M (fun _ -> FlipCoinNTimes N)
let ObtainFrequencyOfHeads tosses =
let heads = tosses |> List.filter (fun toss -> toss = true)
float (List.length (heads)) / float (List.length (tosses))
let GetFirstRandMinHeadsFraction allCoinsLaunchs =
let first = ObtainFrequencyOfHeads(List.head (allCoinsLaunchs))
let randomCoin = List.item (rnd.Next(List.length (allCoinsLaunchs))) allCoinsLaunchs
let random = ObtainFrequencyOfHeads(randomCoin)
let min =
allCoinsLaunchs
|> List.map (fun coin -> ObtainFrequencyOfHeads coin)
|> List.min
(first, random, min)
module Exercice1 =
let GetResult() =
Seq.init 100000 (fun _ -> FlipMCoinsNTimes 1000 10)
|> Seq.map (fun oneExperiment -> GetFirstRandMinHeadsFraction oneExperiment)
|> Seq.map (fun (first, random, min) -> min)
|> Seq.average
However, it takes roughly 4 minutes to run in my machine. I know that it is doing a lot of work, but I'm wondering if there are some modifications that could be made to optimize it.
As I'm trying lo learn F#, I'm asking for optimizations that use F# idioms, not to change the code to a C-style.
Feel free to suggest any kind of improvement, in style, good practices, etc.
[UPDATE]
I have written some code to compare the proposed solutions, it is accesible here.
These are the results:
Base - result: 0.037510, time elapsed: 00:00:55.1274883, improvement:
0.99 x
Matthew Mcveigh - result: 0.037497, time elapsed: 00:00:15.1682052, improvement: 3.61 x
Fyodor Soikin - result:0.037524, time elapsed: 00:01:29.7168787, improvement: 0.61 x
GuyCoder - result: 0.037645, time elapsed: 00:00:02.0883482, improvement: 26.25 x
GuyCoder MathNet- result: 0.037666, time elapsed:
00:00:24.7596117, improvement: 2.21 x
TheQuickBrownFox - result:
0.037494, time elapsed: 00:00:34.2831239, improvement: 1.60 x
The winner concerning the improvement in time is the GuyCoder, so I will accept his answer. However, I find that his code is more difficult to understand.

Answer 1

Allocating a large amount of lists up front is heavy work, the algorithm can be processed online e.g. via sequences or recursion. I transformed all the work into tail recursive functions for some raw speed (will be transformed into loops by the compiler)
not guaranteed to be 100% correct, but hopefully gives you a gist of where I was going with it:
let private rnd = System.Random()
let flipCoin () = rnd.NextDouble() > 0.5
let frequencyOfHeads flipsPerCoin =
let rec countHeads numHeads i =
if i < flipsPerCoin then
let isHead = flipCoin ()
countHeads (if isHead then numHeads + 1 else numHeads) (i + 1)
else
float numHeads
countHeads 0 0 / float flipsPerCoin
let getFirstRandMinHeadsFraction numCoins flipsPerCoin =
let randomCoinI = rnd.Next numCoins
let rec run first random min i =
if i < numCoins then
let frequency = frequencyOfHeads flipsPerCoin
let first = if i = 0 then frequency else first
let random = if i = randomCoinI then frequency else random
let min = if min > frequency then frequency else min
run first random min (i + 1)
else
(first, random, min)
run 0.0 0.0 System.Double.MaxValue 0
module Exercice1 =
let getResult () =
let iterations, numCoins, numFlips = 100000, 1000, 10
let getMinFromExperiment () =
let (_, _, min) = getFirstRandMinHeadsFraction numCoins numFlips
min
let rec sumMinFromExperiments i sumOfMin =
if i < iterations then
sumMinFromExperiments (i + 1) (sumOfMin + getMinFromExperiment ())
else
sumOfMin
let sum = sumMinFromExperiments 0 0.0
sum / float iterations

Answer 2

Running your code on my computer and timing I get:
seconds: 68.481918
result: 0.47570994
Running my code on my computer and timing I get:
seconds: 14.003861
vOne: 0.498963
vRnd: 0.499793
vMin: 0.037675
with vMin being closest to the correct answer of b being 0.01
That is almost 5x faster.
I did not tinker with each method and data structure to figure out why and what worked, I just used many decades of experience to guide me. Clearly not storing the intermediate values but just the results is a big improvement. Specifically coinTest just returns the number of heads which is an int and not a list of the results. Also instead of getting a random number for each coin flip but getting a random number for each coin and then using each part of that random number as a coin flip is advantageous. That saves number of flips - 1 calls to a function. Also I avoided using float values until the very end; I don't consider that saving time on the CPU, but it did simplify the thought process of thinking only in int which allowed me to concentrate on other efficiencies. I know that may sound weird but the less I have to think about the better the answers I get. I also only ran coinTest when it was necessary, e.g. only the first coin, only the random coin, and looked for all tails as an exit condition.
namespace Workspace
module main =
[<EntryPoint>]
let main argv =
let rnd = System.Random()
let randomPick (limit : int) : int = rnd.Next(limit) // [0 .. limit) it's a Python habit
let numberOfCoins = 1000
let numberOfFlips = 10
let numberOfExperiements = 100000
let coinTest (numberOfFlips : int) : int =
let rec countHeads (flips : int) bitIndex (headCount : int) : int =
if bitIndex < 0 then headCount
else countHeads (flips >>> 1) (bitIndex-1) (headCount + (flips &&& 0x01))
countHeads (randomPick ((pown 2 numberOfFlips) - 1)) numberOfFlips 0
let runExperiement (numberOfCoins : int) (numberOfFlips : int) : (int * int * int) =
let (randomCoin : int) = randomPick numberOfCoins
let rec testCoin coinIndex (cFirst, cRnd, cMin, cFirstDone, cRanDone, cMinDone) : (int * int * int) =
if (coinIndex < numberOfCoins) then
if (not cFirstDone || not cRanDone || not cMinDone) then
if (cFirstDone && cMinDone && (coinIndex <> randomCoin)) then
testCoin (coinIndex+1) (cFirst, cRnd, cMin, cFirstDone, cRanDone, cMinDone)
else
let headsTotal = coinTest numberOfFlips
let (cFirst, cRnd, cMin, cFirstDone, cRanDone, cMinDone) =
let cFirst = if coinIndex = 0 then headsTotal else cFirst
let cRnd = if coinIndex = randomCoin then headsTotal else cRnd
let cMin = if headsTotal < cMin then headsTotal else cMin
let cRanDone = if (coinIndex >= randomCoin) then true else cRanDone
let cMinDone = if (headsTotal = 0) then true else cMinDone
(cFirst, cRnd, cMin, true, cRanDone, cMinDone)
testCoin (coinIndex+1) (cFirst, cRnd, cMin, cFirstDone, cRanDone, cMinDone)
else
(cFirst, cRnd, cMin)
else
(cFirst, cRnd, cMin)
testCoin 0 (-1,-1,10, false, false, false)
let runExperiements (numberOfExperiements : int) (numberOfCoins : int) ( numberOfFlips : int) =
let rec accumateExperiements index aOne aRnd aMin : (int * int * int) =
let (cOne,cRnd,cMin) = runExperiement numberOfCoins numberOfFlips
if index > numberOfExperiements then (aOne, aRnd, aMin)
else accumateExperiements (index + 1) (aOne + cOne) (aRnd + cRnd) (aMin + cMin)
let (aOne, aRnd, aMin) = accumateExperiements 0 0 0 0
let (vOne : double) = (double)(aOne) / (double)numberOfExperiements / (double)numberOfFlips
let (vRnd : double) = (double)(aRnd) / (double)numberOfExperiements / (double)numberOfFlips
let (vMin : double) = (double)(aMin) / (double)numberOfExperiements / (double)numberOfFlips
(vOne, vRnd, vMin)
let timeIt () =
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let (vOne, vRnd, vMin) = runExperiements numberOfExperiements numberOfCoins numberOfFlips
stopWatch.Stop()
printfn "seconds: %f" (stopWatch.Elapsed.TotalMilliseconds / 1000.0)
printfn "vOne: %A" vOne
printfn "vRnd: %A" vRnd
printfn "vMin: %A" vMin
timeIt ()
printf "Press any key to exit: "
System.Console.ReadKey() |> ignore
printfn ""
0 // return an integer exit code
========================================================================
This is just an intermediate answer because I inquired if the OP considered using MathNet Numerics idiomatic F# and the OP wanted to see what that looked like. After running his version and this first cut version on my machine the OP version is faster. OP: 75 secs, mine: 84 secs
namespace Workspace
open MathNet.Numerics.LinearAlgebra
module main =
[<EntryPoint>]
let main argv =
let rnd = System.Random()
let flipCoin() =
let head = rnd.NextDouble() > 0.5
if head then 1.0 else 0.0
let numberOfCoins = 1000
let numberOfFlips = 10
let numberOfExperiements = 100000
let numberOfValues = 3
let randomPick (limit : int) : int = rnd.Next(limit) // [0 .. limit) it's a Python habit
let headCount (m : Matrix<float>) (coinIndex : int) : int =
System.Convert.ToInt32((m.Row coinIndex).Sum())
let minHeads (m : Matrix<float>) (numberOfCoins : int) (numberOfFlips : int) : int =
let rec findMinHeads currentCoinIndex minHeadsCount minHeadsIndex =
match currentCoinIndex,minHeadsCount with
| -1,_ -> minHeadsCount
| _,0 -> minHeadsCount // Can't get less than zero so stop searching.
| _ ->
let currentMinHeadCount = (headCount m currentCoinIndex)
let nextIndex = currentCoinIndex - 1
if currentMinHeadCount < minHeadsCount
then findMinHeads nextIndex currentMinHeadCount currentCoinIndex
else findMinHeads nextIndex minHeadsCount minHeadsIndex
findMinHeads (numberOfCoins - 1) numberOfFlips -1
// Return the values for cOne, cRnd, and cMin as int values.
// Will do division on final sum of experiments instead of after each experiment.
let runExperiement (numberOfCoins : int) (numberOfFlips : int) : (int * int * int) =
let (flips : Matrix<float>) = DenseMatrix.init numberOfCoins numberOfFlips (fun i j -> flipCoin())
let cOne = headCount flips 0
let cRnd = headCount flips (randomPick numberOfCoins)
let cMin = minHeads flips numberOfCoins numberOfFlips
(cOne,cRnd,cMin)
let runExperiements (numberOfExperiements : int) (numberOfCoins : int) (numberOfFlips : int) : (int [] * int [] * int []) =
let (cOneArray : int[]) = Array.create numberOfExperiements 0
let (cRndArray : int[]) = Array.create numberOfExperiements 0
let (cMinArray : int[]) = Array.create numberOfExperiements 0
for i = 0 to (numberOfExperiements - 1) do
let (cOne,cRnd,cMin) = runExperiement numberOfCoins numberOfFlips
cOneArray.[i] <- cOne
cRndArray.[i] <- cRnd
cMinArray.[i] <- cMin
(cOneArray, cRndArray, cMinArray)
let (cOneArray, cRndArray, cMinArray) = runExperiements numberOfExperiements numberOfCoins numberOfFlips
let (vOne : double) = (double)(Array.sum cOneArray) / (double)numberOfExperiements / (double)numberOfFlips
let (vRnd : double) = (double)(Array.sum cRndArray) / (double)numberOfExperiements / (double)numberOfFlips
let (vMin : double) = (double)(Array.sum cMinArray) / (double)numberOfExperiements / (double)numberOfFlips
printfn "vOne: %A" vOne
printfn "vRnd: %A" vRnd
printfn "vMin: %A" vMin
Halfway through the coding I realized I could do all of the calculations using just int, it was only the last calculations that generated the percentages that needed to be a float or double and even then that is only because the list of answers is a percentage; in theory the numbers can be compared as int to get the same understanding. If I use only int then I would have to create an int Matrix type and that is more work than I want to do. When I get time I will switch the MathNet Matrix to an F# Array2D or something similar and check that. Note if you tag this with MathNet then the maintainer of MathNet might answer (Christoph Rüegg)
I made an change to this method and it is faster by 5 seconds.
// faster
let minHeads (m : Matrix<float>) (numberOfCoins : int) (numberOfFlips : int) : int =
let (mins : float[]) = m.FoldByRow((fun (x : float) y -> x + y), 0.0)
let (minHead : float) = Array.min mins
System.Convert.ToInt32(minHead)

Answer 3

I tried to find the smallest possible changes to your code to make it faster.
The biggest performance improvement I found was by changing the ObtainFrequencyOfHeads function so that it counts true values in the collection instead of creating an intermediate filtered collection and then counting that. I did this by using fold:
let ObtainFrequencyOfHeads tosses =
let heads = tosses |> List.fold (fun state t -> if t then state + 1 else state) 0
float heads / float (List.length (tosses))
Another improvement came from changing all of the lists into arrays. This was as simple as replacing every instance of List. with Array. (including the new function above).
Some might say this is less functional, because it's using a mutable collection instead of an immutable one. However, we're not mutating any arrays, just using the fact that they are cheap to create, check the length of, and look up by index. We have removed a restriction on mutation but we are still not using mutation. It is certainly idiomatic F# to use arrays for performance if required.
With both of these changes I got almost a 2x performance improvement in FSI.