theburningmonk.com

Prob­lem

Let p(n) rep­re­sent the num­ber of dif­fer­ent ways in which n coins can be sep­a­rated into piles. For exam­ple, five coins can sep­a­rated into piles in exactly seven dif­fer­ent ways, so p(5)=7.

OOOOO

OOOO   O

OOO   OO

OOO   O   O

OO   OO   O

OO   O   O   O

O   O   O   O   O

Find the least value of n for which p(n) is divis­i­ble by one million.

Solu­tion

// the pentagonal numbers sequence, i.e. 1, 2, 5, 7, 12, 15, 22, ...
let pentagonalNumbers =
    Seq.unfold (fun state -> Some(state, state+1)) 1
    |> Seq.collect (fun n -> [n; -1*n])
   |> Seq.map (fun n -> int(0.5 * double(n) * double(3 * n - 1)))

// the coefficients sequence, i.e. +, +, -, -, +, +, -, -, ...
let pCoefficients =
    Seq.unfold (fun state -> Some(state, -1*state)) 1 |> Seq.collect (fun n -> [n; n])

// cache results to improve performance
let mutable cache = Array.init 100000 (fun n -> if n = 0 then 1I else 0I)

// define the function p using the pentagonal numbers
let rec p k =
    if cache.[k] <> 0I then cache.[k]
    else
        let pSeq =
            pentagonalNumbers
            |> Seq.map (fun n -> k - n)
            |> Seq.takeWhile (fun n -> n >= 0)
            |> Seq.map p
        let pk =
            pCoefficients
            |> Seq.zip pSeq
            |> Seq.sumBy (fun (pk, coe) -> pk * bigint(coe))
        cache.[k] <- pk
        pk

let answer =
    Seq.unfold (fun state -> Some(state, state+1)) 1
    |> Seq.filter (fun k -> (p k) % 1000000I = 0I)
    |> Seq.head

Well, this one took some thought and some time to come up with a solu­tion which runs under a minute! A brute force approach sim­ply wouldn’t have worked here as p(k) becomes very large very quickly (p(200) = 3972999029388…). Thank­fully, as the wiki page on par­ti­tion points out, you can build a recur­rence for the func­tion p such that:

p(k) = p(k — 1) + p(k — 2) - p(k — 5) - p(k — 7) + p(k — 12) + p(k — 15) - p(k — 22) — …

using pen­tag­o­nal num­bers in the form of

for n run­ning over pos­i­tive and neg­a­tive inte­gers (n = 1, –1, 2, –2, 3, –3, …), gen­er­at­ing the sequence 1, 2, 5, 7, 12, 15, 22, … The signs in the sum­ma­tion con­tinue to alternate +, +, –, –, +, +, …

Using dynamic pro­gram­ming tech­nique, I’m caching the value of p(k) as they’re gen­er­ated and in doing so, enabled this solu­tion to run in under 30 seconds.

Prob­lem

It is pos­si­ble to write ten as the sum of primes in exactly five dif­fer­ent ways:

7 + 3

5 + 5

5 + 3 + 2

3 + 3 + 2 + 2

2 + 2 + 2 + 2 + 2

What is the first value which can be writ­ten as the sum of primes in over five thou­sand dif­fer­ent ways?

Solu­tion

// generate all prime numbers under <= this max
let max = 1000
let mutable primeNumbers = [2]

// only check the prime numbers which are <= the square root of the number n
let hasDivisor n =
    primeNumbers
    |> Seq.takeWhile (fun n' -> n' <= int(sqrt(double(n))))
    |> Seq.exists (fun n' -> n % n' = 0)

// only check odd numbers <= max
let potentialPrimes = Seq.unfold (fun n -> if n > max then None else Some(n, n+2)) 3

// populate the prime numbers list
for n in potentialPrimes do if not(hasDivisor n) then primeNumbers <- primeNumbers @ [n]
let isPrime n = if n = 1 then false else not(hasDivisor(n))

// implement the coin change algorithm
let rec count n m (coins:int list) =
    if n = 0 then 1
    else if n < 0 then 0
    else if (m <= 0 && n >= 1) then 0
    else (count n (m-1) coins) + (count (n-coins.[m-1]) m coins)

let answer =
    let tuple =
        Seq.unfold (fun state -> Some(state, state+1)) 10
        |> Seq.map (fun n -> (n, primeNumbers |> Seq.filter (fun n' -> n' < n) |> Seq.cache))
        |> Seq.filter (fun (n, l) -> count n (Seq.length l) (Seq.toList l) > 5000)
        |> Seq.head

    fst tuple

Yet another twist to prob­lem 31 and prob­lem 76, this time the coin change algo­rithm will be sup­plied with only prime num­bers less than n.

Prob­lem

It is pos­si­ble to write five as a sum in exactly six dif­fer­ent ways:

4 + 1

3 + 2

3 + 1 + 1

2 + 2 + 1

2 + 1 + 1 + 1

1 + 1 + 1 + 1 + 1

How many dif­fer­ent ways can one hun­dred be writ­ten as a sum of at least two pos­i­tive integers?

Solu­tion

// implement the coin change algorithm
let rec count n m (coins:int list) =
    if n = 0 then 1
    else if n < 0 then 0
    else if (m <= 0 && n >= 1) then 0
    else (count n (m-1) coins) + (count (n-coins.[m-1]) m coins)

let answer = count 100 99 [1..99]

This is basi­cally prob­lem 31 with a twist, using the same coin change algo­rithm but sub­sti­tute the set coins with the num­bers less than 100 and you’ll have your solution!

Prob­lem

The 5-digit num­ber, 16807=7⁵, is also a fifth power. Sim­i­larly, the 9-digit num­ber, 134217728=8⁹, is a ninth power.

How many n-digit pos­i­tive inte­gers exist which are also an nth power?

Solu­tion

let naturalNumbers = Seq.unfold (fun state -> Some(state, state+1)) 1

// define function to find the number of n digit numbers which are also nth power
let f n =
    naturalNumbers
    |> Seq.map (fun n' -> pown (bigint(n')) n)
    |> Seq.skipWhile (fun n' -> n'.ToString().Length < n)
    |> Seq.takeWhile (fun n' -> n'.ToString().Length = n)
    |> Seq.length

let answer =
    naturalNumbers
    |> Seq.map f
    |> Seq.takeWhile (fun l -> l > 0)
    |> Seq.sum

Prob­lem

The cube, 41063625 (345³), can be per­muted to pro­duce two other cubes: 56623104 (384³) and 66430125 (405³). In fact, 41063625 is the small­est cube which has exactly three per­mu­ta­tions of its dig­its which are also cube.

Find the small­est cube for which exactly five per­mu­ta­tions of its dig­its are cube.

Solu­tion

open System

let cubeRoot (n:int64) = Math.Pow(double(n), 1.0/3.0)

// define function to investigate the numbers of d digits which are cubes
let f d =
    // find the min & max number whose cube is d digits long
    let min, max = int64(cubeRoot (pown 10L d)), int64(cubeRoot (pown 10L (d+1)))

    // and look for groups of 5 numbers which are cubes and permutations of one another
    [min..max]
    |> List.map (fun n -> pown n 3)
    |> Seq.groupBy (fun n -> n.ToString().ToCharArray() |> Array.sort)
    |> Seq.filter (fun (k, l) -> l |> Seq.length = 5)

let answer =
    // go through the numbers of a given number of digits and find the first set of groups
    // of 5 numbers which are cubes and permutations of one another
    let groups =
        Seq.unfold (fun state -> Some(state, state+1)) 7
        |> Seq.map f
        |> Seq.filter (fun l -> Seq.length l > 0)
        |> Seq.head

    // find the smallest elements in the groups
    groups |> Seq.map (fun (k, l) -> l |> Seq.min) |> Seq.min