... 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 <bgun...@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 > <phgrosj...@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.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. > > > > -- > > 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 ______________________________________________ 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.