The Research Kitchen Weblog

Problem 28 on the Project Euler website asks what is the sum of both diagonals in a 1001×1001 clockwise spiral. This was an interesting one: the relationship between the numbers on the diagonals is easy to deduce, but expressing it succinctly in R took a little bit of tweaking. I’m sure it could be compressed even further.

# Problem 28
spiral.size <- function(n) {
        stopifnot(n %% 2 ==1)
        
        if (n==1) {
                return(1)
        }
        sum(cumsum(rep(2*seq(1,floor(n/2)), rep(4,floor(n/2))))+1)+1
}

spiral.size(1001)

Problem 22 on Project Euler proves a text file containing a large number of comma-delimited names and asks us to calculate the numeric sum of the alphabetical score for each name multiplied by the name’s position in the original list. This is made slightly easier by the presence of the predefined LETTERS variable in R.

problem22 <- function() {
        namelist <- scan(file="c:/temp/names.txt", sep=",", what="", na.strings="")
        sum(unlist(
                lapply(namelist, 
                        function(Z) which(namelist==Z) * sum(match(unlist(strsplit(Z,"")), LETTERS)))))
}

Problem 15 on Project Euler asks us to find the number of distinct routes between the top left and bottom right corners in a 20×20 grid, with no backtracking allowed.

I originally saw this type of problem tackled in the book Notes On Introductory Combinatorics, by George Polya amongst others. This book is hard to find now, but it is a really clear intro to combinatoric math.

The solution can be paraphrased as follows: if the grid is of size 20×20, and it takes 2 movements to navigate a single square in the grid, then we must make a total of 40 movements to get from the top right to the bottom left. Exactly half of these movements will be left-to-right, and the other half will be up-down. The total number of distinct routes is the number of ways that we can choose 20 of each type of move from the 40 total moves required. So we need the combinatoric construct n-choose-k, or how many ways k items can be selected from n total items. This is represented as .

In R, calculating is just:

choose(40, 20)

Problem 13 on Project Euler asks us to sum 100 50-digit numbers and give the first 10 digits of the result. This is pretty easy. Note we are using R’s integer division operator %/% to discard the remainder of the large summed integer and just gives us the first 10 digits of the result.

## Problem 13
problem13 <- function() {
    nums <- scan("problem13.dat")
    s <- sum(nums)
    s %/% 10^(floor(log10(s))-9)
}

Problem 14 on the Project Euler site asks us to find the longest chain under 1 million created using the Collatz mapping. This is fairly straightforward, although performance again is not great:

## Problem 14
# Collatz conjecture
problem14 <- function(N) {
        maxChain <- 0
        chains <- rep(0,N)
        x <- 1
        for (i in 1:N) {
                n <- i
                chain <- 0
                while(n > 1) {
                        n <- ifelse(n %% 2 == 0, n/2, 3*n+1)
                        chain <- chain + 1
                        if (n < N && chains[n] > 0) {
                            chain <- chain + chains[n]
                                break
                        }
                        
                }
                chains[i] <- chain
                if (chain > maxChain) {
                        maxChain <- chain
                        x <- i
                }
        }
        x
}

Problem 12 on the Project Euler site asks:

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

A triangular number T(n) is defined as . The R code below consists of a solution, which involves the fact that the number of proper divisors of an integer n can be calculated by first computing a prime factorisation of the number n, e.g. if , where p,q are prime, then the number of proper divisors of n can be calculated as . This solution is extremely slow (mainly due to the naive prime sieving algorithm), and could be speeded up dramatically with a little effort.

# Sieve of Eratosthenes
prime.sieve <- function(n) {
 a <- seq.int(1,n)
 p <- 1
 M <- as.integer(sqrt(n))
 while ((p <- p + 1) <= M) {
  if (a[p] != 0)
    a[seq.int(p*p, n, p)] <- 0
 }
 a[a>1 & a>0]
}
 

# Trial Division
# Returns the exponents of the prime
# factors of n
# e.g. if n = p^a*q^b
# tdiv(n) will return (a,b)
tdiv <- function(n) {
 primes <- prime.sieve(n)
 factors <- c()
 i <- 1
 curr <- 0
 
 for (p in primes) {
  while (n %% p == 0) {
   curr <- curr + 1
   n <- n %/% p
  }
  factors[i] <- curr
  i <- i + 1
  curr <- 0
 }
 
 factors[factors > 0]
}

# Compute nth triangular number
T <- function(n) {
        (n*(n+1))/2
}
 
## Problem 12
# This is a slooow solution
problem12 <- function(N) {
 n <- 0 # current triangular number Tn
 i <- 5 # \sum_{i=1}^n{i}
 
 while (TRUE) { 
  n <- T(i)
  factors <- tdiv(n) 
  if (prod(factors+1) >= N) {
   return(n)
  }
  i <- i + 1
 }
}

Problem 19 on the Project Euler website asks the user, given some initial information:

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

The obvious (but longer) way is to calculate the sum of the days between 1901 and 2000, given the number of days in each month, and a helper function to determine whether a year is a leap year or not:

is.leap <- function(year) {
        return (year %% 4 == 0 || (year %% 100 == 0 && year && 4 == 0))
}

# Problem 19
problem19 <- function() {
        daycount <- 1
        daylist <- list()
        i <- 1
        for (year in 1900:2000) {
                months <- c(0,31,28,31,30,31,30,31,31,30,31,30,31)
                if (is.leap(year)) {
                        months[3] <- 29
                        }
                        days <- daycount + cumsum(months)
                        daycount <- days[length(days)]
                        daylist[[i]] <- (days[-(length(days))])
                        i <- i + 1
                }
                sum(unlist(lapply(daylist[-1], function(x) {sum(x %% 7==1)} )))
}

However, with the aid of R’s chron library, there is a much easier way:

# Problem 19, method 2
library(chron)
sum(weekdays(seq.dates(”01/01/1901″, “12/31/2000″, by=”months”))==”Sun”)

Problem 11 on Project Euler involves calculating the maximum product of adjacent numbers in any direction in a 20×20 matrix.

The solution below takes advantage of the symmetry of calculations to cut down on unnecessary loop operations:

problem11 < - function() {
    numbers <- scan("problem11.dat")
        m <- matrix(as.numeric(numbers), 20, byrow=TRUE)
        maxprd <- 0
        N <- 20; n <- 4
        prd1 <- 0; prd2 <- 0; prd3 <- 0
        dims <- dim(m)
        a <- (n-1)
        x <- c(0:a)
        for (i in 1:(dims[1])) {
            for (j in 1:(dims[2])) {
                prd1 <- ifelse(j <= N-a, prod(m[i,j+x]), 0) # row prod
                    prd2 <- ifelse(i <= N-a, prod(m[i+x,j]), 0) # column prod
# lower right diagonal
                    prd3 <- ifelse(i <= N-a && j <= N-a, prod(diag(m[i:(i+a),j:(j+a)])),0)
# lower left diagonal
                    prd4 <- ifelse(i <= N-a && j > a, prod(diag(m[i:(i+a),j:(j-a)])), 0)
                    maxprd < - max(prd1,prd2,prd3,prd4,maxprd)
            }
        }
    maxprd
}

Problem 10 asks us to find the sum of the prime numbers below 2*10⁶. With the sieve() routine written for one of the earlier problems, this is easy: it becomes

> sum(sieve(2E6))

It is slow, however. It makes you appreciate how computationally intensive it is to search for larger primes.

Problem 9 involves finding the Pythagorean triple where a+b+c=1000.

Pythagorean triples have lots of useful relationships that we can exploit. The ones we shall use to solve this problem are:

In this case, we take , and generate the triples as follows:

# Problem 9
# Pythagorean Triple
problem9 <- function() {

        sum <- 0
        a <- 0; b <- 0; c <- 0;
        m <- 0

        for (m in 1:1000) {
         for (n in m:1000) {
         a <- m^2-n^2
         b <- 2*m*n
         c <- n^2 + m^2

         if (all(a^2 + b^2 == c^2, sum(a,b,c)==1000)) {
          return(prod(a,b,c))
         }
        }
        }
}