Problem 42: How many triangle words does the list of common English words contain?

This problem is designed to make use of several tools.

let problem42a =
    let triangle n = let n' = n |> float in (0.5)*(n')*(n'+1.) |> int
    let tseq = Seq.initInfinite (fun i -> triangle (i+1)) |> Seq.cache
    
    let wordValue (s:string) = s |> Seq.sumBy (fun c -> (c |> int)-64)
    
    let text = System.IO.File.ReadAllText("words.txt")
    let words = text.Split([|',';'"'|], System.StringSplitOptions.RemoveEmptyEntries) |> Seq.readonly
    
    let isTriangleWord w =
        let wv = wordValue w
        tseq
        |> Seq.takeWhile (fun t -> t <= wv)
        |> Seq.exists ((=) wv)
        
    words
    |> Seq.filter isTriangleWord
    |> Seq.length

Problem 41: What is the largest n-digit pandigital prime that exists?

My first approach was to try and find the first odd number descending from 987654321 which was both prime and pandigital, but despite attempts at performance tweaks this would never finish executing.

let problem41a = 
    let isPandigital n =
        let dlist = n |> digits |> List.ofSeq
        (List.sort dlist) = [1..List.length dlist]
        
    let rec loop n =
        if isPrime n && isPandigital n then n
        else loop (n-2)
    loop 987654321

Then I realized I would have much better luck generating pandigital numbers and testing them for primality using the lexical permutation algorithm from Problem 24.  The following is a generic implementation with a immutable sequence wrapper.

First we need a couple operators: comparer converts an F# function into an IComparer so we can use the System.Array.Sort overload which allows in-place sub range sorting.  flip reverses the parameters of two parameter functions.

let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y }

let flip f x y = f y x

Next is our permutations function which is generic and takes a comparison function.  The inner permute function mutates the given perm array returning false when the array is at its last permutation.  Then a sequence expression is used to generate a sequence with immutable copies of the array after each permutation.  Finally, permutationsAsc and permutationsDesc are convenience partial applications of permutations.  Despite the fact that the array is copied for each yield of the sequence, this performs quite well.

let permutations f e =
    ///Advances (mutating) perm to the next lexical permutation.
    let permute (perm:'a[]) (f: 'a->'a->int) (comparer:System.Collections.Generic.IComparer<'a>) : bool =
        try
            //Find the longest "tail" that is ordered in decreasing order ((s+1)..perm.Length-1).
            //will throw an index out of bounds exception if perm is the last permuation,
            //but will not corrupt perm.
            let rec find i =
                if (f perm.[i] perm.[i-1]) >= 0 then i-1
                else find (i-1)
            let s = find (perm.Length-1)
            let s' = perm.[s]
            
            //Change the number just before the tail (s') to the smallest number bigger than it in the tail (perm.[t]).
            let rec find i imin =
                if i = perm.Length then imin
                elif (f perm.[i] s') > 0 && (f perm.[i] perm.[imin]) < 0 then find (i+1) i
                else find (i+1) imin
            let t = find (s+1) (s+1)
                
            perm.[s] <- perm.[t]
            perm.[t] <- s'

            //Sort the tail in increasing order.
            System.Array.Sort(perm, s+1, perm.Length - s - 1, comparer)
            true
        with
        | _ -> false
       
    //permuation sequence expression 
    let c = f |> comparer
    let freeze arr = arr |> Array.copy |> Seq.readonly
    seq { let e' = Seq.toArray e
          yield freeze e'
          while permute e' f c do
              yield freeze e' }
              
let permutationsAsc e = permutations compare e
let permutationsDesc e = permutations (flip compare) e

Now we have the solution to our problem.

let problem41c =    
    let rec loop n =
        let maybe = 
            {n..(-1)..1}
            |> permutationsDesc
            |> Seq.map Digits.toInt
            |> Seq.tryFind isPrime
            
        match maybe with
        | Some(value) -> value
        | None -> loop (n-1)
        
    loop 9

Note: apparently if the sum of the digits of a number is divisible by 3 then the number cannot be prime.  This isn’t obvious to me, but it’s late so I’ll look into to it more tomorrow.  However, if we take this fact we find that the number of digits must then either be 4 or 7.  Applying the 7 digit upper bound, both solution (a) and (b) run instantaneously.

Problem 40: If dn represents the nth digit of the fractional part, find the value of the following expression. d1 * d10 * d100 * d1000 * d10000 * d100000 * d1000000

An imperative solution seems appropriate.

let problem40a =
    let sb = System.Text.StringBuilder()
    let mutable n = 1
    while sb.Length <= 1000000 do
        sb.Append(n) |> ignore
        n <- n+1
        
    let mutable prod = 1
    for i in 0..6 do
        prod <- prod * ((sb.[(pown 10 i)-1] |> int) - 48) 
        
    prod

Problem 39: For which value of p ≤ 1000, is the number of solutions maximised?

Brute force algorithm with no real optimizations.

let problem39c =
    let countTriplets p = 
        let mutable count = 0
        for a in 1..p do
            for b in a..p do
                let c = p - (a + b) |> float
                let c' = a*a + b*b |> float |> sqrtF
                if c = c' then
                    count <- count + 1
        count
        
    {1..1000}
    |> PSeq.maxBy countTriplets

Problem 38: What is the largest 1 to 9 pandigital that can be formed by multiplying a fixed number by 1, 2, 3, ... ?

Wow, interesting - tough!  And I finally found Seq.choose (I was looking for Seq.pickAll).

let problem38a =
    let isPosPd (nstr:string) = //we know our chars are digits
        let len = nstr |> Seq.length
        len = 9 
        && (nstr.Contains("0") |> not) 
        && len = (nstr |> Seq.distinct |> Seq.length)
    
    let tryFind n =
        let rec loop i =
            let prodConcats = (seq {for j in 1..i -> n*j |> string }) |> Seq.fold (+) ""
            if isPosPd prodConcats then Some(prodConcats |> int)
            elif i < 9 then loop (i+1)
            else None
        loop 2 //start with 2 since n > 1
        
    {1..9999} //since n > 1, 9999 is clearly an upper limit
    |> PSeq.choose tryFind
    |> PSeq.max

Problem 37: Find the sum of all eleven primes that are both truncatable from left to right and right to left.

Kind of a variation on Problem 35.  I was surprised by how fast it ran!

let problem37a =
    let isTruncatablePrime n =
        if n |> isPrime |> not then false
        else
            let digs = n |> Digits.fromInt
            let truncations =
                seq { for i in 1..(Seq.length digs)-1 -> 
                          digs |> Seq.take i |> Digits.toInt
                      for i in 1..(Seq.length digs)-1 -> 
                          digs |> Seq.skip i |> Digits.toInt }
            Seq.forall isPrime truncations
            
    let rec odds n = seq {yield n; yield! odds (n+2)}
    odds 11 //skip the single digit primes
    |> Seq.filter isTruncatablePrime
    |> Seq.take 11 //we are given there are only 11
    |> Seq.sum

Problem 36: Find the sum of all numbers less than one million, which are palindromic in base 10 and base 2.

Reusing isPalindrome from Problem 4 and leveraging System.Convert for obtaining the binary representation of a given decimal number, this problem is trivial.

let problem36a =
    {1..999999}
    |> Seq.filter (fun n -> (isPalindrome (n|>string)) && (isPalindrome (System.Convert.ToString(n, 2))))
    |> Seq.sum

Problem 35: How many circular primes are there below one million?

Now we get to use our Digits module.  The most interesting part of this algorithm is performing digit rotations (the assignment of r), which went through several revisions before I got it just right.

let problem35c = 
    let isCircularPrime n =
        if not (isPrime n) then false
        else 
            let digs = n |> Digits.fromInt
            let rec loop i = 
                if i = (Seq.length digs)-1 then true
                else
                    let i = i + 1
                    let r = //rotate by i
                        Seq.append 
                            (digs |> Seq.skip i) 
                            (digs |> Seq.take i)
                        |> Digits.toInt
                    if isPrime r then loop i
                    else
                        false
            loop 0

    //we are given that there are 13 such primes below 100
    ({101..2..999999}
    |> Seq.filter isCircularPrime
    |> Seq.length) + 13

Digits

We’ve had a lot of problems involving digit manipulation and so far have implemented ad-hoc string parsing solutions.  But this approach is generally pretty slow.  For primitive integer types (int32 and int64), we can gain two to three times speed increase using arithmetic methods.  On the other hand, generating a sequence of digits from a bigint is actually faster using the former method.  The following module provides type optimized conversions between digit sequences and numbers.

    module Digits =
        //at least twice as fast as fastParse
        let fromInt64 (n:int64) =
            if n = 0L then Seq.singleton 0
            else
                let mutable n = if n < 0L then (abs n) else n
                let mutable powten = 0
                
                while (n/(pown 10L powten) >= 10L) do
                    powten <- powten+1
                    
                let darr = Array.create (powten+1) 0
                let mutable i = 0
                while (powten >= 0) do
                    let d = n/(pown 10L powten)
                    darr.[i] <- d |> int
                    n <- n - d*(pown 10L powten)
                    i <- i + 1
                    powten <- powten-1
                    
                Seq.readonly darr
                            
        let fromInt (n:int) = fromInt64 (n |> int64)
        
        ///parse a positive or negative number string.  if other characters (besides leading '-'
        ///and integers) are present results will be unpredictable.
        let uncheckedParse (nstr:string) =
            if nstr.[0] = '-' then //fast with least num checks
                nstr
                |> Seq.skip 1
                |> Seq.map (fun c -> (c |> int) - 48)
                |> Seq.cache
            else
                nstr
                |> Seq.map (fun c -> (c |> int) - 48)
                |> Seq.cache
        
        ///filter out non-digits
        let parse nstr = 
            uncheckedParse nstr
            |> Seq.filter (fun n -> n >= 0 && n <= 10)
        
        //not sure if using fromString here is faster than direct map string |> parse
        let fromBigInt (n:bigint) = n |> string |> uncheckedParse
                
        let toInt64 (digs:seq<int>) = 
            digs
            |> Seq.fold 
                (fun (e, sum) d -> let e = e-1 in (e, Checked.(+) sum ((d |> int64)*(pown 10L e))))
                (Seq.length digs, 0L)
            |> snd
                    
        ///note: (System.Int32.MinValue) |> Digits.fromInt |> Digits.toInt results
        ///in overflow exceptions since abs(int.MinValue) > int.MaxValue
        let toInt (digs:seq<int>) = 
            digs
            |> Seq.fold 
                (fun (e, sum) d -> let e = e-1 in (e, Checked.(+) sum (d*(pown 10 e))))
                (Seq.length digs, 0)
            |> snd
        
        open System.Text
        let toBigInt (digs:seq<int>) = 
            bigint.Parse(
                digs 
                |> Seq.fold (fun (sb:StringBuilder) d -> ignore <| sb.Append(d) ; sb) (StringBuilder())
                |> string
            ) //not sure if actually fast for bigint

Problem 34: Find the sum of all numbers which are equal to the sum of the factorial of their digits.

The upper bound is 2540160, since (factorial 9)*7 = 2540160 and (factorial 9)^x grows faster than 10^x for x >= 7.

let problem34b =   
    {3..2540160}
    |> Seq.filter (fun i -> i = (i |> string |> Seq.map (string >> int) |> Seq.sumBy factorial))
    |> Seq.sum

Problem 33: Discover all the fractions with an unorthodox cancelling method.

With F#, there are two ways to solve this: the easy way, and the slightly easier way.  The first way, we’ll work entirely with integers, including an implementation of gcd using the Euclid’s algorithm for reducing our final fraction.

gcd and accompanying abs are a sure candidates for inclusion in our Numerics module.

let inline abs (g:G<'a>) n = 
    if n < g.zero then n*g.negone else n
    
let inline gcd (g:G<'a>) n m =
    if n = g.zero || m = g.zero then 
        raise (System.ArgumentOutOfRangeException("n and m must non-zero"))
    else
        let rec gcd n m = 
            if n = m then n
            else
                if n > m then gcd (n-m) m
                else gcd n (m-n)
        gcd (abs g n) (abs g m)

And then our solution is fairly straightforward:

let problem33a =
    let unorthodoxPairs =
        [for numer = 10 to 99 do
            for denom = (numer+1) to 99 do
                let reduced = (numer |> float)/(denom |> float)
                let digitPair n = //decompose digit list of n into a pair
                    let nDigits = n |> string |> Seq.map (string >> float) |> Seq.toArray
                    (nDigits.[0], nDigits.[1])
                let (a,b) = digitPair numer
                let (c,d) = digitPair denom
                let isUnorthodox w x y z = (w/x) = 1. && (y/z) = reduced
                if isUnorthodox a c b d || 
                   isUnorthodox a d b c || 
                   isUnorthodox b d a c || 
                   isUnorthodox b c a d then yield (numer, denom)]
    
    let product = unorthodoxPairs |> List.fold (fun (w,x) (y,z) -> (w*y,x*z)) (1,1)
    snd product / (gcd (fst product) (snd product)) 

Next is our very easy solution which takes advantage of BigRational included in the F# PowerPack:

let problem33b =
    let unorthodoxPairs =
        [for numer = 10 to 99 do
            for denom = (numer+1) to 99 do
                let reduced = (numer |> float)/(denom |> float)
                let digitPair n = //decompose digit list of n into a pair
                    let nDigits = n |> string |> Seq.map (string >> float) |> Seq.toArray
                    (nDigits.[0], nDigits.[1])
                let (a,b) = digitPair numer
                let (c,d) = digitPair denom
                let isUnorthodox w x y z = (w/x) = 1. && (y/z) = reduced
                if isUnorthodox a c b d || 
                   isUnorthodox a d b c || 
                   isUnorthodox b d a c || 
                   isUnorthodox b c a d then yield BigRational.Parse(sprintf "%d/%d" numer denom)]
    
    let product = unorthodoxPairs |> List.fold (*) 1N
    product.Denominator

Here’s a third version which avoids string parsing and the need for conversions between int and float:

let problem33c =
    let unorthodoxPairs =
        [for numer = 10. to 99. do
            for denom = (numer+1.) to 99. do                
                let digitPair n =
                    let tensPlace = System.Math.Truncate(n/10.)
                    (tensPlace, n-tensPlace*10.)    

                let (a,b) = digitPair numer
                let (c,d) = digitPair denom

                let isUnorthodox w x y z = (w/x) = 1. && (y/z) = numer/denom
                if isUnorthodox a c b d || 
                   isUnorthodox a d b c || 
                   isUnorthodox b d a c || 
                   isUnorthodox b c a d then yield BigRational.Parse(sprintf "%.0f/%.0f" numer denom)]
    
    let product = unorthodoxPairs |> List.fold (*) 1N
    product.Denominator

Problem 32: Find the sum of all products whose multiplicand/multiplier/product identity can be written as a 1 through 9 pandigital.

While having lots of pieces, this problem is mostly straightforward.  The only part that required any analysis is determining sufficient lower and upper bounds for the product, since the worst case range (1 to 999999999) is far too large.  Letting p be the product, mn be the multiplican, and mr be the multiplier, we observe that if mn * mr = p, then (len p) = ((len mn) + (len mr)) + (-1 or 0).  Which implies the length of the product is cannot be less than 4 or greater than 5 or we will have either too few or too many digits in our pandigital set. Thus the range  may be restricted to 1234 to 98765.

let problem32c =
    let hasDistinctPositiveDigits (nstr:string) = 
        not (nstr.Contains("0")) && nstr.Length = (nstr |> Seq.distinct |> Seq.length)
    
    let isPositivePanDigitalSet mnstr mrstr pstr =
        let concatedDigitStr:string = mnstr + mrstr + pstr
        concatedDigitStr.Length = 9 && hasDistinctPositiveDigits concatedDigitStr
        
    let findPositivePanDigitalSet p =
        let pstr = p |> string
        if not (hasDistinctPositiveDigits pstr) then None
        else
            let sr = sqrtn p
            let rec loop mn =
                if mn > sr then None
                elif p % mn = 0 then
                    let mr = p/mn
                    if isPositivePanDigitalSet (mn |> string) (mr |> string) pstr then 
                        Some(mn, mr, p) 
                    else loop (mn + 1)
                else loop (mn + 1)
            loop 2
    
    {1234..98765} //product must be between 4 and 5 digits
    |> Seq.map findPositivePanDigitalSet
    |> Seq.filter Option.isSome
    |> Seq.sumBy (fun (Some(_,_,p)) -> p)

Problem 31: How many different ways can £2 be made using any number of coins?

More fun with recursive sequence expressions! In this solution, we generate all of the combinations instead of only counting them.

let problem31c =
    let combinations amt coins = //produce all ascending combinations starting with start
        let rec combinations combo =
            seq{ let sum = List.sum combo
                 if sum = amt then 
                     yield combo
                 elif sum < amt then 
                     yield! coins 
                            |> Seq.filter ((<=) combo.Head) //to generate combinations instead permutations
                            |> Seq.collect (fun c -> combinations (c::combo)) }
        seq {for start in coins do yield! combinations [start]}  //concat all ascending combinations for each start
    combinations 200 [1;2;5;10;20;50;100;200] |> Seq.length