[R] A little exercise in R!
Bert Gunter
gunter.berton at gene.com
Sat Apr 14 07:06:37 CEST 2012
... and a moment's more consideration immediately shows it cannot be
done for n = 18, since 16,17, and 18 cannot all be at an end.
-- Bert
On Fri, Apr 13, 2012 at 9:59 PM, Bert Gunter <bgunter at gene.com> wrote:
> 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
--
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