pedidos 1:17 por pares perfectos cuadrados

Question

Hubo una pregunta interesante en I-ayuda:

"Tome los números del uno al 17. ¿Puede usted los escribe en una línea de modo que cada par de números que son uno al lado del otro, se suma para dar un número cuadrado? "

Mi solución está por debajo y no es especialmente especial. Tengo curiosidad acerca de una solución más elegante y/o robusta. ¿Tal vez una solución que puede tomar una cadena arbitraria de números y ordenarlos así si es posible?

sq.test <- function(a, b) { 
    ## test for number pairs that sum to squares. 
    sqrt(sum(a, b)) == floor(sqrt(sum(a, b))) 
} 

ok.pairs <- function(n, vec) { 
    ## given n as a member of vec, 
    ## which other members of vec satisfiy sq.test 
    vec <- vec[vec!=n] 
    vec[sapply(vec, sq.test, b=n)] 
} 

grow.seq <- function(y) { 
    ## given a starting point (y) and a pairs list (pl) 
    ## grow the squaring sequence. 
    ly <- length(y) 
    if(ly == y[1]) return(y) 

    ## this line is the one that breaks down on other number sets... 
    y <- c(y, max(pl[[y[ly]]][!pl[[y[ly]]] %in% y])) 
    y <- grow.seq(y) 

    return(y) 
} 


## start vector 
x <- 1:17 

## get list of possible pairs 
pl <- lapply(x, ok.pairs, vec=x) 

## pick start at max since few combinations there. 
y <- max(x) 
grow.seq(y) 

Answer 1

Puede utilizar outer para calcular los pares admisibles. La matriz resultante es la matriz de adyacencia de un gráfico, y solo desea un Hamiltonian path en él.

# Allowable pairs form a graph 
p <- outer(
    1:17, 1:17, 
    function(u,v) round(sqrt(u + v),6) == floor(sqrt(u+v))) 
) 
rownames(p) <- colnames(p) <- 1:17 
image(p, col=c(0,1)) 

# Read the solution on the plot 
library(igraph) 
g <- graph.adjacency(p, "undirected") 
V(g)$label <- V(g)$name 
plot(g, layout=layout.fruchterman.reingold)