完璧な正方形のペア

Question

で1:17発注

R-助けに興味深い質問がありました：

「の数字に17を使用して、ラインでそれらを書き出すことができますまでのいずれかを実行しますが、そのようにしている番号のすべてのペア互いに隣り合って、合計して正方形の数字を与えるのですか？ "

私の解決策は以下の通りで、特別なものではありません。私はより洗練された、そして/または強固な解決策について興味があります。可能であれば、任意の数の文字列を取り、このような順序で並べ替えることができるソリューションですか？

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

許容可能なペアを計算するのにouterを使用できます。 結果の行列は、グラフの隣接行列 であり、その上には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)