[R] A little exercise in R!
Bert Gunter
gunter.berton at gene.com
Sat Apr 14 06:59:48 CEST 2012
Folks:
IMHO this is exactly the **wrong** way t go about this. These are
mathematical exercises that should employ mathematical thinking, not
brute force checking of cases.
Consider, for example, the 1 to 17 sequence given by Ted. Then 17
**must** be one end of the sequence and 16 the other. (Why?) Hence,
starting from the 17 end, the values ** must** be 17 8 1 ...
Proceeding in this way, it takes only a couple of minutes to solve.
The more interesting point which I think the question was really
about, is can this always be done? I haven't given this any thought,
but there may be an easy proof or counterexample. If the answer to
this latter is no, then perhaps even more interesting is to
characterize the set of numbers where it can/cannot be done.
But this is all way off topic, no?
Cheers,
Bert
On Fri, Apr 13, 2012 at 6:26 PM, Philippe Grosjean
<phgrosjean at sciviews.org> wrote:
> 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.
>>
>>
>
> ______________________________________________
> 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.
--
Bert Gunter
Genentech Nonclinical Biostatistics
Internal Contact Info:
Phone: 467-7374
Website:
http://pharmadevelopment.roche.com/index/pdb/pdb-functional-groups/pdb-biostatistics/pdb-ncb-home.htm
More information about the R-help
mailing list