zamawiania 1:17 przez idealny kwadrat par

Question

Nie było interesujące pytanie na R-help:

„Take numery jednego do 17. Można zapisać je w linii tak, że każda para liczb, które są obok siebie, sumuje się, aby podać liczbę kwadratową? "

Moje rozwiązanie jest poniżej i nie jest szczególnie szczególne. Ciekawi mnie bardziej eleganckie i/lub solidne rozwiązanie. Może rozwiązanie, które może wziąć dowolny ciąg liczb i zamówić je w ten sposób, jeśli to możliwe?

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

Można użyć outer do obliczenia dopuszczalnych par. Wynikowa macierz to macierz dopasowania do wykresu, i po prostu chcesz mieć na niej Hamiltonian path.

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