Project Euler in F#: Problem 108

According to the referrer logs people are stumbling across this blog, looking for the solution to problem 110. That seems like a good indication that 110 is an interesting problem; the folks at project Euler suggest doing 108 first, so I’ll give that a shot.

In the following equation xy, and n are positive integers.

$\frac{1}{x} + \frac{1}{y} = \frac{1}{n}$

What is the least value of n for which the number of distinct solutions exceeds one-thousand?

It’s easier to think of this as looking for solutions of $y = n + \frac{n^2}{x-n}$, i.e., as looking for the number of factors of $n^2$. The only catch is we need to divide by two, since $n \leq y \leq 2n$

module Problem108 =
let factors n =
let rec loop n m ms =
if n % m = 0L then
loop (n/m) m (m::ms)
elif n > m then
loop n (m+1L) ms
else
ms
loop n 2L []

let numFactors n = factors n |> Seq.countBy(fun x->x) |> Seq.map (fun (a,b) -> b+1) |> Seq.reduce(*)
let numSolutionsTimesTwo n = numFactors (n*n)

let ans = (Seq.initInfinite (fun n -> n + 2) |> Seq.map int64 |> Seq.map numSolutionsTimesTwo |> Seq.takeWhile ((>) 2000) |> Seq.length) + 2


That works, but it takes about two seconds to run. There’s no way that’s going to work for problem 110, where the bound is four million. I wonder if taking the inverse approach of starting with sets of factors (instead of starting with numbers and generating all their factors) might work.

Unfortunately, Dustin stopped his project Euler series at problem 10, so I can’t check out his blog to see how I could code this up more elegantly, but after googling around for a bit I found a solution which puts mine to shame. His (or her) solution runs an order of magnitude faster, despite using a language that’s an order of magnitude slower. I want to do 110 right now, but I’ll have to go back and see how keyzero‘s solution works after that.