整理し直す:組み合わせの団代数、flag minor

  • 資料はこちら:

https://arxiv.org/pdf/1005.1086.pdf

  • 素数nの集合の部分集合の族から全体と空集合を除くと、\{\{1\},\{2\},...,\{n\},\{1,2\},..,\{2,3\},...,\{n-1,n\},...,\{1,...n-1\},\{2,...,n\}\}となり、その要素数2^n-2
  • これのflag minorを考える
    • flag minorとは、行が、部分集合、列は、元の行列の左詰めの列になったような正方行列の行列式のこと
  • 今、{1},{1,2},...,{1,2,...,n-1}{n},{n-1,n},...,{2,...,n}とをFrozen とし、それ以外をMutableとする
  • Frozenは常に現れ、Mutableは一部(\frac{(n-1)(n-2)}{2}個だけが現れるような箙をつくると
  • Mutableのうちの1つを入れ替えて別のMutableに変異させることができる
  • これをやるために、ちょっと工夫が必要で、1要素\Omegaを加える。これはオリジナルの行列の行列式ではなく-\Delta_1 \Delta_{2,3,...,n} + \Delta_2 \Delta_{1,3,...n}とないう特殊な形をしているが、それさえ許せば団代数になる
  • Flag minorの間には、\Delta_A \Delta_B = \prod_{E(i -> A) exists} \Delta_i + \prod_{E(A -> i) exists} \Delta_iという関係がある
  • 文章で書いてもわかりにくいので絵で描く

f:id:ryamada:20210301105500p:plain
f:id:ryamada:20210301105513p:plain
f:id:ryamada:20210301105523p:plain

  • 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