ordinazione 01:17 da Perfect coppie quadrati

Question

C'era una domanda interessante sulla R-help:

"Prendi i numeri da uno fino a 17. Potete scriverle in una linea in modo che ogni coppia di numeri che sono uno accanto all'altro, aggiunge per dare un numero quadrato? "

La mia soluzione è inferiore e non particolarmente speciale. Sono curioso di una soluzione più elegante e/o robusta. Forse una soluzione che può prendere una stringa arbitraria di numeri e ordinarli così se possibile?

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

È possibile utilizzare outer per calcolare le coppie ammissibili. La matrice risultante è la matrice di adiacenza di un grafico, e si desidera solo un Hamiltonian path su di esso.

# 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)