Since I thought this was a cool question, I posted it to StackOverflow. Vincent Zookynd's answer is amazing and really exercises the power of R.
http://stackoverflow.com/questions/10150161/ordering-117-by-perfect-square-pairs/10150797#10150797 On Fri, Apr 13, 2012 at 10:06 PM, Bert Gunter <gunter.ber...@gene.com>wrote: > ... 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 > [[alternative HTML version deleted]]
______________________________________________ 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.
