mükemmel kare çiftleri

Question

tarafından 1:17 Sipariş

R-yardımına ilginç bir soru vardı:

"numaraları 17. Bir satıra onları yazabilir miyim kadar birini alın, böylece olan sayıların her çifti yan yana, bir kare numarası vermek için ekler? "

Çözümüm aşağıda ve özellikle özel değil. Daha zarif ve/veya sağlam bir çözümü merak ediyorum. Belki de rasgele bir sayı dizisi alıp mümkünse bu şekilde sipariş edebilecek bir çözüm.

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

Sen izin verilen çiftleri hesaplamak için outer kullanabilirsiniz. Ortaya çıkan matris, bir grafiğin bitişik matrisidir, ve üzerinde sadece Hamiltonian path olmasını istiyorsunuz.

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