2011-11-30

座標を与える

この記事は、こちらに書き直しました
2次元分割表のセルに自由度次元空間のベクトルを対応付ける話は、こちらでした
こちらでは代数統計学の一環として、多次元分割表の取扱いについてメモした
外積代数については、こんなメモもした
さて、これらをつなげてみよう
なるk多次元表があるときに、k個の尺度のそれぞれの内訳が決まっているとすると、この表の自由度はとなる
- $k=2$ の場合が $(r_1 -1)\times (r_2-1)$ である
$2^k$ のようなk次元表のとき $2^k - k-1$ であるが、これは、 $k+1$ を加えてやれば、 $2^k$ の自由度がある、とも読める
他方、外積代数では、 $2^k$ の要素が代数的振る舞いをすることが言えていて、そのうちの１つは0ベクトルに相当するし、この $2^k$ の要素というのは、1,2,3,...,kを要素とする集合の冪集合の要素に対応すると考えることができる
このように考えると、「自由度のそれぞれは、要素の組合せに定義された外積と対応する、というようにとらえることができる(ちょっとはしょっているので、なんのことかわからないかもしれない)
それをさらに、各尺度に複数の順序なしカテゴリを与えて、各尺度のカテゴリには、 $r_i-1$ 次元にある頂点数 $r_i$ 個の正単体の頂点座標を与えることとし、さらに、複数尺度の組合せには、このような正単体の頂点座標ベクトルの外積代数対応物を対応させることで、表のすべてのセルにベクトルを対応づけることができるように思われる
そして、表に周辺度数の制約があるというのは、このようにして与えた座標に制約という値を与えて、自由度〜次元を落としてやったような亜空間を考えればよさそう

CategoryVector2D<-
function (N = 3, M = 4) 
{
    cvN <- CategoryVector(N)
    cvM <- CategoryVector(M)
    m <- matrix(0, N * M, (N - 1) * (M - 1))
    counter1 <- 1
    counter2 <- 1
    for (i in 1:N) {
        for (j in 1:M) {
            counter2 <- 1
            for (k in 1:(N - 1)) {
                for (l in 1:(M - 1)) {
                  m[counter1, counter2] <- cvN[i, k] * cvM[j, 
                    l]
                  counter2 <- counter2 + 1
                }
            }
            counter1 <- counter1 + 1
        }
    }
    m
}


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])
}

library(sets)
CategoryVectorND<-function(n){
	
	df<-1
	NN<-length(n)
	S<-as.set(1:NN)
	powS<-set_power(S)
	scnt<-1
	result<-list()
	pows<-list()
	for(s in powS){
		ns<-c()
		nlist<-c()
		for(i in s){
			ns<-c(ns,n[i])
			nlist<-c(nlist,i)
		}
		
		N<-length(ns)
		if(N>0){
			CategoryVectors<-NULL
			for(i in 1:length(ns)){
				CategoryVectors[[i]]<-CategoryVector(ns[i])
				df<-df*(ns[i]-1)
			}
			#tmparr<-array(0,ns)
			tmparr<-array(0,ns[N:1])
			addresses<-which(tmparr==0,arr.ind=TRUE)
			#print(addresses)
			ret<-list()
			cnt<-1
			print(CategoryVectors)
			for(i in 1:length(addresses[,1])){
				tmp<-c(CategoryVectors[[1]][addresses[i,N],])
				if(N>=2){
		    for(j in 2:N){
		      #print(tmp)
		      #print(c(CategoryVectors[[j]][addresses[i,N-j+1],]))
		      tmp<-c(outer(tmp,c(CategoryVectors[[j]][addresses[i,N-j+1],]),"*"))
		      #print(tmp)
		    }
				}

				#ret<-c(ret,tmp)
				ret[[cnt]]<-tmp
				cnt<-cnt+1
			}
			#array(ret,c(df,ns[N:1]))
			result[[scnt]]<-ret
			pows[[scnt]]<-nlist
			scnt<-scnt+1
		}
	}
	list(v=result,pows=pows)
}


ns<-c(3,3)
out.n<-CategoryVectorND(ns)
out.n


x<-y<-c()
for(i in 1:length(out.n)){
	x[i]<-out.n[[i]][1]
	y[i]<-out.n[[i]][2]
}
plot(x,y)



ns<-c(4)
out.n<-CategoryVectorND(ns)
out.n