Greetings all! A recent news item got me thinking that a problem stated therein could provide a teasing little exercise in R programming. http://www.bbc.co.uk/news/uk-england-cambridgeshire-17680326 Cambridge University hosts first European 'maths Olympiad' for girls The first European girls-only "mathematical Olympiad" competition is being hosted by Cambridge University. [...] Olympiad co-director, Dr Ceri Fiddes, said competition questions encouraged "clever thinking rather than regurgitating a taught syllabus". [...] "A lot of Olympiad questions in the competition are about proving things," Dr Fiddes said. "If you have a puzzle, it's not good enough to give one answer. You have to prove that it's the only possible answer." [...] "In the Olympiad it's about starting with a problem that anybody could understand, then coming up with that clever idea that enables you to solve it," she said. "For example, take the numbers one up to 17. "Can you write them out in a line so that every pair of numbers that are next to each other, adds up to give a square number?" Well, that's the challenge: Write (from scratch) an R program that solves this problem. And make it neat. NOTE: If there should happen to be some R package that can solve this kind of problem already, without you having to think much, then its use is illegitimate! (I.e. will be deemed "regurgitation"). Over to you. With best wishes, Ted. ------------------------------------------------- E-Mail: (Ted Harding) <Ted.Harding at wlandres.net> Date: 13-Apr-2012 Time: 22:33:43 This message was sent by XFMail
I thought this was kinda cool! Here's my solution, its not robust or
probably efficient....
I'd to hear improvements or other solutions!
Justin
sq.test <- function(a, b) {
## test for number pairs that sum to squares.
sqrt(sum(a, b)) == floor(sqrt(sum(a, b)))
}
ok.pairs <- function(n, vec) {
## given n as a member of vec,
## which other members of vec satisfiy sq.test
vec <- vec[vec!=n]
vec[sapply(vec, sq.test, b=n)]
}
grow.seq <- function(y) {
## given a starting point (y) and a pairs list (pl)
## grow the squaring sequence.
ly <- length(y)
if(ly == y[1]) return(y)
## this line is the one that breaks down on other number sets...
y <- c(y, max(pl[[y[ly]]][!pl[[y[ly]]] %in% y]))
y <- grow.seq(y)
return(y)
}
## start vector
x <- 1:17
## get list of possible pairs
pl <- lapply(x, ok.pairs, vec=x)
## pick start at max since few combinations there.
y <- max(x)
grow.seq(y)
On Fri, Apr 13, 2012 at 2:34 PM, Ted Harding
<Ted.Harding@wlandres.net>wrote:
> Greetings all!
> A recent news item got me thinking that a problem stated
> therein could provide a teasing little exercise in R
> programming.
>
> http://www.bbc.co.uk/news/uk-england-cambridgeshire-17680326
>
> Cambridge University hosts first European 'maths Olympiad'
> for girls
>
> The first European girls-only "mathematical Olympiad"
> competition is being hosted by Cambridge University.
> [...]
> Olympiad co-director, Dr Ceri Fiddes, said competition questions
> encouraged "clever thinking rather than regurgitating a taught
> syllabus".
> [...]
> "A lot of Olympiad questions in the competition are about
> proving things," Dr Fiddes said.
>
> "If you have a puzzle, it's not good enough to give one answer.
> You have to prove that it's the only possible answer."
> [...]
> "In the Olympiad it's about starting with a problem that anybody
> could understand, then coming up with that clever idea that
> enables you to solve it," she said.
>
> "For example, take the numbers one up to 17.
>
> "Can you write them out in a line so that every pair of numbers
> that are next to each other, adds up to give a square number?"
>
> Well, that's the challenge: Write (from scratch) an R program
> that solves this problem. And make it neat.
>
> NOTE: If there should happen to be some R package that can solve
> this kind of problem already, without you having to think much,
> then its use is illegitimate! (I.e. will be deemed
"regurgitation").
>
> Over to you.
>
> With best wishes,
> Ted.
>
> -------------------------------------------------
> E-Mail: (Ted Harding) <Ted.Harding@wlandres.net>
> Date: 13-Apr-2012 Time: 22:33:43
> This message was sent by XFMail
>
> ______________________________________________
> R-help@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
[[alternative HTML version deleted]]
Hi all,
I got another solution, and it would apply probably for the ugliest one :-(
I made it general enough so that it works for any series from 1 to n (n
not too large, please... tested up to 30).
Hint for a better algorithm: inspect the object 'friends' in my code:
there is a nice pattern appearing there!!!
Best,
Philippe
..............................................<?}))><........
) ) ) ) )
( ( ( ( ( Prof. Philippe Grosjean
) ) ) ) )
( ( ( ( ( Numerical Ecology of Aquatic Systems
) ) ) ) ) Mons University, Belgium
( ( ( ( (
..............................................................
findSerie <- function (n, tmax = 500) {
## Check arguments
n <- as.integer(n)
if (length(n) != 1 || is.na(n) || n < 1)
stop("'n' must be a single positive integer")
tmax <- as.integer(tmax)
if (length(tmax) != 1 || is.na(tmax) || tmax < 1)
stop("'tmax' must be a single positive integer")
## Suite of our numbers to be sorted
nbrs <- 1:n
## Trivial cases: only one or two numbers
if (n == 1) return(1)
if (n == 2) stop("The pair does not sum to a square number")
## Compute all possible pairs
omat <- outer(rep(1, n), nbrs)
## Which pairs sum to a square number?
friends <- sqrt(omat + nbrs) %% 1 < .Machine$double.eps
diag(friends) <- FALSE # Eliminate pairs of same numbers
## Get a list of possible neighbours
neigb <- apply(friends, 1, function(x) nbrs[x])
## Nbr of neighbours for each number
nf <- sapply(neigb, length)
## Are there numbers without neighbours?
## then, problem impossible to solve..
if (any(!nf))
stop("Impossible to solve:\n ",
paste(nbrs[!nf], collapse = ", "),
" sum to square with nobody else!")
## Are there numbers that can have only one neighbour?
## Must be placed at one extreme
toEnds <- nbrs[nf == 1]
## I must have two of them maximum!
l <- length(toEnds)
if (l > 2)
stop("Impossible to solve:\n ",
"More than two numbers form only one pair:\n ",
paste(toEnds, collapse = ", "))
## The other numbers can appear in the middle of the suite
inMiddle <- nbrs[!nbrs %in% toEnds]
generateSerie <- function (neigb, toEnds, inMiddle) {
## Allow to generate serie by picking candidates randomly
if (length(toEnds) > 1) toEnds <- sample(toEnds)
if (length(inMiddle) > 1) inMiddle <- sample(inMiddle)
## Choose a number to start with
res <- rep(NA, n)
## Three cases: 0, 1, or 2 numbers that must be at an extreme
## Following code works in all cases
res[1] <- toEnds[1]
res[n] <- toEnds[2]
## List of already taken numbers
taken <- toEnds
## Is there one number in res[1]? Otherwise, fill it now...
if (is.na(res[1])) {
taken <- inMiddle[1]
res[1] <- taken
}
## For each number in the middle, choose one acceptable neighbour
for (ii in 2:(n-1)) {
prev <- res[ii - 1]
allpossible <- neigb[[prev]]
candidate <- allpossible[!(allpossible %in% taken)]
if (!length(candidate)) break # We fail to construct the serie
## Take randomly one possible candidate
if (length(candidate) > 1) take <- sample(candidate, 1) else
take <- candidate
res[ii] <- take
taken <- c(taken, take)
}
## If we manage to go to the end, check last pair...
if (length(taken) == (n - 1)) {
take <- nbrs[!(nbrs %in% taken)]
res[n] <- take
taken <- c(take, taken)
}
if (length(taken) == n && !(res[n] %in% neigb[[res[n - 1]]]))
res[n] <- NA # Last one pair not allowed
## Return the series
return(res)
}
for (trial in 1:tmax) {
cat("Trial", trial, ":")
serie <- generateSerie(neigb = neigb, toEnds = toEnds,
inMiddle = inMiddle)
cat(paste(serie, collapse = ", "), "\n")
flush.console() # Print text now
if (!any(is.na(serie))) break
}
if (any(is.na(serie))) {
cat("\nSorry, I did not find a solution\n\n")
} else cat("\n** I got it! **\n\n")
return(serie)
}
findSerie(17)
On 13/04/12 23:34, (Ted Harding) wrote:> Greetings all!
> A recent news item got me thinking that a problem stated
> therein could provide a teasing little exercise in R
> programming.
>
> http://www.bbc.co.uk/news/uk-england-cambridgeshire-17680326
>
> Cambridge University hosts first European 'maths Olympiad'
> for girls
>
> The first European girls-only "mathematical Olympiad"
> competition is being hosted by Cambridge University.
> [...]
> Olympiad co-director, Dr Ceri Fiddes, said competition questions
> encouraged "clever thinking rather than regurgitating a taught
> syllabus".
> [...]
> "A lot of Olympiad questions in the competition are about
> proving things," Dr Fiddes said.
>
> "If you have a puzzle, it's not good enough to give one answer.
> You have to prove that it's the only possible answer."
> [...]
> "In the Olympiad it's about starting with a problem that
anybody
> could understand, then coming up with that clever idea that
> enables you to solve it," she said.
>
> "For example, take the numbers one up to 17.
>
> "Can you write them out in a line so that every pair of numbers
> that are next to each other, adds up to give a square number?"
>
> Well, that's the challenge: Write (from scratch) an R program
> that solves this problem. And make it neat.
>
> NOTE: If there should happen to be some R package that can solve
> this kind of problem already, without you having to think much,
> then its use is illegitimate! (I.e. will be deemed
"regurgitation").
>
> Over to you.
>
> With best wishes,
> Ted.
>
> -------------------------------------------------
> E-Mail: (Ted Harding)<Ted.Harding at wlandres.net>
> Date: 13-Apr-2012 Time: 22:33:43
> This message was sent by XFMail
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
>
On Fri, Apr 13, 2012 at 10:34:49PM +0100, Ted Harding wrote:> Greetings all! > A recent news item got me thinking that a problem stated > therein could provide a teasing little exercise in R > programming. > > http://www.bbc.co.uk/news/uk-england-cambridgeshire-17680326 > > Cambridge University hosts first European 'maths Olympiad' > for girls > > The first European girls-only "mathematical Olympiad" > competition is being hosted by Cambridge University. > [...] > Olympiad co-director, Dr Ceri Fiddes, said competition questions > encouraged "clever thinking rather than regurgitating a taught > syllabus". > [...] > "A lot of Olympiad questions in the competition are about > proving things," Dr Fiddes said. > > "If you have a puzzle, it's not good enough to give one answer. > You have to prove that it's the only possible answer." > [...] > "In the Olympiad it's about starting with a problem that anybody > could understand, then coming up with that clever idea that > enables you to solve it," she said. > > "For example, take the numbers one up to 17. > > "Can you write them out in a line so that every pair of numbers > that are next to each other, adds up to give a square number?" > > Well, that's the challenge: Write (from scratch) an R program > that solves this problem. And make it neat.Hi. Is recursion acceptable? Using recursion, i obtained two solutions. extend <- function(x) { y <- setdiff((1:17), x) if (length(y) == 0) { cat(x, "\n") return } y <- y[(y + x[length(x)]) %in% (1:5)^2] for (z in y) { extend(c(x, z)) } } for (i in 1:17) extend(i) 16 9 7 2 14 11 5 4 12 13 3 6 10 15 1 8 17 17 8 1 15 10 6 3 13 12 4 5 11 14 2 7 9 16 Petr.