Multiplying 192 with 1, 2 and 3:

192 x 1 = 192

192 x 2 = 384

192 x 3 = 576

Concatenating the products, we get 192384576. That number is 1-9 pandigital (as in all digits 1 to 9 is represented in the number exactly one time).

The same can be achieved by multiplying 9 with 1, 2, 3, 4 and 5. That gives us the pandigital concatenation 918273645.

We should now find the largest 1-9 pandigital number, formed as a concatenation in the described way, by multiplying an integer with 1, 2,…n, where n > 1.

Testing with 918273645. Nope, that is not the solution. That would be too easy 🙂

OK. Lets call the integer we’re multiplying, m.

And as we’re using R, lets call the numbers we are multiplying it with, for n, as in the vector 1:n.

The concatenated product will have to have 9 as its first digit. The first digits comes from multiplying m with 1. Therefore, the first digit in m must be 9.

We need to end up with a total of 9 digits in the concatenated product. If m has two digits, multiplying with 1 will give us two digits in the result. Multiplying with 2 will give us 3 digits in the result (any two digit number larger than 50 will, multiplied by 2, give a three digit result. And we know that m should begin with 9).

Multiplying with 3 will give another 3 digits in the result, bringing us to at total of 8. Multiplying with 4 brings the total number of digits in the concatenated result to 11. There can be only 9.

Chosing a three digit m gives similar problems.

But a four digit m, with 9 as the first digit, gives us four digits multiplying by 1 and five when we multiply by 2. Giving us a total of 9 digits in the result.

What we know so far:

• The integer we have to multiply has four digits, and begins with 9.
• We will have to multiply it by 1 and 2. Or 1:2.

That should be possible to brute-force.

Multiply all four digit integers where the first digit is 9 by 1:2.

Collapse the results to a single string.

Keep all the mumbers that are pandigital.

Take the maximum of it.

I don’t need to check all the numbers. I know that the first four digits must be larger than 9182, since this is the first four digits in the example. The highest number is not 9999, it is 9876.

t <- 9183:9876

Using the purrr library:

library(purrr)
answer <- t %>%
  keep(function(x) length(unique(setdiff(unlist(strsplit(paste(x*1:2,collapse=""),split="")),0)))==9)

Ok, lets stop there. What am I doing?

I pass all the possible four digit integers to keep(). keep() applies a function to each of the integers, and keeps the ones where the function evaluates to true.

The function in question is an anonymous function of x:

length(unique(setdiff(unlist(strsplit(paste(x*1:2,collapse=“”),split=“”)),0)))==9

x, the integer from t, is multiplied wiht 1:2. That results in a vector where the first element is x multiplyed by 1, and the second x multiplied by 2.

That is then put into the paste() function, with the parameter collapse=“”. The result is that the vector from just before, is concatenated to just one string.

That string is splitted by strsplit into individual characters. The result is a list. Which is bloody annoying to work with.
So I put everything into unlist(), that returns a vector.

Setdiff(x,0) removes any zeroes from that vector.

Having removed the zeroes, unique() returns all the unique values in the vector. If there is 9, the number is 1 to 9 pandigital.

And if it is, the integer is kept by keep.

It doesn’t really give me the result. It returns the four digit integers beginning with 9, that, multiplied by 1:2 and concatenated gives a pandigital result.

But the largest of them is the integer I should multiply by 1:2. So lets expand the code a bit:

answer <- t %>%
  keep(function(x) length(unique(setdiff(unlist(strsplit(paste(x*1:2,collapse=""),split="")),0)))==9) %>%
  max() %>%
  (function(x) x*1:2) %>%
  (function(x) paste(x, collapse="")) %>%
  as.numeric()

max() gives me the largest of the four digit integers. The next function mulitplies it by 1:2. After that, the result is collapsed. And finally converted to numeric by as.numeric(). Not really necessary, but I’m doing it anyway.

Lessons learned

When using pipes to do stuff, anonymous functions are useful. But should be put into parantheses.

Project Euler 32

More pandigitality. Or whatever it’s called.

39 x 186 = 7254

And that is interesting, because 39 186 7254 is pandigital. As in all the digits 1 to 9 is represented exactly once.

The task is: Find all the products, where multiplicand (39), multiplier (186) and product (7254) is 1 through 9 pandigital.

First question I need to answer is:

How many digits can there be in the multiplicand and multiplier?

If there is 1 digit in the multiplicand, there has to be 4 digits in the multiplier, and 4 in the product.

If there is only 3 in the multiplier, we would have to have 5 digits in the product, which is impossible when we multiply a 1 digit number with a 3 digit number.

And if there was 5 digits in the multiplier, we would get 5 digits in the product, bringing the total number of digits in the identity to 11.

Therefore: If there is 1 digit in the multiplicand, there has to be 4 digits in the multiplier. We will get some products with 5 digits, but we’ll filter them out.

What if there are 2 digits in the multiplicand?

Then there has to be 3 digits in the multiplier, and 4 in the the product.

If there are 2 digits in the multiplier, the highest number of digits we can get in the product, is 4. And then we would only have 8 digits in total.

If on the other hand we have 2 digits in the multiplicand, and 4 digits in the multiplier, we would get 5 digits in the product, bringing the total number of digits to 11.

So. There must be 1 or 2 digits in the multiplicand. And 4 or 3 digits respectively in the multiplier.

And there must never be more than 4 digits in the product.

Lets begin by making all possible combinations of multiplicands and multipliers.

multiplicand <- 1:9
multiplier <- 1023:9876
res1 <- expand.grid(multiplicand,multiplier)

multiplicand <- 10:98
multiplier <- 102:987
res2 <- expand.grid(multiplicand,multiplier)

testcases <- rbind(res1,res2)

All possibilities for 1 digit in the multiplicand, combined with all possibilities for a 4-digit multiplier.

Combined (rbind) with all possibilities for 2-digit multiplicands, and all possibilites for 3-digit multipliers.

Next I’ll need a function that returns TRUE if its input it 1 throug 9 pandigital:

isPan <-  function(x){ (length(unique(setdiff(unlist(strsplit(x,split="")),0)))==9)&&(nchar(x)==9) }
isPan <- Vectorize(isPan)

I also need it to be vectorized. This is not at perfect way to do it. But I can’t figure out another way.

And now we’ll use the lovely pipes to pass all the test cases through a series of functions:

library(dplyr)

answer <- testcases %>%
  mutate(product= Var1*Var2) %>%
  filter(product <= 9999) %>%
  mutate(concat = paste(Var1, Var2, product, sep="")) %>%
  filter(isPan(concat)) %>%
  select(product) %>%
  unique() %>%
  sum()

First I make a new column with the mutate() function, called product, that is the multiplication of Var1 and Var2 (multiplicand and multiplier respectively)

Next I filter out all the product that has more than 4 digits.

Next I make another new column, where I paste together the multiplicand, the multiplier and the product.

I filter, using my isPan() function. If the concatenation is pandigital, I keep it. Otherwise I throw the row away.

Now I only have rows where the concatenation of multiplicand, multiplier and product is pandigital.

But I’m actually only interested in the product, so I select the column “product”

Some of the products are repeated, unique takes care of that.

And then I just need to sum them.

Lessons learned

Vectorized functions are essential for this methodology. But can be difficult to write.

Project Euler 44 – Pentagon numbers

A pentagonal number is generated by the formula:

P~n~ = n(3n-1)/2

I must now find the pair of pentagonal numbers P~j~ and P~k~ where the sum P~j~ + P~k~ is also pentagonal.

And where P~j~ – P~k~ is pentagonal.

And where D = |P~j~ – P~k~| is minimised.

The answer is D.

First I’ll make a function generating pentagonal numbers:

pent <- function(x){
  x*(3*x - 1)/2
}

Nice and vectorized.

I can check it by calculating the first ten pentagonal numbers:

t <- 1:10
pent(t)

##  [1]   1   5  12  22  35  51  70  92 117 145

And see that they are the same as the first ten pentagonal numbers listed in the problemt text.

Next, lets make a nice long list of pentagonal numbers:

t <- 1:10000
t <- pent(t)

Next I’ll make all the pair-wise combinations of these numbers:

s <- expand.grid(t,t)

And then I’ll filter those combinations:

library(dplyr)

answer<- s %>%
  filter((Var1 + Var2) %in% t) %>%
  filter(abs(Var1 - Var2) %in% t) %>%
  transmute(D = Var1 - Var2) %>%
  abs() %>%
  min()

First – only retain the combinations where the sum of the two pentagonal numbers is itself in the list of pentagonal numbers.

Then, only retain the combinations where the absolute difference is also in the list of pentagonal numbers.

Then calculate a new row D, as the difference.

Pass that to abs() to get the absolute difference.

And finally to min() to get the minimum.

The final two steps are actually unnecessary, since I only find one pair of pentagonal numbers that meets the requirement.

Lessons learned

Hm. Not really. Why is the first I find the solution? Noone else seems to know.

Project Euler 61

OK, this was a bit of a challenge.

Find six four-digit numbers that are cyclical. As in: The last two digits of the first number is equal to the first two digits of the second number, the last two digits for the second number is equal to the first two digits in the second number. Etc. The last two digits in the final sixth number must be equal to the first two digits in the first number.

Also, one number must be triangle, one square, one pentagonal, one hexagonal, one heptagonal and on octagonal.

Lets begin by making lists of the different kinds of numbers:

Four-digit triangle-numbers:

P3 <- function(x){
  x*(x+1)/2
}
L3 <- P3(45:140)

Square numbers:

P4 <- function(x){
  x*x
}
L4 <- P4(32:99)

Pentagonal:

P5 <- function(x){
  x*(3*x -1)/2
}
L5 <- P5(26:81)

Hexagonal

P6 <- function(x){
  x*(2*x-1)
}
L6 <- P6(23:70)

Heptagonal:

P7 <- function(x){
  x*(5*x-3)/2
}
L7 <- P7(21:63)

Octagonal:

P8 <- function(x){
  x*(3*x-2)
}
L8 <- P8(19:58)

Lets get them all into a list:

values <- list(L8, L7, L6, L5, L4, L3)

And this is where it gets complicated.

I take each value in L8, which is now values[[1]]

For each of them, I run through each of the other elements of values, 2:6.

For each values[[i]], I check if there are any of the numbers, where the first two digits is equal to the last two in the element in L8 I’ve come to.

If there is, I run through all of them (the ones where the first two digits is equal to the last two in the element in L8 I’ve come to.)

For each of these, I run through each of the remaining list elements, setdiff(2:6, b), where b is the iterator in 2:6

For each of those, I check that there are numbers where the first two digits etc etc etc.

When I get to the last number, I check that the last two digits are the same as the first two digits in the number in the first loop. Then I sum the numbers I’ve found, and get the answer.

It is not difficult. As such. But there are a lot of nested for-loops, and I have to check that there is a possible next number, and, if not, go to the next element.

It took quite a lot of time to get it right…

for(i in values[[1]]){
  for(b in 2:6){
    if(length(values[[b]][(values[[b]] %/% 100) == (i %% 100)])==0){
        next()
      }
    for(j in values[[b]][(values[[b]] %/% 100) == (i %% 100)]){
      for(c in setdiff(2:6, b)){
       if(length( values[[c]][(values[[c]] %/% 100) == (j %% 100)]  )==0){
         next()
       }
       for(k in values[[c]][(values[[c]] %/% 100) == (j %% 100)]){
         for(d in setdiff(2:6, c(b,c))){
           if(length( values[[d]][(values[[d]] %/% 100) == (k %% 100)]  )==0){
         next()
       }
           for(l in values[[d]][(values[[d]] %/% 100) == (k %% 100)]){
             for(e in setdiff(2:6, c(b,c,d))){
               if(length( values[[e]][(values[[e]] %/% 100) == (l %% 100)]  )==0){
         next()
       }
               for(m in values[[e]][(values[[e]] %/% 100) == (l %%100)]){
                  for(f in setdiff(2:6, c(b,c,d,e))){
                    if(length( values[[f]][(values[[f]] %/% 100) == (m %% 100)]  )==0){
                    next()
                     } else{
                    for(n in values[[f]][(values[[f]] %/% 100) == (m %% 100)]){
                          if((n %% 100) == (i %/% 100)){
                        answer <- sum(i,j,k,l,m,n)
                        break()
                      }}
                    }
                  }   
               }
             } 

           }
          }
       }
     }
    }
  }
}

Neat. But there must be an easier way.

How many ways can you make 2 pounds given these sizes of coins:

1p, 2p, 5p, 10p, 20p, 50p, 1£ and 2£

Where 1£ is 100p.

We can take either 0 or 1 2£ coin.

answer <- 0

for(a in seq(0,200,by=200)){
  for(b in seq(0,(200-a),by=100)){
    for(c in seq(0,(200-a-b), by=50)){
      for(d in seq(0,(200-a-b-c),by=20)){
        for(e in seq(0,(200-a-b-c-d), by=10)){
          for(f in seq(0,(200-a-b-c-d-e), by=5)){
            for(g in seq(0,(200-a-b-c-d-e-f),by=2)){
              answer <- answer + 1
            }
          }
        }
      }
    }
 }
}

How to explain it…

I need to count up to 200p total.

a is the part of the 200p that is made up by a 2£ coint. That is either 0 or 200. Or the sequence from 0 to 200 taken in increments of 200.

What is left after considering 2£ coins, is 200 minus the value of a. The number of 1£ coins we can use to make up that amount is all the values from 0 to what is left. Ie 0 to 200-a in increments of 100. The part of the total 200p that is made up by 1£ coins is b.

After adding some 1£ coins, there are 200-a-b left. That can be made by 50p coins. The part of what is left i c, and that is values from 0 to 200-a-b in increments of 50, ie seq(0,(200-a-b), by=50)

Etc.

The trick is to make sure that the ranges of the inner loops is controlled by what happened in previous loops.

Otherwise I will loop over far too many values.

Number spiral diagonals

We can make squares of numbers, by starting with 1, and add numbers in a spiral.

It is easier to show than descripe:

square <- matrix(c(21, 22, 23, 24, 25,20,  7,  8,  9, 10,19,  6,  1,  2, 11,18,  5,  4,  3, 12,17, 16, 15, 14, 13), 5,5,byrow=T)
square

##      [,1] [,2] [,3] [,4] [,5]
## [1,]   21   22   23   24   25
## [2,]   20    7    8    9   10
## [3,]   19    6    1    2   11
## [4,]   18    5    4    3   12
## [5,]   17   16   15   14   13

This is a 5 by 5 square. Start at 1, add the 2 to the right of that, and add numbers in a clockwise spiral.

If we look at all the numbers in the diagonals, we can see that the sum of those numbers, is 101. Ie, 21 + 7 + 1 + 3 + 13 + 25 + 9 + 5 + 17 = 101

We are now asked: What is the sum of the numbers in the diagonals in a 1001 by 1001 square?

Looking at an n by n square, where n is uneven, we can see that the north-eastern corner of the square will always be n^2.

We know that the side is n. So the value of the north-western corner will always be n² – (n-1).

Similar the south-western corner is n² – 2(n-1). And the south-eastern is n² – 3(n-1).

The first “square” is a special case. But I can now calculate the corners in all the squares with unequal n.

The sum of those corners is:

n² + n² -(n-1) + n² – 2(n-1) + n² – 3(n-1)

Which reduces to:

4*n² – 6n + 6

If I calculate that for all unequal n from 3 to 1001, sum them, and add 1, I have my answer.

library(purrr)
answer <- seq(3,1001,by=2) %>%
  map(function(x) 4*x*x - 6*x + 6) %>%
  unlist() %>%
  sum() 
answer <- answer + 1

Lessons learned

Not really.

Some numbers are palindromic, ie they are the same read in both directions.
Some numbers are palindromic in more than one base.
The problem mentions 585, which is palindromic. In binary 585 is 1001001001. And that is palindromic as well.
Find all numbers below 1000000 that are palindromic in both base 10 and base 2.
What is their sum?

First I’m going to need a function that checks if a number is palindromic.

palindromic <- function(x){
  paste(rev(unlist(strsplit(as.character(x),""))), collapse="")==as.character(x)
}

This function converts the input to character, splits it in individual characters, and unlists it. Because strsplit() returns a list. Then that vector is reversed with rev(), and pasted together to a single string. That string is then compared to the input – converted to character.
It returns TRUE if the input is palindromic. And what is nice is that it doesn’t care if the input is a number or a string.

Next I’m going to need a function that converts a number to it’s binary representation.
There is one, intToBits(). But it returns all the individual bits. And in reverse order. Also, it returns the bits as characters. So. intToBits(x) to get the bits. as.integer() to convert them to integers. Then the vector is reversed. And collapsed with paste().
One more detail – leading zeroes are not allowed. Therefore I remove all leading zeroes with a regular expression.

binary <- function(x){
  unlist(map(x, function(x) sub("^[0]+", "", paste(rev(as.integer(intToBits(x))), collapse="")))         )
}

This is a bit annoying. paste() pastes everything together. When I pass a vector to it, it will not only split the individual elements apart, convert them, and then paste them together individually. It will also paste together every single element in the vector, and just return a very long string.
map() solvse this. I define the “split, convert, paste-together” part as an anonymous functtion, which is then passed to map along with the vector. map() applies the function to each element in the vector, and as if by magic, stuff is no longer pasted together. map() returns a list, so I’ll have to wrap it in unlist().

Now I have all the elements. I just need find a way to convert a binary number to its decimal representation.
strtoi() does that. It takes a character vector, and converts it to integer – given a certain base, in this case 2.
I’ll just use that as an anonymous function.

Piping everything together:

t <- 1:1000000
s <- t %>%
  keep(palindromic) %>%
  binary() %>%
  keep(palindromic) %>%
  (function(x) strtoi(x, base=2)) %>%
  sum()

Passing all numbers from 1 to a million to keep(), with the predicate function palindromic. There are faster ways to generate palindromes, I know.
Piping the result of that to binary, converting every palindromic number (decimal) to binary.
Then, once more, through keep, only keeping the binary numbers which are palindromic.
Now we have the numbers which are palindromic in both decimal and binary. They are converted to integers, and summed.

Lessons learned.
1. map() is good to know – The alternative here would be to use Vectorize().
2. How to convert from decimal to binary, and back.

This problem defines a sum.
1¹ + 2² + 3³ + 4⁴ + 5⁵ + 6⁶ + 7⁷ + 8⁸ + 9⁹ + 10¹⁰

Lets call that S10. We are told that S10 is equal to 10405071317.

Our task is now to find the last ten digits fo S1000.

This is relatively simple – I have solved similar problems before. The challenge is that

999^999

## [1] Inf

has an awfull lot of digits. The number is so large that R tells me it is infinite.

We are only interested in the last ten digits however, and R handles ten digits without problems.

Instead of using the built-in power function, I’ll make my own.

selfPower <- function(x){
  res <- 1
  for(i in 1:x){
    res <- (res*x)%%10000000000000
  }
  res
}

The function takes x as input. Multiply the result (initialized to 1) with x, and do that x times. After each multiplication, it keeps the last 13 digits as the result. Whatever happens with the rest of the digits is uninteresting.

I’ll run that function on all numbers from 1 to 1000. And then I’ll have to add it all together.
Adding stuff up, I’ll run into the same problem. So instead of using the built-in add-function, I’m writing my own.

adding <- function(x,y){
  (x+y)%%100000000000
}

It takes two numbers. Add them, and return the last 11 digits.

Putting that together, and doing a bit of functional programming using purrr:

library(purrr)
answer <- 1:1000 %>%
  (function(x) sapply(x, selfPower)) %>%
  reduce(adding) %>%
  (function(x) x%%10000000000)

I’m passing the numbers 1:1000 to an anonymous function, that sapply’s selfPower on the x’es. Then I reduce the results using adding. And finally that result is passed to a second anonymous function, that returns the last ten digits.

Lessons learned:
1. Anonymous functions should be inside parantheses.
2. I run a version of the magrittr library, that has an interesting error in the error message when you learn lesson 1: “Error: Anonymous functions myst be parenthesized”

Reciprocal cycles.

Yeah.
1/6 = 0.1(6)

And
1/7 = 0.(142857)

Where (6) indicates that 6 is repeated.

Find the number d where 1/d has the longest recurring cycle.

Ok. So how to do this. One challenge is to calculate the decimal fraction to arbitrary precision. The recurring cycle might turn up after 7 digits. Or after 1000.
The other challenge is to figure out when the recurring cycle is actually recurring.

If I had to do this with paper and pen, I would take 1/7. The result is 0, and a remainder of 1. My first approximation of 1/7 would be 0. Then I would multiply the remainder by 10, and divide that result with 7:
10/7. The result is 1, with a remainder of 3. The approximation is now 0.1. The remainder is multiplied and divided: 30/7 = 4 and a remainder of 2. The approximation is now 1/7 = 0.14. Lets put that in a table:

Step Division made Result Remainder Approximation

 1      1/7               0            1             0
 2      10/7              1            3             0.1
 3      30/7              4            2             0.14
 4      20/7              2            6             0.142
 5      60/7              8            4             0.1428
 6      40/7              5            5             0.14285
 7      50/7              7            1             0.142857

And the I can stop. Because the next digit in the approximation is determined by the remainder of the previous division. And now I have a remainder that I have seen before. The first step where I have a remainder of 1 is step one. The next is step 7, and the cycle is 7-1 long.

I now have the structure of how to solve this.
Take a number d. Calculate 1 %% d. Save that result, lets call it X~1~, somewhere. Calculate X~2~ = X~1~*10 %% d, and save X~2~. Continue calculating X~n+1~ = 10 X~n~ %% d, until X~n+1~ has been seen before.
Do that for all positive integers d < 1000.

Lets write a function for that:

recurr <- function(d){
  res <- numeric()
  new_remainder <- 0.1
  while(length(res)==length(unique(res))){
    new_remainder <- (new_remainder*10) %% d
    res <- c(res, new_remainder)
  }
  which(res==res[length(res)])[2] - which(res==res[length(res)])[1]
}

The function takes d as input.
An empty vector, res, is defined, and a variable new_remainder is set to 0.1.
I’m using the res vector to store the consecutive list of remainders from the divisions. The moment that there are duplicate values in that vector, I have added a remainder to it that was already there. That indicates that a recurring cycle has been reached.
The next remainder that should be entered to the result vector, is found by multiplying the previous remainder by 10 and do the integer division by d. By setting the new_remainder variable to 0.1 from the beginning, I’m making sure that the first division is 1 %% d.
The new remainder is added to the result vector at the end. This is not an efficient method of growing that vector. I’ll think I’ll live with it.
The while-loop stops when a remainder has been added that was already in the result vector. That remainder will be in the last position of the vector. The length of the recurring cycle is the distance between the to instances of the last remainder added. That is length of the cycle.

What now remains is to run this function on all numbers d < 1000, and get the d, that has maximum recurr(d).

I pipe the vector 1:999 to map(), which simply applies a function on all elements of the vector.
The result is a list, so that is piped to unlist.
The order of that vector is unchanged. So the value in position 42, will be the length of the recurring cycle in 1/42. which.max() returns the position of the largest element in a vector, which is just what I need.

library(purrr)
answer <- 1:999 %>%
  map(recurr) %>%
  unlist %>%
  which.max()

Lessons learned

1. Probably most of all that I should not shy away from a problem just because it seems a bit difficult. Not that this a difficult problem, it’s only a 5 percenter. But I passed it over more than once, because I could not get min brain around how to get those fractions.
2. There might be a better way to see if something has occured before in a sequence of numbers. But this is working, and I think there is at least one other Euler problem that can be solved using similar logic.