# project euler: problem 61

November 22, 2012
By

(This article was first published on YGC » R, and kindly contributed to R-bloggers)


Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are all figurate (polygonal) numbers and are generated by the following formulae:
Triangle          P3,n=n(n+1)/2      1, 3, 6, 10, 15, ...
Square            P4,n=n2            1, 4, 9, 16, 25, ...
Pentagonal        P5,n=n(3n−1)/2     1, 5, 12, 22, 35, ...
Hexagonal         P6,n=n(2n−1)       1, 6, 15, 28, 45, ...
Heptagonal        P7,n=n(5n−3)/2     1, 7, 18, 34, 55, ...
Octagonal         P8,n=n(3n−2)       1, 8, 21, 40, 65, ...

The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three interesting properties.

The set is cyclic, in that the last two digits of each number is the first two digits of the next number (including the last number with the first).
Each polygonal type: triangle (P3,127=8128), square (P4,91=8281), and pentagonal (P5,44=2882), is represented by a different number in the set.
This is the only set of 4-digit numbers with this property.

Find the sum of the only ordered set of six cyclic 4-digit numbers for which each polygonal type: triangle, square, pentagonal, hexagonal, heptagonal, and octagonal, is represented by a different number in the set.


Firstly, I defined getPolygonalNumber to generate all the polygonal numbers and split the first and last two digits in a data.frame.

I think this problem can be done by something like the merge function. Then I got confused, since the order of this cycle was unknown beforehand.

The findConnected function was implemented, to work like a merge function for combining array. Polygonal types were recorded in findConnected function, and screen out those do not met the "only one number for each polygonal type" criteria.

Then, wrapping findConnected function in a for loop to find the cycle at a specific length.

?View Code RSPLUS
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92  getPolygonalNumber <- function(n, type, ndigit=4) { pType <- c("triangle", "square", "pentagonal", "hexagonal", "heptagonal", "octagonal") if (type < 3 || type > 8) { stop("type should be integer in [3,8]") } p <- switch(pType[type-2], "triangle" = n*(n+1)/2, "square" = n^2, "pentagonal" = n*(3*n-1)/2, "hexagonal" = n*(2*n-1), "heptagonal" = n*(5*n-3)/2, "octagonal" = n*(3*n-2) )   nd <- 10^(ndigit-1) idx <- p/nd > 1 & p/nd <10 if (length(idx) == 0) { return(NA) }   p <- p[idx] p.df <- t( sapply(p, function(i) c(floor(i/100), i%%100) ) )   p.df <- p.df[ p.df[,2] != 0, ] p.df <- p.df[ p.df[,2] > 10, ] return(p.df) }   findConnected <- function(pl, dfx) { p <- pl$p type <- pl$type nc <- ncol(p) nr <- nrow(p)   xx <- lapply(1:nr, function(n) { idx <- which(p[n,nc] == dfx$start) list(p=t(sapply(idx, function(i) c(p[n,], dfx$end[i]))), type=t(sapply(idx, function(i) c(type[n,], dfx$type[i])))) }) pp <- lapply(xx, function(i) i$p) type <- lapply(xx, function(i) i$type) i <- sapply(pp, ncol) != 0 | sapply(type, ncol) != 0 pp <- pp[i] type <- type[i] pp <- do.call(rbind, pp) type <- do.call(rbind, type) idx <- apply(type, 1, function(j) length(unique(j)) == length(j) ) pp <- pp[idx,] type <- type[idx,] result <- list(p=pp, type=type) return(result) } findCycle <- function(pp, size=6) { n <- length(pp) type <- matrix(rep(n+2, nrow(pp[[n]])), ncol=1) type <- as.data.frame(type) ps <- list(p=pp[[n]], type=type) dfx <- do.call(rbind, pp[-n]) dfx <- as.data.frame(dfx) colnames(dfx) <- c("start", "end") dfx$type <- rep(3:(n+1), times=sapply(pp[-n], nrow))   for (i in 1:(size-1)) { ps <- findConnected(ps, dfx) }   idx <- ps$p[,1] == ps$p[,ncol(ps$p)] result <- list(p=ps$p[idx,], type=ps$type[idx,]) return(result) } pp <- lapply(3:8, getPolygonalNumber, n=10:150, ndigit=4) result <- findCycle(pp, size=6) print(result) s <- 101 * sum(unique(result$p)) cat("Answer of PE 61:", s, "\n")

This code runs in less than 1 sec.

> system.time(source("problem61.R"))
$p [1] 12 81 28 82 56 25 12$type
[1] 8 6 5 3 4 7

user  system elapsed
0.388   0.005   0.393