Today I've found myself reading again the excellent paper Why Functional Programming Matters, where the author describes the core activity of programming in a functional fashion in terms of "glueing functions together".

It's been a while since I last played around with F#. So I decided this would be a good time to refresh some of the core concepts by translating some of the examples from his paper into F#.

Reduce

The paper starts off describing how a reduce function could be devised, extrapolating a common behavior from a certain set of functions. Let's first consider a function to sum all the items in a list:

    let add a b = a + b

    let rec sum l =
        match l with
        | [] -> 0
        | h::t -> add h (sum t)
  

Nothing too fancy going on here. Let's now consider a similar function that instead multiplies together all the items in a list:

    let mul a b = a * b

    let rec product l =
        match l with
        | [] -> 1
        | h::t -> mul h (product t)
  

If you compare the structure of the two functions sum and product you can see that the two are very similar. The are only two differences between the two:

• The value being returned when an empty list is matched (0 vs 1).
• The function being applied between the head of the list and the application of the recursive function to the remaining of the list (add vs mul)

It's easy, then, to extrapolate a more general reduce function, as follows:

    let rec reduce f a l =
        match l with
        | [] -> a
        | h::t -> f h ((reduce f a) t)
  

Let's consider all the pieces step by step:

• reduce is a (recursive) function accepting a function f, a value a and a list l.
• f is the function that we want to apply between two elements of the list (sum or mul in the two examples above)
• a is the value that we want to return when f is applied to the empty list (0 or 1 respectively), and
• l is the actual list we want to operate on.

Let's try this new function in the interactive window:

  > reduce;;
  val it : (('a -> 'b -> 'b) -> 'b -> 'a list -> 'b)
  > reduce add 0 [1;2;3];;
  val it : int = 6
  > reduce mul 1 [1;2;3];;
  val it : int = 6
  

As you see, the compiler infers the types involved in reduce as follows:

• ('a -> 'b -> b') is the description of f: a function that takes two arguments of type 'a and 'b and returns one item of type 'b (note that 'a and 'b may in some cases represent the same type, as with add and mul).
• 'b is a parameter of the same type as the one returned by f.
• 'a listis a list of items the same type as the first argument of f.
• 'b is finally the return type of the whole reduction process

.

There's an interesting special case: when 'b is 'a list. That is, when f has the following form: ('a -> a' list -> a' list). A function receiving an item and a list and returning another list. Can you think of any function like that? What about concatenating an item and a list?

    let cons a l = a::l
  

Let's see how the F# interactive interprets the new function we've just created and an example of usage:

    > cons;;
    val it : ('a -> 'a list -> 'a list)
    > cons 1 [2; 3];;
    val it : int list = [1; 2; 3]
    >
  

And we now consider cons as our f function, first parameter of the reduce, we can write for example:

    let append a b = reduce cons b a
    let copy l = reduce cons l []
  

where append concatenates two lists and copy simply replicates any given list:

    > append;;
    val it : ('a list -> 'a list -> 'a list)
    > append [1;2] [3;4];;
    val it : int list = [1; 2; 3; 4]
    >  copy;;
    val it : ('a list -> 'a list)
    > copy [1;2;3];;
    val it : int list = [1; 2; 3]
    >

In the following post we'll continue translating some more core functions from the "Why Functional Programming Matters" into F#. Stay tuned!

2011 brings us yet another Project Euler problem to tackle: this time is Problem 18, one of the most interesting that I've solved so far:

By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.

3
7 4
2 4 6
8 5 9 3

That is, 3 + 7 + 4 + 9 = 23.

Find the maximum total from top to bottom of the triangle below:

75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

NOTE: As there are only 16384 routes, it is possible to solve this problem by trying every route. However, Problem 67, is the same challenge with a triangle containing one-hundred rows; it cannot be solved by brute force, and requires a clever method! ;o)

Analysis

This problem is easily solved resorting to dynamic programming, which we can loosely describe as decomposing the overall problem into easier sub-problems and combining their solutions to find the final answer.

In our case, if we consider the number associated with each node of the triangle as a cost, the overall problem can be expressed as finding the path with maximum cost from the upper vertex to the bottom row. A generic sub-problem would be the cost to reach the bottom row from a generic node at position i,j.

Given the cost of passing through a given node and the cost of reaching the bottom row from that particular node, we can define the following truth:

or, in other words, from each node i,j the cost of reaching the bottom is equal to the cost of the node itself plus the maximum path between one of the two adjacent nodes from the row below.

Let's confirm why this is the case with the help of the following figure: consider for example the first node from the left in the fourteenth (last-but-one) row (having cost 63): from there you can move to the bottom either going to node 04 or node 62. Clearly, if we want to pick the highest cost, we need to pick 62 (and we mark this choice with a grey line). The overall cost to reach the bottom from that node is thus 63 + max (04, 62) = 125.

Let’s consider now the second node from that row (66). From there, we have to choose between node 62 and 98: the highest cost path from there is thus 66 + max(62, 98) = 164. We can continue for all the nodes in the row to find the highest cost path from each node; the solution to such sub-problems is indicated in gray close to each node.

Having solved all sub-problems for row 14, we can now consider the row immediately above. In the following figure, I have replaced row 14 with the solutions of the sub-problems that we had just solved; the row above is row 13. Please note how we don’t care about row 15 anymore: its contribution to the overall problem is already captured in each sub-problems’ solution for row 14! Hence, we proceed in a similar way to solve the sub-problems for the row 13 just as we did for row 14:

We continue to follow a similar pattern moving upwards row after row, until we reach the tip of the triangle, always considering two rows at a time.

Solution

#light

let a = Array2D.zeroCreate<int> 15 15

a.[0,0] <- 75
a.[1,0] <- 95
a.[1,1] <- 64
a.[2,0] <- 17
a.[2,1] <- 47
a.[2,2] <- 82
a.[3,0] <- 18
// other initializations omitted for clarity
// full listing available on Github
// (https://github.com/stefanoric/YAPEFSHARP)
a.[14,10] <- 38
a.[14,11] <- 53
a.[14,12] <- 60
a.[14,13] <- 04
a.[14,14] <- 23 

let costs = Array2D.zeroCreate<int> 15 15

// costs for bottom row is the same as bottom row values
Array2D.blit a 14 0 costs 14 0 1 15 |> ignore

let max a b = if a > b then a else b

for i in 13 .. -1 .. 0 do
    for j in 0 .. i do
        costs.[i,j] <- a.[i,j] + max costs.[i+1,j] costs.[i+1, j+1]

let result () =
    costs.[0,0]

Most of the code for this solution is needed just to initialize the two dimensional array containing the triangle. For reading convenience, I have skipped most of the uninteresting rows, but you can find the complete solution on Github.

So, we have a matrix (2D array) for the cost of each nodes and another matrix for the solutions of the sub-problems associated to each node. Trivially, the costs and the solutions coincide for the bottom row (note the handy Array2D.blit function to copy a whole row from one matrix to the other).

Then, with a loop we move backward from the last-but-one row up to the tip of the triangle calculating the sub-problems solutions as explained above.

Project Euler problem 17 turned out to be quite an easy one.

If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.

If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?

NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage.

Solution

The solution this time is almost trivial:

• "Zero" is considered to have 0 length (it will be obvious later on why this is the case)
• Numbers from 1 to 19 have their own unique names (i.e. they are not composed by putting together more words)
• Numbers from 20 to 99 are combined putting together a word like "thirty" and a number from 0 to 9. If the number is zero, we don't add anything (we don't say "twenty and zero")
• Numbers from 100 to 999 are combined putting together a words like "two hundred and" plus a number from 0 to 99 composed as explained above. Exact multiples of 100 are exception in that they don't have another trailing number (again, we don't say "two hundred and zero").

#light

let thousand    = "oneThousand"
let hundred     = "hundred"
let hundred_and = "hundredAnd"

let zero_to_nine = new System.Collections.Generic.Dictionary<int, string="">()
zero_to_nine.[0] <- ""
zero_to_nine.[1] <- "one"
zero_to_nine.[2] <- "two"
zero_to_nine.[3] <- "three"
zero_to_nine.[4] <- "four"
zero_to_nine.[5] <- "five"
zero_to_nine.[6] <- "six"
zero_to_nine.[7] <- "seven"
zero_to_nine.[8] <- "eight"
zero_to_nine.[9] <- "nine"

let ten_to_nineteen =  new System.Collections.Generic.Dictionary<int, string="">()
ten_to_nineteen.[10] <- "ten"
ten_to_nineteen.[11] <- "eleven"
ten_to_nineteen.[12] <- "twelve"
ten_to_nineteen.[13] <- "thirteen"
ten_to_nineteen.[14] <- "fourteen"
ten_to_nineteen.[15] <- "fifteen"
ten_to_nineteen.[16] <- "sixteen"
ten_to_nineteen.[17] <- "seventeen"
ten_to_nineteen.[18] <- "eighteen"
ten_to_nineteen.[19] <- "nineteen"

let twenty_to_ninety = new System.Collections.Generic.Dictionary<int, string="">()
twenty_to_ninety.[20] <- "twenty"
twenty_to_ninety.[30] <- "thirty"
twenty_to_ninety.[40] <- "forty"
twenty_to_ninety.[50] <- "fifty"
twenty_to_ninety.[60] <- "sixty"
twenty_to_ninety.[70] <- "seventy"
twenty_to_ninety.[80] <- "eighty"
twenty_to_ninety.[90] <- "ninety"

let len s = String.length s

let calculate_letters_under_one_hundred n =
    match n with
        | x when x < 10 -> len zero_to_nine.[x]
        | x when x < 20 -> len ten_to_nineteen.[x]
        | x when x < 100 -> len twenty_to_ninety.[((x / 10) * 10)] + len zero_to_nine.[(x % 10)]
        | _ -> failwith "Number is too big!"

let calculate_letters n =
    match n with
        | x when x < 100 -> calculate_letters_under_one_hundred x
        | x when ((x < 1000) && (x % 100 = 0)) -> len zero_to_nine.[(x / 100)] + len hundred
        | x when x < 1000 -> len zero_to_nine.[(x / 100)] + len hundred_and +  calculate_letters_under_one_hundred (x % 100)
        | 1000 -> len thousand
        | _ -> failwith "Numer is too big!"

let all_letters_up_to n =
    List.sumBy (fun i -> calculate_letters i) [1..n]

It’s time for another Project Euler exercise. This time around it’s problem 16:

2¹⁵ = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.

What is the sum of the digits of the number 2¹⁰⁰⁰?

Analysis

I have tried to found an elegant way to solve this problem at a mathematical level, but I couldn't gain any insight relating powers of 2 to their representation in base 10 (I'd love to know if such a thing exists). Therefore I resorted to solve this problem with brute force.

Luckily F# (and now all other .NET 4.0 cousin languages) sports the BigInteger numeric type which helps tackling such huge numbers.

There are basically two approaches to solve this problem:

• Transform the result of exponentiation into a string and iterate through the string adding up all the individual digits, or
• Do without strings, and decompose the big number into the individual digits on my own.

I have decided to take the second route because it seemed like a more interesting exercise (the first approach could probably lead to a one-liner). ^[1].

Let’s consider a generic number n and consider how we can describe it as a sum of powers of 10:

For example

and k = 2, d₀ = 3, d₁ = 2, and d₂ = 4

So, given a generic number n, we need to find the highest power of ten ( k ) such that

(logarithms will help us there). After k is found, we can start diving n by 10^k to find d_k and use the reminder of the division to calculate d_k-1 and so forth until we reach d₀.

Solution

#light

open System
open System.Numerics

let rec decompose_rec n power_of_ten accu =
    match power_of_ten with
        | i when i = 1I -> accu @ [n]
        |_ ->
            let d = n / power_of_ten
            let digits = accu @ [d]
            decompose_rec (n - (d * power_of_ten)) (power_of_ten / 10I) digits

let decompose n =
    let power = floor (log10 (float n))
    let initial_power_of_ten = BigInteger.Pow(10I, int32 power)
    decompose_rec n initial_power_of_ten []

let sum_digits n =
    decompose n |> List.sum

1. ^[1] A recruiter for a very big company once asked me something very similar during an interview as a coding exercise ↩

With Project Euler Problem 15 we approach the fascinating world of graphs (but, as we shall see, only in a very tangential fashion):

Starting in the top left corner of a 2×2 grid, there are 6 routes (without backtracking) to the bottom right corner.

How many routes are there through a 20×20 grid?

Analysis

With pen and paper the fact that a 2×2 grid has 6 possible routes can be easily confirmed. However, as soon as the grid size grows, it's simply not practical to start drawing all the possible ways to reach the lowest right corner from the top left one.

In order to find a general solution, it helps trying a dynamic programming approach: we first try to solve a smaller problem and then combine the solutions of more sub-problems to find the overall answer.

The smallest problem that we can consider is the number of possible routes in a 1×1 grid. What could be simpler? Considering all the three possible starting corners of such a grid we can see that:

• From both the bottom-left and the top-right corner there's only one possible route to the destination.
• From the top-left corner there are trivially two possible routes.

In the picture below, I have marked for each corners the number of possible routes to the destination for the 1×1 grid:

We can now consider the bigger 2×2 grid enclosing the smaller 1×1 grid representing the sub-problem we solved earlier:

• Both points on the outer sides of the grid have only one possible route to the destination. In fact, from there you can only proceed along the edge. So, we mark both of these points with 1.
• Let’s now consider the point immediately above the bottom left one on the grid: from this point we can either move down (to the point that we just marked with a “1”) or right to the point of the 1×1 grid that we had marked with a “2” previously. Hence, from this point we have 1 possible route if we decide to go down or 2 possible routes if we decide to go right: that makes 3 possible routes that can lead from this point to the destination.

We can generalize and deduce that for each point in the grid, the number of possible routes to the destination is equal to the sum of the routes available from the point immediately down and the point immediately right (points on the outer edge having only 1 possible route). This is the key to solve this problem for any kind of grid.

So, we have informally demonstrated the result for the 2×2 grid:

And similarly we can resolve the problem for a 3×3 grid:

Now, if you look closely at the patterns of the possible routes for each point in the grid, you may recognize what in Italy we call Il triangolo di Tartaglia (Tartaglia’s Triangle), which everywhere else in the world is most probably known as Pascal's Triangle:

(note that the triangle obviously continues ad infinitum).

The solution for a square grid of any size lies in the vertical diagonal (if you excuse the quasi-oxymoron), that is 1, 2, 6, 20, etc…. If we start counting rows from the top, first row being row 0, second row being row 1 and so on, and columns from the left also starting from 0, we can see that for a square grid of size n, the number of routes is given by the item in the n column within the 2*n row.

Now, it would be trivial, if somehow boring, to solve the problem for a 20×20 grid using a spreadsheet. All you have to do is to create the 20 x 2 = 40 rows of the Pascal triangle (with some copy and paste of the right formula for each cell), and pick the 20^th element from that road.

However, you don't actually have to create the whole triangle: the values of each row can be calculated using they binomial expansion: for a given row r, the value at column c is given by the following formula:

Perhaps more interestingly, you can calculate the same value without resorting to the factorial by using the following recursive formula (where r' is the row number +1 and  c is the column index):

Solution

So, after all this analysis, the solution comes up to be quite simple and maybe not that interesting per se. The recursive formula to calculate the values from the triangle's rows fits naturally the F# pattern matching:

#light

let rec pascal_item row_plus_one column =
    match column with
    | 0L -> 1L
    | _-> (row_plus_one-column) * (pascal_item row_plus_one (column-1L)) / column

let number_of_routes grid_size =
    pascal_item (int64(2*grid_size + 1)) (int64 grid_size)

Project Euler Problem 14 introduces the fascinating Collatz Conjecture:

Take any natural number n. If n is even, divide it by 2 to get n / 2, if n is odd multiply it by 3 and add 1 to obtain 3n + 1. Repeat the process indefinitely. The conjecture is that no matter what number you start with, you will always eventually reach 1.

The Euler problem to be resolved is phrased as follows:

The following iterative sequence is defined for the set of positive integers:

n –> n/2 (n is even)
n –> 3n + 1 (n is odd)

Using the rule above and starting with 13, we generate the following sequence:

13 –> 40 –> 20 –> 10 –> 5 –> 16 –> 8 –>  4 –> 2 –>  1

It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.

Which starting number, under one million, produces the longest chain?

As with many other Project Euler problems, we are requested to generate a sequence (in this case a sequence of “Collatz sequences”) and to single out one item matching a certain criteria. In this particular case, we need to create Collatz sequences for all numbers under 1 million and find out the longest one.

Solution

The basic algorithm has the following shape:

let is_odd x =
    x % 2L = 1L

let rec naive_sequence n (partial:int64 list) =
    match n with
        | 1L -> partial @ [1L]
        | x when is_odd x -> naive_sequence ((3L*x) + 1L) (partial @ [n])
        |_ -> naive_sequence (n/2L) (partial @ [n])

Using this recursive function, we could easily generate Collatz sequences for arbitrarily large numbers. But the performance would soon degrade when we start building sequence for numbers bigger than about 10 thousands.

In the process of generating all the sequences from 1 to 1 million, however, it’s easy to see that for each sequence that we build, there are a lot of subsequences that are identical, which are being calculated over and over.

Consider for example the two sequences having 5 and 24 as starting numbers respectively:

5 –> 16 –> 8 –> 4 –> 2 –> 1

24 –> 12 –> 6 –> 3 –> 10 –> 5 –> 16 –> 8 –> 4 –> 2 –> 1

As you can see, after a few iterations the sequence starting from 24 converges to the sequence starting at 5, which we have already calculated! (see this image from Wikipedia for a pictorial representation of this behavior)

As you would have guessed by now, the key to solve this problem is precisely caching the subsequences that are being calculated, so that the partial results can be reused for subsequent iterations.

So, with these considerations in mind, we can have a look at the final solution:

#light

open System.Collections.Generic

let is_odd x =
    x % 2L = 1L

let rec collatz_sequence n (partial:int64 list) (cache: IDictionary<int64, int64 list>) =
    if cache.ContainsKey(n) then
        let result = partial @ cache.[n]
        let sequence_starter = List.head result
        if not(cache.ContainsKey(sequence_starter)) then
            cache.Add(sequence_starter, result) |> ignore
        result
    else
        match n with
        | 1L ->
            let result = partial @ [1L]
            let sequence_starter = List.head result
            cache.Add(sequence_starter, result) |> ignore
            result
        | n when is_odd n -> collatz_sequence ((3L*n) + 1L) (partial @ [n]) cache
        | _ -> collatz_sequence (n/2L) (partial @ [n]) cache

let sequence_cache = new Dictionary<int64, int64 list>()

let calculate_sequence n =
    collatz_sequence n [] sequence_cache

let max_sequence_lengths (max:int64) =
    let all_sequences = [for i in 1L..max -> calculate_sequence i]
    let lengths = List.map List.length all_sequences
    let max = List.max lengths
    let max_index = List.findIndex (fun (x:int64 list) -> x.Length = max) all_sequences
    max_index + 1L

As you can see, the basic pattern of the algorithm is still the same. However, we have added a cache to store partial results which dramatically improve the performances (this version resolve the problem on my laptop in about 7 seconds).

The last function max_sequence_lengths is the main loop generating all the sequences, calculating the lengths and picking the sequence with the highest length.

Caching partial results is a common theme in functional programming, and is called memoization. The example provided above is not one of the cleanest examples of memoization. It turns out that combining memoization and tail recursion is a tricky problem.

Now that with F# (and .NET 4.0 in general) we have support for big integers through the BigInteger type, Project Euler problem 13 has become a trivial one:

Work out the first ten digits of the sum of the following one-hundred 50-digit numbers.

37107287533902102798797998220837590246510135740250
46376937677490009712648124896970078050417018260538
74324986199524741059474233309513058123726617309629
…
53503534226472524250874054075591789781264330331690

Solution (note that I have removed most of the input numbers to improve readability):

#light

open System.Linq
open System.Numerics

let numbers =
  [|37107287533902102798797998220837590246510135740250I;
    46376937677490009712648124896970078050417018260538I;
    74324986199524741059474233309513058123726617309629I;
    ...
    53503534226472524250874054075591789781264330331690I|]

let solve_problem_13 () =
    numbers
        .Aggregate(0I, fun (x:BigInteger) (y:BigInteger) -> x + y)
            .ToString().Substring(0, 10)

Using Linq, it's easy to compute the solution with a simple aggregation. Note that I couldn't use the Sum function directly because it does not have an overload for BigInteger type.

Without support for such big numbers, one could have reasoned that, in order to calculate the first 10 digits of the result, only the first 11 digits of each number are relevant. With this intuition, the problem would have been tractable using simple longs.

Parallel version

Problem 13 is a classical problem that can be resolved using parallel aggregation: it can be decomposed into many independent sub-tasks (each calculating the sum of 10 numbers, as an example) and the final result can be obtained aggregating the results from each of them.

With Linq AsParallel, scaling this problem on multiple cores is trivial:

let solve_problem_13 () =
    numbers
        .AsParallel() // MAKE IT PARALLEL!
            .Aggregate(0I, fun (x:BigInteger) (y:BigInteger) -> x + y)
                .ToString().Substring(0, 10)

Of course, with such a trivial problem, you should not expect big performance improvements with a parallel version (indeed, the overhead of splitting the work into different threads might usually lengthen the time it takes to get to the result).

See all Project Euler problems solutions.

After a brief digression with an RPN Calculator, here we are again with a new Project Euler problem:

The sequence of triangle numbers is generated by adding the natural numbers.

So the 7^(th) triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

The first ten terms would be:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, …

Let us list the factors of the first seven triangle numbers:

1: 1
3: 1,3
6: 1,2,3,6
10: 1,2,5,10
15: 1,3,5,15
21: 1,3,7,21
28: 1,2,4,7,14,28

We can see that 28 is the first triangle number to have over five divisors.

What is the value of the first triangle number to have over five hundred divisors?

Again, this problem is relatively simple to solve and it's about finding an algorithm with decent performances.

The naive (slow) solution

#light

let triangles =
    Seq.unfold (fun (acc, state) -> Some (acc, (state + acc, state + 1))) (0, 1)
    |> Seq.skip 1 // skip the initial 0

let divides y x =
    x % y = 0

let rec all_factors_slow_rec n i acc =
    match i with
        | 1 -> 1::acc
        | x when divides x n -> all_factors_slow_rec n (x-1) (x::acc)
        | _ -> all_factors_slow_rec n (i-1) acc

let all_factors_slow n =
    all_factors_slow_rec n n []

let find_index m =
    triangles
    |> Seq.map all_factors_slow
    |> Seq.tryFindIndex (fun x -> List.length x >= m)

let resolve_problem_12 =
    let i = find_index 500
    match i with
        | None -> failwith "Cannot resolve problem"
        | Some(i) ->
            let list = triangles |> Seq.take (i+1) |> List.ofSeq
            list.[i]

• Considering that triangle numbers are a mathematical sequence defined as follows:
  where , then we easily define an F# sequence that yields triangle numbers using Seq.unfold.
• We then define a function all_factors_slow_rec to calculate all factors (not just primes) of a given number. The slow solution presented in the first listing starts from a number n and then by brute force tries all the numbers down to 1 as a candidate factor.
• Once we have these two pieces together, it's just a matter of enumerating all possible triangle numbers, finding for each their factors (using Seq.map) and finally determining the first triangle number having at least 500 factors (using Seq.tryFindIndex). If is the index of such a number, we then go back to the original sequence of triangles to extract the element.

An improved version

#light

let divides y x =
    x % y = 0

let triangles =
    Seq.unfold (fun (acc, state) -> Some (acc, (state + acc, state + 1))) (0, 1)
    |> Seq.skip 1 // skip the initial 0

let rec all_factors_quick_rec n i factors =
    if divides i n then
        let y = n / i
        if (i < y) then
            all_factors_quick_rec n (i + 1) (i::y::factors)
        elif (i = y) then
            // we have reached the square root value
            i::factors
        else
            factors
    elif i > int (sqrt (float n)) then
        // we are beyond the square root value
        factors
    else
        // try with the next number
        all_factors_quick_rec n (i + 1) factors

let all_factors_quick n =
    all_factors_quick_rec n 1 []

let find_index m =
    triangles
    |> Seq.map all_factors_quick
    |> Seq.tryFindIndex (fun x -> List.length x >= m)

let resolve_problem_12 =
    let i = find_index 500
        match i with
        | None -> failwith "Cannot resolve problem"
        | Some(i) ->
            let list = triangles |> Seq.take (i+1) |> List.ofSeq
            list.[i]

The bottleneck of the previous solution is the naive approach to find all the factors of a number. On my machines this solution takes several minutes.

Better performances can be obtained observing that in order to determine all the factors of a number we don't have try all smaller numbers. As a matter of fact, the following is true (considering n the number to be factorized):

• if , obviously both x and y are factors, so I don't have to probe y anymore
• If I start probing from 2 going up, I can stop probing when I have reached . In fact, any number bigger than must have been already found probing a smaller number.

Suppose for example that we have to factor the number 36 (one of the triangle numbers):

• 1 is always a factor -> factors = {1, 36}
• 2 * 18 = 36 -> factors = {1, 36, 2, 18}
• 3 * 12 = 36 -> factors = {1, 36, 2, 18, 3, 12 }
• 4 * 9 = 36 -> factors = {1, 36, 2, 18, 3, 12, 4, 9}
• 5 does not divide -> factors = {1, 36, 2, 18, 3, 12, 4, 9}
• 6 * 6 = 36 -> factors = {1, 36, 2, 18, 3, 12, 4, 9, 6}

We can stop here because if 7 divided 36 evenly, we would have already found a number x < 6 such that 7 * x = 36.

The improved version runs on my machine in less than 1 second.

See all Project Euler problems solutions.

While continuing my journey in F#, after playing with Project Eulero problems for a few weeks, I have come across another excellent  excercise site which goes under the name of Programming Praxis.

The first exercise requires to implement a simple calculator using Reverse Polish Notation (RPN).

Here follows a simple solution to the problem. Operands are pushed onto the stack until an operator is found: at that point the last two operands are popped from the stack, the operator is applied to them and the result is pushed back on the stack.

#light

let is_operator c =
    match c with
        | "+" | "-" | "*" | "/"  -> true
        | _ -> false

let calculate left operator right =
    match operator with
        | "+" -> left + right
        | "-" -> left - right
        | "*" -> left * right
        | "/" -> left / right
        | _ -> failwith "Unknown operator"

let proc (item:string) (stack:System.Collections.Generic.Stack<double>) =
    if is_operator item then
        let r = stack.Pop()
        let l = stack.Pop()
        let result = calculate l item r
        stack.Push result
    else
        stack.Push(System.Convert.ToDouble(item))

let evaluate (expression:string) =
    let stack = new System.Collections.Generic.Stack<double>()
    let items = expression.Split([|' ' |])
    Array.iter (fun i -> proc i stack) items
    stack.Pop()

• We first define a simple function to check whether a given string is to be interpreted as an arithmetic operand. As you can see, we only support basic operators, nothing too fancy.
• We then define a function which takes a double, a string (representing an operator) and another double, and returns the result of applying the given operator to the two numbers.
• The proc function takes a string, which represent either an operand or an operator, and a stack of operands.
  If the item contained in the string is an operator, two operands are popped from the stack: the first pop is for the right side operand and the second pop is for the left operand; hence, the operator is applied to the two operands and the result is pushed back onto the stack.
  Otherwise, if it's an operand, it's first converted from the string format and pushed onto the stack.
• Finally, the entrance point to the program is defined with the evaluate function, which
  • accepts a string containing the overall expression (such as "1 2 + 4 / 5 * 6 -")
  • splits the string into an array of token strings
  • feed each token into the proc function
  • finally pops the stack with the last operand to yield the result of the operation.

Project Euler Problem 11 is an interesting one; when addressed with a functional approach it lends itself to be solved using function composition. Let's have a look at the question and then a possible solution:

In the 20×20 grid below, four numbers along a diagonal line have been marked in red. 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 The product of these numbers is 26 × 63 × 78 × 14 = 1788696. What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20×20 grid?

#light

let numbers =
    array2D [|
      [|08;02;22;97;38;15;00;40;00;75;04;05;07;78;52;12;50;77;91;08|];
      [|49;49;99;40;17;81;18;57;60;87;17;40;98;43;69;48;04;56;62;00|];
      [|81;49;31;73;55;79;14;29;93;71;40;67;53;88;30;03;49;13;36;65|];
      [|52;70;95;23;04;60;11;42;69;24;68;56;01;32;56;71;37;02;36;91|];
      [|22;31;16;71;51;67;63;89;41;92;36;54;22;40;40;28;66;33;13;80|];
      [|24;47;32;60;99;03;45;02;44;75;33;53;78;36;84;20;35;17;12;50|];
      [|32;98;81;28;64;23;67;10;26;38;40;67;59;54;70;66;18;38;64;70|];
      [|67;26;20;68;02;62;12;20;95;63;94;39;63;08;40;91;66;49;94;21|];
      [|24;55;58;05;66;73;99;26;97;17;78;78;96;83;14;88;34;89;63;72|];
      [|21;36;23;09;75;00;76;44;20;45;35;14;00;61;33;97;34;31;33;95|];
      [|78;17;53;28;22;75;31;67;15;94;03;80;04;62;16;14;09;53;56;92|];
      [|16;39;05;42;96;35;31;47;55;58;88;24;00;17;54;24;36;29;85;57|];
      [|86;56;00;48;35;71;89;07;05;44;44;37;44;60;21;58;51;54;17;58|];
      [|19;80;81;68;05;94;47;69;28;73;92;13;86;52;17;77;04;89;55;40|];
      [|04;52;08;83;97;35;99;16;07;97;57;32;16;26;26;79;33;27;98;66|];
      [|88;36;68;87;57;62;20;72;03;46;33;67;46;55;12;32;63;93;53;69|];
      [|04;42;16;73;38;25;39;11;24;94;72;18;08;46;29;32;40;62;76;36|];
      [|20;69;36;41;72;30;23;88;34;62;99;69;82;67;59;85;74;04;36;16|];
      [|20;73;35;29;78;31;90;01;74;31;49;71;48;86;81;16;23;57;05;54|];
      [|01;70;54;71;83;51;54;69;16;92;33;48;61;43;52;01;89;19;67;48|];
      |]

let dimensions = (Array2D.length1 numbers, Array2D.length2 numbers)

let horizontal_traverser (i, j) (iMax, jMax) f_4 =
    if (i > iMax) || (j + 4> jMax) then 0
    else f_4 numbers.[i,j]  numbers.[i, j+1] numbers.[i,j+2] numbers.[i,j+3]

let vertical_traverser (i,j) (iMax, jMax) f_4 =
    if (i + 4 > iMax) || (j > jMax) then 0
    else f_4 numbers.[i,j] numbers.[i+1, j] numbers.[i+2, j] numbers.[i+3,j]

let diagonal_traverser_left_right (i, j) (iMax, jMax) f_4 =
    if (i + 4 > iMax) || (j + 4 > jMax) then 0
    else f_4 numbers.[i,j] numbers.[i+1, j+1] numbers.[i+2, j+2] numbers.[i+3,j+3]

let diagonal_traverser_right_left (i, j) (iMax, jMax) f_4 =
    if (i - 3 < 0) || (j + 4 > jMax) then 0
    else f_4 numbers.[i,j] numbers.[i-1, j+1] numbers.[i-2, j+2] numbers.[i-3,j+3]

let max_in_direction traverser f_4 =
    seq { for i in 0..fst dimensions - 1 do
              for j in 0..snd dimensions - 1 do
                  yield traverser (i,j) dimensions f_4 }
    |> Seq.max

let maximum f_4 =
    [| max_in_direction horizontal_traverser f_4;
       max_in_direction vertical_traverser f_4;
       max_in_direction diagonal_traverser_left_right f_4;
       max_in_direction diagonal_traverser_right_left f_4 |]
    |> Array.max

let problem_11 () =
    maximum (fun a b c d -> a * b * c * d)

• We first declare a two-dimensions array containing the 20×20 numbers that we need to explore. To do this we use F# Array2D Module. The same module is used also to compute a tuple containing the size of the two dimension arrays, which we'll use later on.
• We then proceed to define four traverser functions, one for each of these directions: horizontal, vertical, diagonal top-left to bottom-right and diagonal bottom-left to top-right. Each traverser takes as input a given item of the array and applies the supplied 4-parameters function to the starting item plus the next 3 items in a direction. Note how at this point we are not talking about a specific operation (product or sum) yet and we are concentrating on 4 items of the array at a time.
• Next we define the max_in_direction function that takes a traverser and a 4-parameters function and finds the maximum value in that particular direction (whatever it might be applying the given function).
• We are getting closer to the solution by defining the maximum one-dimension array, where each item is the maximum value in each of the four directions and then taking the highest one.
• We finally solve the problem by invoking the maximum function passing to it the product of four items as a lambda.

Note how easy it is to change the particular function that we use to aggregate the 4 items: suppose for example that we are interested in the 4 items giving the maximum sum, we could simply invoke:

maximum (fun a b c d -> a + b + c + d)

See all Project Euler problems solutions.