整理し直す:組み合わせの団代数、flag minor
- 資料はこちら:
https://arxiv.org/pdf/1005.1086.pdf
- 要素数nの集合の部分集合の族から全体と空集合を除くと、となり、その要素数は
- これのflag minorを考える
- flag minorとは、行が、部分集合、列は、元の行列の左詰めの列になったような正方行列の行列式のこと
- 今、ととをFrozen とし、それ以外をMutableとする
- Frozenは常に現れ、Mutableは一部(個だけが現れるような箙をつくると
- Mutableのうちの1つを入れ替えて別のMutableに変異させることができる
- これをやるために、ちょっと工夫が必要で、1要素を加える。これはオリジナルの行列の行列式ではなくとないう特殊な形をしているが、それさえ許せば団代数になる
- Flag minorの間には、という関係がある
- 文章で書いてもわかりにくいので絵で描く
- Rで実験
library(igraph) # Flag minor cluster algebra matrix my.B.flagminor <- function(n){ unbound.chamber <- 2 * (n-1) bound.chamber <- (n-1) * (n-2) /2 total.chamber <- unbound.chamber + bound.chamber B <- matrix(0,total.chamber,total.chamber) n.chamber.per.row <- n:2 n.row <- n-1 id.first.row <- c(1,cumsum(n.chamber.per.row)[1:(n.row-1)]+1) # horizontal arrow for(i in 1:(n.row-1)){ for(j in 1:(n.chamber.per.row[i]-1)){ tmp <- id.first.row[i] + j -1 tmp2 <- tmp + 1 B[tmp,tmp2] <- 1 } } # up row for(i in 1:(n.row-1)){ for(j in 2:(n.chamber.per.row[i]-1)){ tmp <- id.first.row[i] + j -1 tmp2 <- id.first.row[i+1] + (j-1) -1 B[tmp,tmp2] <- 1 } } # down row for(i in 2:n.row){ for(j in 2:n.chamber.per.row[i]){ tmp <- id.first.row[i] + j -1 tmp2 <- id.first.row[i-1] + j -1 B[tmp,tmp2] <- 1 } } #B.skew <- B - t(B) frozen <- c() for(i in 1:(n.row-1)){ frozen <- c(frozen,id.first.row[i],id.first.row[i+1]-1) } frozen <- c(frozen,id.first.row[n.row],id.first.row[n.row]+1) mutable <- (1:length(B[,1])) [-frozen] B. <- B[c(mutable,frozen),c(mutable,frozen)] B.skew <- B. - t(B.) B.ext <- B.skew[,1:length(mutable)] return(list(B.ext = B.ext,B=B,B.skew=B.skew,B.=B.)) } my.layout.flagminor <- function(n){ unbound.chamber <- 2 * (n-1) bound.chamber <- (n-1) * (n-2) /2 total.chamber <- unbound.chamber + bound.chamber n.chamber.per.row <- n:2 n.row <- n-1 id.first.row <- c(1,cumsum(n.chamber.per.row)[1:(n.row-1)]+1) xy <- matrix(0,0,2) for(i in 1:n.row){ tmp <- cbind(1:n.chamber.per.row[i] + i * 0.5,rep(i,n.chamber.per.row[i])) xy <- rbind(xy,tmp) } #xy[length(xy[,1]),1] <- xy[length(xy[,1]),1] + 0.5 return(xy) } my.B.mut <- function(B,k){ new.B <- B n <- length(B[1,]) m <- length(B[,1]) rule1 <- FALSE for(i in 1:m){ for(j in 1:n){ if(i == k || j == k){ rule1 <- TRUE }else{ rule1 <- FALSE } if(rule1){ new.B[i,j] <- -B[i,j] }else{ new.B[i,j] <- B[i,j] + 1/2 * (abs(B[i,k]) * B[k,j] + B[i,k] * abs(B[k,j])) } } } return(new.B) }
n <- 4 out <- my.B.flagminor(n) g <- graph.adjacency(out$B) lout <- my.layout.flagminor(n) plot(g,layout = lout) ||< >|r| M <- matrix(rnorm(4^2),4,4)
> M[3,1] * det(M[c(2,3,4),1:3])*det(M[c(1,2),1:2]) + M[2,1] * det(M[c(3,4),1:2])*det(M[1:3,1:3]) [1] -0.4221082 > (-M[1,1] * det(M[2:4,1:3]) + M[2,1] * det(M[c(1,3,4),1:3])) * det(M[c(2,3),1:2]) [1] -0.4221082 > M[2,1]*det(M[c(1,3,4),1:3]) [1] -0.2134941 > M[1,1] * det(M[c(2,3,4),1:3]) + (-M[1,1]*det(M[c(2,3,4),1:3]) + M[2,1] * det(M[c(1,3,4),1:3])) [1] -0.2134941 > dOmega <- (-M[1,1]*det(M[c(2,3,4),1:3]) + M[2,1] * det(M[c(1,3,4),1:3])) > det(M[c(1,3),1:2]) * dOmega [1] -1.333752 > M[1,1]*det(M[c(3,4),1:2])*det(M[1:3,1:3]) + M[3,1] * det(M[1:2,1:2])*det(M[c(1,3,4),1:3]) [1] -1.333752
> B <- out$B.ext > B [,1] [,2] [,3] [1,] 0 1 -1 [2,] -1 0 1 [3,] 1 -1 0 [4,] 1 0 0 [5,] 0 -1 0 [6,] -1 0 1 [7,] 0 1 -1 [8,] 0 0 -1 [9,] 0 0 1 > B2 <- my.B.mut(B,3) > B2 [,1] [,2] [,3] [1,] 0 0 1 [2,] 0 0 -1 [3,] -1 1 0 [4,] 1 0 0 [5,] 0 -1 0 [6,] 0 0 -1 [7,] 0 0 1 [8,] 0 -1 1 [9,] 1 0 -1 > B3 <- my.B.mut(B2,1) > B3 [,1] [,2] [,3] [1,] 0 0 -1 [2,] 0 0 -1 [3,] 1 1 0 [4,] -1 0 1 [5,] 0 -1 0 [6,] 0 0 -1 [7,] 0 0 1 [8,] 0 -1 1 [9,] -1 0 0 > B4 <- my.B.mut(B3,3) > B4 [,1] [,2] [,3] [1,] 0 0 1 [2,] 0 0 1 [3,] -1 -1 0 [4,] 0 1 -1 [5,] 0 -1 0 [6,] 0 0 1 [7,] 1 1 -1 [8,] 1 0 -1 [9,] -1 0 0 > B5 <- my.B.mut(B4,2) > B5 [,1] [,2] [,3] [1,] 0 0 1 [2,] 0 0 -1 [3,] -1 1 0 [4,] 0 -1 0 [5,] 0 1 0 [6,] 0 0 1 [7,] 1 -1 0 [8,] 1 0 -1 [9,] -1 0 0