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.berton@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 <bgunter@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@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@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]]

