2012-11-19

積:グラフ代数

積
- デカルト積
  - グラフ $G=(U,E),H=(V,F)$ のデカルト積 $G \bigotimes H$ は、 $u \in U, v \in V$ の順序対 $(u,v)$ をノードとして、 $u---u' \in E$ のときには $\forall v, (u,v)---(u',v)$ を辺に持ち、また、 $v---v' \in F$ のときには $\forall u, (u,v)---(u,v')$ を辺に持つようなグラフ

# グラフ(とその隣接行列)を適当に作り
g1 <- make.graph.adj(5)
g2 <- make.graph.adj(4)

gr.dec.prod <- function(m1,m2){
	n1 <- length(m1[,1])
	n2 <- length(m2[,1])
	n <- n1*n2
	N <- as.matrix(expand.grid(1:n1,1:n2))
	M <- matrix(FALSE,n,n)
	for(i in 1:n){
		for(j in 1:n){
			if((N[i,1] == N[j,1]) & m2[N[i,2],N[j,2]]){
				M[i,j] <- TRUE
			}else if((N[i,2] == N[j,2]) & m1[N[i,1],N[j,1]]){
				M[i,j] <- TRUE
			}
		}
	}
	M
}
new.m <- gr.dec.prod(g1$m,g2$m)
gnew <- graph.adjacency(new.m,mode="undirected")
par(mfcol=c(2,2))
plot(g1$g)
plot(g2$g)
plot(gnew)

- ちょっと別のやり方も(他の積の定義との対応関係からは、下のやり方は良くない)

X <- matrix(c(0,1,1,1,0,0,1,0,0),byrow=TRUE,3,3)
Y <- matrix(c(0,1,1,1,0,1,1,1,0),byrow=TRUE,3,3)
prod.dec <- function(X,Y){
	dimX <- dim(X)
	dimY <- dim(Y)
	Z <- matrix(0,dimX[1]*dimY[1],dimX[1]*dimY[1])
	for(i in 1:dimY[1]){
		for(j in 1:dimY[1]){
			if(i == j){
				tmp <- X
			}else{
				if(Y[i,j] == 1){
					tmp <- diag(rep(1,dimX[1]))
				}else{
					tmp <- matrix(0,dimX[1],dimX[2])
				}
				
			}
			Z[(1:dimX[1])+(i-1)*dimX[1],(1:dimX[1])+(j-1)*dimX[1]] <- tmp
		}
	}
	Z
}
prod.dec(X,Y)

> prod.dec(X,Y)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    0    1    1    1    0    0    1    0    0
 [2,]    1    0    0    0    1    0    0    1    0
 [3,]    1    0    0    0    0    1    0    0    1
 [4,]    1    0    0    0    1    1    1    0    0
 [5,]    0    1    0    1    0    0    0    1    0
 [6,]    0    0    1    1    0    0    0    0    1
 [7,]    1    0    0    1    0    0    0    1    1
 [8,]    0    1    0    0    1    0    1    0    0
 [9,]    0    0    1    0    0    1    1    0    0

- - 格子

library(igraph)
P3 <- matrix(c(0,1,0,1,0,1,0,1,0),byrow=TRUE,3,3)
P4 <- matrix(c(0,1,0,0,1,0,1,0,0,1,0,1,0,0,1,0),byrow=TRUE,4,4)
Grid34 <- prod.dec(P3,P4)
plot(graph.adjacency(Grid34))

- - - 格子グラフの作り方はこちらにも
  - 円柱

C4 <- matrix(c(0,1,0,0,1,0,1,0,0,1,0,1,1,0,1,0),byrow=TRUE,4,4)
Cylind44 <- prod.dec(P4,C4)
plot(graph.adjacency(Cylind44))

- - トーラス

C3 <- matrix(c(0,1,1,1,0,1,1,1,0),byrow=TRUE,3,3)
Torus34 <- prod.dec(C3,C4)
plot(graph.adjacency(Torus34))

- 直積 direct product
  - $G \otimes H$ は、 $u \in U, v \in V$ の順序対 $(u,v)$ をノードとして、 $u---u' \in E$ かつ $v---v' \in F$ のときに、 $\forall v, (u,v)---(u',v)$ を辺に持つようなグラフ

gr.direct.prod <- function(m1,m2){
	n1 <- length(m1[,1])
	n2 <- length(m2[,1])
	n <- n1*n2
	N <- as.matrix(expand.grid(1:n1,1:n2))
	M <- matrix(FALSE,n,n)
	for(i in 1:n){
		for(j in 1:n){
			if(m1[N[i,1],N[j,1]] & m2[N[i,2],N[j,2]]){
				M[i,j] <- TRUE
			}
		}
	}
	M
}
new.m <- gr.direct.prod(g1$m,g2$m)
gnew <- graph.adjacency(new.m,mode="undirected")
par(mfcol=c(2,2))
plot(g1$g)
plot(g2$g)
plot(gnew)

- 強い積
  - $G \boxplus H$ は、 $u \in U, v \in V$ の順序対 $(u,v)$ をノードとして、 $G \square{H}$ の辺と $G \otimes H$ の辺とを辺に持つようなグラフ

gr.strong.prod <- function(m1,m2){
	m.dec <- gr.dec.prod(m1,m2)
	m.direct <- gr.direct.prod(m1,m2)
	m.dec | m.direct
}
new.m <- gr.strong.prod(g1$m,g2$m)
gnew <- graph.adjacency(new.m,mode="undirected")
par(mfcol=c(2,2))
plot(g1$g)
plot(g2$g)
plot(gnew)

- 奇数積
  - $G \bigtriangleup H$ は、 $u \in U, v \in V$ の順序対 $(u,v)$ をノードとして、 $u---u' \in E$ と $v---v' \in F$ とのどちらか片方のみが存在する(xorの関係)とき、 $\forall v, (u,v)---(u',v)$ を辺に持つようなグラフ

gr.odd.prod <- function(m1,m2){
	n1 <- length(m1[,1])
	n2 <- length(m2[,1])
	n <- n1*n2
	N <- as.matrix(expand.grid(1:n1,1:n2))
	M <- matrix(FALSE,n,n)
	for(i in 1:n){
		for(j in 1:n){
			if(xor(m1[N[i,1],N[j,1]],m2[N[i,2],N[j,2]])){
				M[i,j] <- TRUE
			}
		}
	}
	M
}
new.m <- gr.odd.prod(g1$m,g2$m)
gnew <- graph.adjacency(new.m,mode="undirected")
par(mfcol=c(2,2))
plot(g1$g)
plot(g2$g)
plot(gnew)

- 辞書式順序の積
  - $G \circ H$ は、 $u \in U, v \in V$ の順序対 $(u,v)$ をノードとして、 $u---u' \in E$ のとき $(u,v)---(u',v')$ に辺をもち、 $v---v' \in F$ とき、 $(u,v)---(u,v')$ に辺を持つようなグラフ。 $G,H$ の順序の影響の出方に注意

gr.lexico.prod <- function(m1,m2){
	n1 <- length(m1[,1])
	n2 <- length(m2[,1])
	n <- n1*n2
	N <- as.matrix(expand.grid(1:n1,1:n2))
	M <- matrix(FALSE,n,n)
	for(i in 1:n){
		for(j in 1:n){
			if(m1[N[i,1],N[j,1]]){
				M[i,j] <- TRUE
			}else if(N[i,1]==N[j,1] & m2[N[i,2],N[j,2]]){
				M[i,j] <- TRUE
			}
		}
	}
	M
}
new.m <- gr.lexico.prod(g1$m,g2$m)
gnew <- graph.adjacency(new.m,mode="undirected")
par(mfcol=c(2,2))
plot(g1$g)
plot(g2$g)
plot(gnew)

べき乗？？フラクタル様(自作)

gr.fractal.prod <- function(m,d){
	M <- list()
	M[[1]] <- m
	n <- length(m[,1])
	if(d > 1){
		for(i in 2:d){
			n2 <- length(M[[i-1]][,1])
			M[[i]] <- matrix(0,n*n2,n*n2)
			for(j in 1:n){
				M[[i]][(1+n2*(j-1)):(n2*j),(1+n2*(j-1)):(n2*j)] <- M[[i-1]]
				for(j2 in 1:n){
					if(j2 != j){
						if(m[j,j2] == 1){
							M[[i]][(1+n2*(j-1)):(n2*j),(1+n2*(j2-1)):(n2*j2)] <- diag(rep(1,n2))
						}
					}
				}
			}
			
		}
	}
	M
}

m <- matrix(c(0,1,1,0,0,0,1,0,0,0,0,1,0,0,0,0),4,4)
d <- 4
g.fr <- gr.fractal.prod(m,d)

par(ask = TRUE)
for(i in 1:d){
	plot(graph.adjacency(g.fr[[i]]))
}