Site icon R-bloggers

project euler: problem 61

R on Guangchuang Yu

[This article was first published on 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=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

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.