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.hard...@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.
______________________________________________
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.
