Posts Tagged ‘FSharp.PowerPack’

Project Euler Problem #146!

April 25th, 2010

Problem #146 says:

The smallest positive integer n for which the numbers n^(2)+1, n^(2)+3, n^(2)+7, n^(2)+9, n^(2)+13, and n^(2)+27 are consecutive primes is 10.
The sum of all such integers n below one-million is 1242490.

What is the sum of all such integers n below 150 million?

This problem is rather complicated to say the least and my below solution is my first attempt at solving it, it takes about a half hour to run on a quad core machine. There are some tests in place to remove numbers as fast as possible for instance the numbers must be a multiple of 10 before we add a 1,3,7,9,13, or 27 to it, there is also a few modulus test being performed to narrow the search area down some. Then the list of possible numbers is filtered in parallel to make sure we only get consecutive primes. This solution uses the Miller-Rabin code posted earlier with a modified non-recursive toBinary method. There are 12 valid numbers.

Solution provided in f# and requires .net 4.0 and the Fsharp powerpack.

#light
module ProjectEuler

open System
open System.Diagnostics
open Microsoft.FSharp.Linq
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Math
open System.Numerics

let toBinary (n:BigInteger) =
    let mutable m = n
    let mutable r = []
    while m > BigInteger.Zero do
        r <- r @ [(m % (BigInteger 2))]
        m <- m / BigInteger 2
    r

let test (a:BigInteger) (n:BigInteger) =
    let (b:List<BigInteger>) = toBinary (n - BigInteger.One)
    let mutable d = BigInteger.One
    let mutable Prime = false
    let CheckList = [0 .. b.Length-1 ] |> List.rev
    for i in CheckList do
        let x = d
        d <- (d*d) % n
        if (d = BigInteger.One && x <> BigInteger.One && x <> n-BigInteger.One) then
            Prime <- true // complex
        if b.[i] = BigInteger.One then
            d <- (d*a) % n
    if d <> BigInteger.One then
        Prime <- true //complex
    Prime //if its still false then prime

let MillerRabin (n:uint64) (s:int) =
    let Rand = new System.Random()
    let mutable Prime = true
    if n < Convert.ToUInt64(Int32.MaxValue) then
        for j in [1 .. s+1] do
            let a = Rand.Next(1, Convert.ToInt32(n)-1)
            if (test (BigInteger a) (BigInteger n)) then
                Prime <- false
    else
        for j in [1 .. s+1] do
            let a = Rand.Next(1, Int32.MaxValue)
            if (test (BigInteger a) (BigInteger n)) then
                Prime <- false
    Prime

let ntest n =
    let k = n / 10UL
    if (n%3UL=1UL || n%3UL=2UL)
        && n%13UL<>0UL
        && n%2UL=0UL
        && n%5UL=0UL &&
        ((n%7UL=3UL || n%7UL=4UL) &&
            (n%210UL=10UL ||
             n%210UL=80UL ||
             n%210UL=130UL ||
             n%210UL=200UL )) &&
        (k % 7UL = 1UL ||
         k % 7UL = 6UL ||
         k % 3UL <> 0UL ||
         k % 13UL <> 0UL ||
         k % 17UL <> 0UL ||
         k % 29UL <> 0UL ||
         k % 19UL <> 0UL ||
         k % 23UL <> 0UL ) then
        true
    else
        false

let nsquaretest n =
    let ns = n*n
    if ((MillerRabin ((ns)+13UL) 5) &&
        (MillerRabin ((ns)+3UL) 5) &&
        (MillerRabin ((ns)+7UL) 5) &&
        (MillerRabin ((ns)+9UL) 5) &&
        (MillerRabin ((ns)+1UL) 5) &&
        (MillerRabin ((ns)+27UL) 5) ) then
        if (MillerRabin (ns + 19UL) 5 ||
            MillerRabin (ns + 21UL) 5) then
            false
        else
            true
    else
        false

let rec sum (a:uint64) (n:List<uint64>)  =
    if n = List.empty then
        a
    else
        sum (a+n.Head) n.Tail

let watch = new Stopwatch()
watch.Start()

let check =
    [10UL .. 10UL .. 1000000UL]
    |> PSeq.filter ntest
    |> PSeq.toList

let Answer =
    check
    |> PSeq.filter nsquaretest
    |> PSeq.toList

Console.WriteLine(Answer |> sum 0UL)
Console.WriteLine(Answer.Length)
watch.Stop()
Console.WriteLine(watch.Elapsed)
Console.Beep() |> ignore
Console.ReadKey() |> ignore

Tags: , , ,
Posted in Project Euler | Comments (0)

Project Euler Problem #74!

March 26th, 2010

Problem #74 says:

The number 145 is well known for the property that the sum of the factorial of its digits is equal to 145:

1! + 4! + 5! = 1 + 24 + 120 = 145

Perhaps less well known is 169, in that it produces the longest chain of numbers that link back to 169; it turns out that there are only three such loops that exist:

169 → 363601 → 1454 → 169
871 → 45361 → 871
872 → 45362 → 872

It is not difficult to prove that EVERY starting number will eventually get stuck in a loop. For example,

69 → 363600 → 1454 → 169 → 363601 (→ 1454)
78 → 45360 → 871 → 45361 (→ 871)
540 → 145 (→ 145)

Starting with 69 produces a chain of five non-repeating terms, but the longest non-repeating chain with a starting number below one million is sixty terms.

How many chains, with a starting number below one million, contain exactly sixty non-repeating terms?

This solution is done with brute force by checking the chain length and counting the matching results. Could be made a lot faster if a collection of previous results was stored to avoid duplicating work. But it runs fast enough for me.

Solution in F# and requires .Net 4 and the FSharp powerpack.

#light

open System
open System.Diagnostics
open Microsoft.FSharp.Linq
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Math
open System.Numerics

let rec Factorial (x:int64) =
    if x <= (int64 1) then
        (int64 1)
    else
        x * Factorial (x-(int64 1))

let DigitalSumFactorial (x:int64) =
    x.ToString().ToCharArray()
    |> Seq.map (fun (x:char) -> Int64.Parse (x.ToString()))
    |> Seq.map Factorial
    |> Seq.sum

let rec CheckChain (x:int64) (k:List<int64>) =
    if List.contains x k then
        k.Length
    else
        let nK = x :: k
        let nX = DigitalSumFactorial x
        CheckChain (nX) (nK)

type TestCase (y:int64) =
    let Chainl = CheckChain y List.empty
    member x.Length
        with get() = Chainl

let watch = new Stopwatch()
watch.Start()

let Answer =
    [(int64 2) .. (int64 999999)]
    |> PSeq.map (fun (x:int64) -> TestCase(x))
    |> PSeq.filter (fun (x:TestCase) -> if x.Length = 60 then true else false)
    |> PSeq.length

Console.WriteLine(Answer)
watch.Stop()
Console.WriteLine(watch.Elapsed)
Console.ReadKey() |> ignore

Tags: , , ,
Posted in Project Euler | Comments (0)

Project Euler Problem #113!

March 23rd, 2010

Problem #113 says:

Working from left-to-right if no digit is exceeded by the digit to its left it is called an increasing number; for example, 134468.

Similarly if no digit is exceeded by the digit to its right it is called a decreasing number; for example, 66420.

We shall call a positive integer that is neither increasing nor decreasing a “bouncy” number; for example, 155349.

As n increases, the proportion of bouncy numbers below n increases such that there are only 12951 numbers below one-million that are not bouncy and only 277032 non-bouncy numbers below 10^(10).

How many numbers below a googol (10^(100)) are not bouncy?

This is a simple combinatorial counting problem. As such we just need to calculate the binomial of a few numbers and remove the duplicates. The binomial requires the use of a unbounded integer class (in this case the biginteger class from System.Numerics) if you don’t want to use such a class you need to do some optimization on the binomial calculation.

Solution below in FSharp requires .Net 4 the FSharp powerpack. Runs in under 1 second.

#light

open System
open System.Diagnostics
open Microsoft.FSharp.Linq
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Math
open System.Numerics

let rec Factorial (x:BigInteger) =
    if x = BigInteger.One then
        BigInteger.One
    else
        BigInteger.Multiply (x,(Factorial (BigInteger.op_Decrement x)))

let binomial (n:int) (k:int) =
    let bN = BigInteger n
    let bK = BigInteger k
    (Factorial bN) / ((Factorial bK) * (Factorial(bN-bK)))

let watch = new Stopwatch()
watch.Start()

let BigBinom = binomial 110 10
let SmallBinom = binomial 109 9
let n100 = BigInteger (10*100)
let two = BigInteger 2

Console.WriteLine(BigBinom + SmallBinom - n100 - two)
watch.Stop()
Console.WriteLine(watch.Elapsed)
Console.ReadKey() |> ignore

Tags: , , ,
Posted in Project Euler | Comments (0)

Project Euler Problem #72!

March 22nd, 2010

Problem #72 says:

Consider the fraction, n/d, where n and d are positive integers. If n

If we list the set of reduced proper fractions for d ≤ 8 in ascending order of size, we get:

1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8

It can be seen that there are 21 elements in this set.

How many elements would be contained in the set of reduced proper fractions for d ≤ 1,000,000?

The simplest way to solve this is to realize that its simply the sum of the euler totient (phi function) of all the numbers from 2 to 1,000,000. So we just need to generate some primes write a nifty totient function and run the numbers down.

Solution below in fSharp and requires the FSharp power pack and .Net 4.

#light

open System
open System.Diagnostics
open Microsoft.FSharp.Linq
open Microsoft.FSharp.Collections

//prime generation from
//http://bit.ly/aWFrGy
let is_prime_juliet n =
    let maxFactor = sqrt(float n)
    let rec loop testPrime tog =
        if testPrime > maxFactor then true
        elif n % testPrime = 0. then false
        else loop (testPrime + tog) (6. - tog)
    if n = 2. || n = 3. || n = 5. then true
    elif n <= 1. || n % 2. = 0. || n % 3. = 0. || n % 5. = 0. then false
    else loop 7. 4.

let getPrimes upTo =
    seq {
        yield 2.;
        yield 3.;
        yield 5.;
        yield! (7., 4.)
        |> Seq.unfold (fun (p, tog) -> if p <= upTo then Some(p, (p + tog, 6. - tog)) else None)
    }
    |> Seq.filter is_prime_juliet

let Primes =
    (getPrimes (1000.))
    |> Seq.toList

let rec factorise (n:float) =
    if n = 1. then
        []
    else
        let c = Primes |> List.filter (fun x -> n % x = 0.)
        if c.Length = 0 then
            [n]
        else
            let a = Primes |> List.find (fun x -> n % x = 0.)
            a :: factorise (n / a)

let Totient (x:float) =
    (factorise x)
    |> Seq.distinct
    |> Seq.map (fun x -> 1. - (1./x))
    |> Seq.fold(fun acc a -> acc * a) x

let watch = new Stopwatch()
watch.Start()

let Answer =
    [2. .. 1000000.]
    |> PSeq.map Totient
    |> PSeq.toArray
    |> PSeq.sum

Console.WriteLine(Answer)
watch.Stop()
Console.WriteLine(watch.Elapsed)
Console.ReadKey() |> ignore

Tags: , , ,
Posted in Project Euler | Comments (0)

Project Euler Problem #62!

March 21st, 2010

Problem #62 says:

The cube, 41063625 (345^(3)), can be permuted to produce two other cubes: 56623104 (384^(3)) and 66430125 (405^(3)). In fact, 41063625 is the smallest cube which has exactly three permutations of its digits which are also cube.

Find the smallest cube for which exactly five permutations of its digits are cube.

The solution below uses a custom class that takes a int64 in its constructor and to identify it later, it then creates a list of all of the digits of the number sorted by size. We then take an item in the list and see how many times it matches another class in the list including matching against itself. If the items returns 5 then we know its one of the numbers we’re looking for.

Solution in f# and requires FSharp.PowerPack and .Net 4. Runs in ~10 seconds.

#light

open System
open System.Diagnostics
open Microsoft.FSharp.Linq
open Microsoft.FSharp.Collections

type TestCase (y) =
    let num = y
    let icube = (num*num*num).ToString().ToCharArray() |> Seq.sort |> Seq.toList
    member x.Num
        with get() = num
    member x.Cube
        with get() = icube

let watch = new Stopwatch()
watch.Start()

let mutable CheckSet =
    [1000L .. 9000L]
    |> Seq.map (fun x -> new TestCase(x))
    |> Seq.toList

Console.WriteLine("starting check")

let Check (num:TestCase) =
    let count =
        CheckSet
        |> Seq.filter (fun (x:TestCase) -> num.Cube = x.Cube)
        |> Seq.length
    if count = 5 then
        true
    else
        false

let Answer =
    let n =
        CheckSet
        |> PSeq.filter Check
        |> PSeq.toList
    n.[0]

Console.WriteLine(Answer.Num*Answer.Num*Answer.Num)
watch.Stop()
Console.WriteLine(watch.Elapsed)
Console.ReadKey() |> ignore

Tags: , , ,
Posted in Project Euler | Comments (0)