パーミュテーションの球面配置 - ryamadaのコンピュータ・数学メモ

N個の要素の並べ方はN!通りある(順列)
この順列をN-1次元球面に配置する方法があり、それは、Permutohedronと呼ばれるN-1次元polytope(こちら)
考え方
- N個の要素は、N-1次元空間のN正単体(こちら)の頂点に配置することができる
  - N正単体はN-1次元空間にある、頂点数N個のN-1次元polytope
- 今、N正単体のN-1次元空間の頂点座標 $X=(x_1,x_2,...,x_N);x_i=(a_{i,1},a_{i,2},...,a_{i,N-1})$ が与えられているものとする
- N正単体には $\sum_{i}^N x_i=0$ という関係がある
- ここで、N!通りの順列 $S=(s_1,...,s_j,...,s_{N!});s_j = (t_{j,1},...,t_{j,N})$ について、点 $p_{s_j} = \sum_{i=1}^{N} i \times x_{t_{i,j}}$ を定めるとき、 $N!$ 個の点の集合 $P=(p_{s_j})$ はPermutohedronの頂点座標である

置換permutationに基づく統計手法にランクテストや、パーミュテーションテストがある…こちらなど

#library(sphere) # CategoryVector()を有する私的パッケージ
CategoryVector<-
function (nc = 3) 
{
    df <- nc - 1
    d <- df + 1
    diagval <- 1:d
    diagval <- sqrt((df + 1)/df) * sqrt((df - diagval + 1)/(df - 
        diagval + 2))
    others <- -diagval/(df - (0:(d - 1)))
    m <- matrix(rep(others, df + 1), nrow = df + 1, byrow = TRUE)
    diag(m) <- diagval
    m[upper.tri(m)] <- 0
    as.matrix(m[, 1:df])
}

N<-4 # 大きい数字だと、重くなるのは当然…
X<-CategoryVector(N)
library(gtools)
p<-permutations(N,N)

Ph<-p%*%X

library(rgl)
# N-2要素が一致している順列ペアを確認し、辺を描かせる
# 辺数調べの最大値制約を入れる
Emax<-1000000
Ecounter<-0
E<-NULL
DifID<-NULL
for(i in 1:(length(p[,1])-1)){
	for(j in (i+1):length(p[,1])){
		tmp<-p[i,]-p[j,]
		Ecounter<-Ecounter+1
		if(length(which(tmp==0))==N-2 & length(which(abs(tmp)==1))==2){
			E<-rbind(E,Ph[i,])
			E<-rbind(E,Ph[j,])
			DifID<-rbind(DifID,sort(which(abs(tmp)==1)))
		}
		if(Ecounter==Emax){
			break
		}
		
	}
	if(Ecounter==Emax){
			break
		}
}
plot3d(Ph[,1],Ph[,2],Ph[,3])

# 異なる順列位置によって辺の色を変える
C<-DifID%*% matrix(c(1,N+1),2,1)

segments3d(E[,1:3],col=rainbow(C),lwd=3)

image(Ph%*%t(Ph))