べたべたになぞってみる - ryamadaのコンピュータ・数学メモ

ZDDは組み合わせの圧縮表現
Simpathはグラフの経路全網羅のためのZDD構築のアルゴリズム(こちら)
アルゴリズムの説明をしてもらったけれど、どうやるのだか分らなかったのでRで、べたべたに書いてみることにする

グラフ $G=\{V,E\}$ がある
$v_1=x_{start}, v_{target} \in V$ を定める
$E=\{e_1,e_2,...,e_{n}$ とエッジに順序を定める
処理はすべてのエッジについてループを回す
エッジを処理するごとにその処理段階ごとに「検討するべき状態」を決める
- 「検討するべき状態」についてループを回す
- 「検討するべき状態」からは、処理対象のエッジを加えるか加えないかの２つの「状態」が次の段階の「検討するべき状態」の候補として挙がる
- ただし、このままだと、「検討するべき状態」が倍々で増えてしまうので、以下をして「状態」を減らす
  - (1)スタートからターゲットに到達したら、その状態については、以降の処理はしないので「検討するべき状態」には加えない
  - (2)エッジを増やしても、経路として不適当(枝分かれ)だったら、以降の処理はしないので「検討するべき状態」には加えない
  - (3)それ以外の場合は「mate」という条件に照らして、同じ場合は、「検討するべき状態」として同じなので、まとめる。ただし、考慮するべきは、線状になっている部分の両端で、かつ、それ以降に処理する予定のエッジがつながる可能性のあるノードについてのmate条件のみ。それをfrontierと言う。その説明の図を頂戴しました(下図)

全部のエッジの処理が済んだら、「最終的に経路になったもの」は「経路」とし、「最終的に経路とならなかったもの」は、「不採用」
「最後の不採用」の結果、ZDD的に省略できる枝は、刈り込む。刈り込むにあたって、処理した順番が後の方のエッジの方から刈り込んでいく(たぶんこれは最後にやるのだと思う…)
これらを「きれいに」書くのが目標だが、「きれいに」書くと、後で読んでわからなくなるのが目に見えているので、べたべたに書く
まずは、小さいグラフを作ろう(ここは大きすぎなければどうでもよい)

# ノード数
n.v <- 5
# エッジを適当に発生させて
n.e <- sample((n.v+1):(n.v*(n.v-1)/2),1)
e.list <- cbind(sample(1:n.v,n.e,replace=TRUE),sample(1:n.v,n.e,replace=TRUE))
e.list <- e.list[which(e.list[,1]!=e.list[,2]),]
e.list
# igraphパッケージのグラフオブジェクトにしておく
library(igraph)
g <- graph.edgelist(e.list,directed=FALSE)
m <- (sign(as.matrix(get.adjacency(g))))
m[upper.tri(m)] <- 0
g <- graph.adjacency(m,mode="undirected")
e.list <- get.edgelist(g)

さあやろう

# スタートは１番ノードで決め打ち
# ゴールは適当に選ぶ
goal <- sample(2:n.v,1)
goal

# フロンティアはmate値が自身と異なり、かつ、未処理エッジに接続しているノード
# フロンティアの候補は、エッジの処理が進むにつれて減る
frontiers <- list()
for(i in 1:length(e.list[,1])){
	frontiers[[i]] <- sort(unique(c(e.list[i:length(e.list[,1]),])))
}

# P,Pnew,tmp.Pnewはそれぞれmate状態を格納するリスト
# Pは「処理するべき状態」のリスト
# 「処理するべき状態」にあるエッジを足すか足さないか、の２通りをtmp.Pnewとして扱って
# 次世代に回すか回さないかの判断をする
# 回すとなったら、Pnewに格納する
# Pnewにすでに登場しているかどうかも次世代へ回すか否かの判断に使うので、これを「すべての」「処理するべき状態」について更新して、全部の「状態」が終わったら更新する
P <- Pnew <- tmp.Pnew <- list()
fr.Pnew <- fr.tmp.Pnew <- list()
# 初期状態はエッジがまったく処理されていない状態
P[[1]] <- matrix(rep(1:n.v,2),nrow=2,byrow=TRUE)
# ZDD.edgeは、「状態」を更新しながら、だんだんに段階が下っていき、「処理するべき状態」に相当するノードが増えていくが、それらの関係を分岐木(エッジを加えたか加えなかったかの情報を持たせたエッジでつなげたグラフのエッジ情報
# ただし、５列の情報のうち、左２列は「処理するべき状態」の「世代」と「世代内ID」、次の２列が、「次世代の処理するべき状態」の「世代」と「世代内ID」、最右の列は、エッジを加える処理か、加えない処理化の区別
ZDD.edge <- matrix(NA,0,5)
# matesは本当に記憶するべき状態は少ないのだが、ここでは「べたべた」にするために、元のグラフのすべてのノードについて、記憶しておく
# 2行n.v列の行列
# すでにエッジ加え処理で取り込まれていて、その線状グラフの末端のノードは逆末端のノードIDを第２行に登録し、すでに通過済みで末端でないノードは0、未処理はノードIDそのまま
mates <- matrix(NA,0,n.v*2)
# ZDDの最終ステップは、エッジ本数の段階の後なので、その段階を「最終段」として数値化しておく
row.goal <- length(e.list[,1])+2
# エッジを処理する
for(i in 1:length(e.list[,1])){
# 処理中のエッジの接続ノードID２個
	tmp.edge <- e.list[i,]
	print("current edge is ")
	print(tmp.edge)
	id <- 0
# すべての「処理すべき状態」のループ
	if(length(P) > 0){
		for(j in seq(P)){
	# 処理するべき状態のmateを確認
			print(P[[j]])
			#if(P[[j]][2,1]==goal){
				# 終わっている
				print("reached")
			#}else{
	# 扱うエッジが接続する２ノードのmate状態をとりだす
				a <- P[[j]][,tmp.edge[1]]
				b <- P[[j]][,tmp.edge[2]]
				# to add
	# エッジを加える場合
	# どちらか片方でも「線状グラフの途中」であるなら、a[2]*b[2]=0であり
	# その場合は、「枝分かれ」することを意味し、これ以上やっても仕方ない
				if(a[2]*b[2]==0){
					# 枝分かれ
					print("branching")
	# 最終的に、ZDDの「だめ〜0」のノードへ連結する
					ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,0,1))
					mates <- rbind(mates,c(P[[j]][2,],rep(0,n.v)))
				}else{
	# 枝分かれしないなら、加えて、mateを更新しておく
					print("add edge")
					id <- length(Pnew)+1
					tmp.Pnew[[1]] <- P[[j]]
					x <- a[2]
					y <- b[2]
					z <- P[[j]][,x]
					w <- P[[j]][,y]
					print("z=")
					print(z)
					print("w=")
					print(w)
					tmp.Pnew[[1]][2,a[1]] <- tmp.Pnew[[1]][2,b[1]] <- 0
	# ここの場合分けは不要なのだと思う…
					if(z[1]-z[2]!=0){
						#tmp.Pnew[[1]][2,z[1]] <- w[2]
						tmp.Pnew[[1]][2,z[1]] <- w[1]
					}else{
						tmp.Pnew[[1]][2,z[1]] <- w[1]
					}
					if(w[1]-w[2]!=0){
						#tmp.Pnew[[1]][2,w[1]] <- z[2]
						tmp.Pnew[[1]][2,w[1]] <- z[1]
					}else{
						tmp.Pnew[[1]][2,w[1]] <- z[1]
					}
					print(tmp.Pnew[[1]])
	# エッジを加えた状態が次世代の「処理するべき状態」かどうかは、できたmateがこれまでに登録されていない場合に限るので、それを確認する
					id.incl <- FALSE
	# エッジを加えて、経路が完成していたら、「次世代」には回さずに、「完成〜1」のZDDノードにつなぐ
	# すべてのエッジの処理が終わった段階で、未決の場合は、「経路にならなかった」ことを意味するので「だめ〜0」につなぐ
					if(tmp.Pnew[[1]][2,1] == goal){
						print("goal")
						ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,1,1))
						mates <- rbind(mates,c(P[[j]][2,],rep(1,n.v)))
					}else if(length(which(tmp.Pnew[[1]][2,frontiers[[i]]]==1)) < 1){
						# frontierに1がつながらないなら、もうアウト
						ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,0,1))
						mates <- rbind(mates,c(P[[j]][2,],rep(0,n.v)))
					}else{
						if(i == length(e.list[,1])){
							ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,0,1))
							mates <- rbind(mates,c(P[[j]][2,],rep(0,n.v)))
						}else{
	# frontierのmate状態が「新し」ければ、Pnewに付け加えて、それをZDDの次世代ノードとして、それとつなぐ
	# frontierのmate状態が「古」ければ、その既存のZDDノードを確認してそれにつなぐ
							sameMate <- id
							for(k in seq(Pnew)){
								if(sum((Pnew[[k]][2,frontiers[[i]]]-tmp.Pnew[[1]][2,frontiers[[i]]])^2)==0){
									sameMate <- k
								}
							}
							if(sameMate == id){
								Pnew[[length(Pnew)+1]] <- tmp.Pnew[[1]]
								id.incl <- TRUE
							}
							ZDD.edge <- rbind(ZDD.edge,c(i,j,i+1,sameMate,1))
							mates <- rbind(mates,c(P[[j]][2,],tmp.Pnew[[1]][2,]))
						}
						
					}
				}
	# エッジを加えない場合
	# mateの更新はない(考慮するべきfrontierは変わる)
	# 「次世代」に回すかを判断し、しかるべく次世代ノードとつなぐ
	# 全エッジの処理がおわって「ダメ〜0」へつなぐ必要も判断
				# to ignore
				print("not add edge")
				if(id.incl){
					id <- id+1
				}else{
					id <- id
				}
				tmp.Pnew[[1]] <- P[[j]]
				if(length(which(tmp.Pnew[[1]][2,frontiers[[i]]]==1)) < 1){
					# frontierに1がつながらないならアウト
					ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,0,1))
					mates <- rbind(mates,c(P[[j]][2,],rep(0,n.v)))
				}else if(i == length(e.list[,1])){
					ZDD.edge <- rbind(ZDD.edge,c(i,j,row.goal,0,0))
					mates <- rbind(mates,c(P[[j]][2,],rep(0,n.v)))
				}else{
					sameMate <- id
					for(k in seq(Pnew)){
						if(sum((Pnew[[k]][2,frontiers[[i]]]-tmp.Pnew[[1]][2,frontiers[[i]]])^2)==0){
							sameMate <- k
						}
					}
					if(sameMate == id){
						Pnew[[length(Pnew)+1]] <- tmp.Pnew[[1]]
					}
					ZDD.edge <- rbind(ZDD.edge,c(i,j,i+1,sameMate,0))
					mates <- rbind(mates,c(P[[j]][2,],tmp.Pnew[[1]][2,]))
				}
				
				#print(Pnew[[1]])
			#}

		}
	# 次世代のために「処理するべき状態」を更新
		print("renew P")
		P <- Pnew
		Pnew <- list()

	}
}

# ZDD(５列の行列)を使って描図する(igraphのグラフオブジェクトを使う)
draw.dd <- function(dd){
	nodes.1 <- paste(dd[,1],dd[,2],sep=".")
	nodes.2 <- paste(dd[,3],dd[,4],sep=".")
	e.list <- cbind(nodes.1,nodes.2)
	g <- graph.edgelist(e.list)
	E(g)$color <- dd[,5]+1
	#g <- set.edge.attribute(g,"color",dd[,5]+1)
	plot(g)
	#coords <- rbind(dd[,1:2],dd[,3:4])
	#plot(coords)
	#segments(dd[,1],dd[,2],dd[,3],dd[,4],col=dd[,5]+1)
}
# ZDD(５列の行列)を使って、世代ごとにノードが並ぶように描図
draw.dd.2 <- function(dd,mates){
	#nodes.1 <- paste(dd[,1],dd[,2],sep=".")
	#nodes.2 <- paste(dd[,3],dd[,4],sep=".")
	#e.list <- cbind(nodes.1,nodes.2)
	#g <- graph.edgelist(e.list)
	#E(g)$color <- dd[,5]+1
	#g <- set.edge.attribute(g,"color",dd[,5]+1)
	#plot(g)
	dd.2 <- -dd
	dd.2[,5] <- -dd.2[,5]
	dd.2[,c(2,4)]
	coords <- rbind(dd.2[,2:1],dd.2[,4:3])
	plot(coords)
	segments(dd.2[,2],dd.2[,1],dd.2[,4],dd.2[,3],col=dd.2[,5]+1)
	labels <- rbind(mates[,1:n.v],mates[,(n.v+1):(n.v*2)])
	labels2 <- rep(NULL,length(labels[,1]))
	for(i in 1:length(labels[1,])){
		labels2 <- paste(labels2,labels[,i],sep=".")
	}
	text(coords+0.1,labels2)
}
par(mfcol=c(2,2))
node.col <- rep(0,n.v)
node.col[1] <- 2
node.col[goal] <- 3
V(g)$color <- node.col
plot(g)
draw.dd(ZDD.edge)
draw.dd.2(ZDD.edge,mates)
# エッジの処理順を見ながら、うまく行っているかどうか、も見てみよう
e.list