[This article was first published on

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

**YGC » R**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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=n^{2}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 Answer of PE 61: 28684 user system elapsed 0.388 0.005 0.393

#### Related Posts

To

**leave a comment**for the author, please follow the link and comment on their blog:**YGC » R**.R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.