階層化
- ノードとエッジからできたものが全体グラフの中でサブグラフになる
- このサブグラフもノードとして扱いたい
- サブグラフはノードの集合とエッジの集合の組でできている(グラフはノード集合とエッジ集合の組)
- このサブグラフをノードに帰属させるには、ノード集合とエッジ集合とにエッジを下したノードを作ることで可能だが、その前に、すべてのエッジはノード扱いできるようにする必要がある
- 言い換えると、ノード集合とエッジ集合を作るときにエッジの集合もノード集合とする(ただしこのノードは本来のノード2つにエッジを伸ばした、次数2に限定したノード)こととし、このノード集合をエッジがノード化したノード集合を作り、その上でサブグラフに相当するノードからは、エッジがノード化したノード(と、もしあれば、サブグラフに帰属する次数0のノード(サブグラフ上で連結していないノード)にエッジを下ろすものとする
- こうすれば、ノード・エッジに関してサブグラフによる取りまとめができ、さらにこのサブグラフに対応するノードを要素とするサブグラフを従えたサブグラフも作れそうだ
- やってみよう
- こんな「メタな知識」をファイル"メタ正単体.txt"で受け取る
- ファイル名がメタな知識につけられた名前であり、そんなメタな知識同士(正単体.txtと双対.txt)同士を結んだり、メタな知識(正単体.txt)と単なる用語知識("完全グラフ")とを結んだりできる
正単体.txt 双対.txt 正単体.txt 完全グラフ
setwd("C:\\Users\\ryamada\\Desktop\\20121214入力ノート") library(igraph) #infiles <- c("正単体.txt","双対.txt","序数.txt","グラフ理論.txt","集合.txt","数.txt","複体.txt") infiles <- c("正単体.txt","双対.txt","グラフ理論.txt","メタ正単体.txt") infile.list <- list() for(i in 1:length(infiles)){ infile.list[[i]] <- read.table(infiles[i], sep = "\t", fill =TRUE) } g <- graph.empty(directed=FALSE) g.plus <- graph.empty(directed=FALSE) v.list <- list() v.plus.list <- list() e.list <- list() e.plus.list <- list() for(i in 1:length(infile.list)){ infile <- infile.list[[i]] # 行列の方が好きなので行列にする infile.m <- as.matrix(infile) # エッジに関係するところだけを取り出す infile.m <- infile.m[,1:length(infile.m[1,])] # ノードをユニークにする unique.word <- unique(c(infile.m)) unique.word <- unique.word[which(unique.word != "")] # ノードの名前に順序idをつける v.list[[i]] <- NULL v.list[[i]] <- unique.word e.list[[i]] <- matrix(0,0,2) v.plus.list[[i]] <- unique.word e.plus.list[[i]] <- matrix(0,0,2) #g <- g + vertices(v.name) # 行ごとに要素数を数えて for(j in 1:length(infile.m[,1])){ num.kids <- length(which(infile.m[j,] != ""))-1 if(num.kids>=1){ for(k in 1:num.kids){ #g <- g + edges(c(infile.m[i,1],infile.m[i,j+1])) e.list[[i]] <- rbind(e.list[[i]],c(infile.m[j,1],infile.m[j,k+1])) } } } sorted.e.list <- t(apply(e.list[[i]],1,sort)) tmp.v <- paste(sorted.e.list[,1],sorted.e.list[,2],sep="") v.plus.list[[i]] <- c(unique.word,infiles[i],tmp.v) v.plus.list[[i]] <- unique(v.plus.list[[i]]) #e.plus.list[[i]] <- e.list[[i]] for(j in 1:length(e.list[[i]][,1])){ e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(e.list[[i]][j,1],tmp.v[j])) e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(e.list[[i]][j,2],tmp.v[j])) e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(tmp.v[j],infiles[i])) } #plot(g,vertex.label=V(g)$name) } unique.v <- unique(unlist(v.list)) unique.plus.v <- unique(unlist(v.plus.list)) g <- graph.empty(directed=FALSE) + vertices(unique.v) g.plus <- graph.empty(directed=FALSE) + vertices(unique.plus.v) for(i in 1:length(infile.list)){ for(j in 1:length(e.list[[i]][,1])){ g <- g + edges(e.list[[i]][j,]) } for(j in 1:length(e.plus.list[[i]][,1])){ g.plus <- g.plus + edges(e.plus.list[[i]][j,]) } } plot(g,vertex.label=V(g)$name,vertex.size=3,edge.arrow.mode=0) dev.new() plot(g.plus,vertex.label=V(g.plus)$name,vertex.size=3,edge.arrow.mode=0)
- ごちゃごちゃしてきてどうなっているのかわかりにくいのでサブクラスをまとめるノード(入力ファイル名のノード)のあたりのみを表示させる(一部を表示させる機能で)
# 2点を指定して、その最短パスを求め、その周囲だけを表示する two <- c("正単体.txt","完全グラフ") sh.paths <- get.shortest.paths(g.plus,two[1],two[2]) sh.paths.mat <- shortest.paths(g.plus) lay <- layout.kamada.kawai(g) Ls <- 0:1 par(ask=TRUE) for(i in seq(Ls)){ L <- Ls[i] tmp <- (sh.paths.mat[unlist(sh.paths),] <= L) neighbors <- sign(apply(tmp,2,sum)) tmp.g <- induced.subgraph(g.plus,which(neighbors==1)) plot(tmp.g,vertex.label=V(tmp.g)$name,vertex.size=3,edge.arrow.mode=0,layout=lay[which(neighbors==1),]) }
一部は修正項目かもしれないから、これはx6相当
- 知識が増えてくると、そのすべてを常に使っているわけではないようだ
- 2つの用語が何か関係していそうだけれど、どうしてそう思うのか?と考える
- ひとまず2つの用語を選ぶ
- ついでその2用語ノードをつないでみる
- つなぐときには最短距離にしよう
- 最短距離のパスの周囲に着目してみよう
- 取り出しには、「最短パス」「最短パス上のノード集合」「最短パス上のノード集合から、指定距離にあるノードの集合「指定ノードの作るサブグラフ」ができればよい
# 2点を指定して、その最短パスを求め、その周囲だけを表示する two <- c("双対","部分集合") sh.paths <- get.shortest.paths(g,two[1],two[2]) sh.paths.mat <- shortest.paths(g) lay <- layout.kamada.kawai(g) Ls <- 0:10 par(ask=TRUE) for(i in seq(Ls)){ L <- Ls[i] tmp <- (sh.paths.mat[unlist(sh.paths),] <= L) neighbors <- sign(apply(tmp,2,sum)) tmp.g <- induced.subgraph(g,which(neighbors==1)) plot(tmp.g,vertex.label=V(tmp.g)$name,vertex.size=3,edge.arrow.mode=0,layout=lay[which(neighbors==1),]) }
表示出力を関数化する
# 全ノードの最短距離は求めておく sh.paths.mat <- shortest.paths(g.plus) # その上で、 show.neighbors <- function(g,vs,L=1){ tmp <- (sh.paths.mat[vs,] <= L) if(length(vs)>1){ neighbors <- sign(apply(tmp,2,sum)) }else{ neighbors <- sign(tmp) } tmp.g <- induced.subgraph(g,which(neighbors==1)) plot(tmp.g,vertex.label=V(tmp.g)$name,vertex.size=3,edge.arrow.mode=0) } # グラフ全体g.plusにおいてある点と距離1以内にあるノードで構成されたサブグラフを表示する show.neighbors(g.plus,c("ベクトル空間"),L=1) # 複数ノードを指定して、そのノード集合からの距離が指定距離以内のノードで構成されたサブグラフを表示する show.neighbors.series <- function(g.plus,vs,Ls=0:4){ par(ask=TRUE) for(i in Ls){ show.neighbors(g.plus,vs,L=i) } par(ask=FALSE) } # 2ノードを指定して、その最短パスのノード列を列挙し、 two <- c("複体","直積") sh.paths <- get.shortest.paths(g.plus,two[1],two[2]) # そのパスのノードをノード集合として、近隣ノードのサブグラフを表示する show.neighbors.series(g.plus,unlist(sh.paths),Ls=0:7)
入力追加が簡単にできることの実装確認2
- フォルダ内に入力ファイルを入れておき、それを全部取り出して、グラフ化する
- list.files()関数を使えば、あるフォルダを指定して、そこに入力ファイルを置いておけば、全ファイルを取り出してくれる
setwd("hogePATH") library(igraph) infiles <- list.files() infile.list <- list() for(i in 1:length(infiles)){ infile.list[[i]] <- read.table(infiles[i], sep = "\t", fill =TRUE) } g <- graph.empty(directed = FALSE) g.plus <- graph.empty(directed = FALSE) v.list <- list() v.plus.list <- list() e.list <- list() e.plus.list <- list() for(i in 1:length(infile.list)){ infile <- infile.list[[i]] # 行列の方が好きなので行列にする infile.m <- as.matrix(infile) # エッジに関係するところだけを取り出す #infile.m <- infile.m[,1:length(infile.m[1,])] # ノードをユニークにする unique.word <- unique(c(infile.m)) unique.word <- unique.word[which(unique.word != "")] # ノードの名前に順序idをつける v.list[[i]] <- NULL v.list[[i]] <- unique.word e.list[[i]] <- matrix(0,0,2) v.plus.list[[i]] <- unique.word e.plus.list[[i]] <- matrix(0,0,2) #g <- g + vertices(v.name) # 行ごとに要素数を数えて for(j in 1:length(infile.m[,1])){ num.kids <- length(which(infile.m[j,] != ""))-1 if(num.kids>=1){ for(k in 1:num.kids){ #g <- g + edges(c(infile.m[i,1],infile.m[i,j+1])) e.list[[i]] <- rbind(e.list[[i]],c(infile.m[j,1],infile.m[j,k+1])) } } } sorted.e.list <- t(apply(e.list[[i]],1,sort)) tmp.v <- paste(sorted.e.list[,1],sorted.e.list[,2],sep="") v.plus.list[[i]] <- c(unique.word,infiles[i],tmp.v) v.plus.list[[i]] <- unique(v.plus.list[[i]]) #e.plus.list[[i]] <- e.list[[i]] for(j in 1:length(e.list[[i]][,1])){ e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(e.list[[i]][j,1],tmp.v[j])) e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(e.list[[i]][j,2],tmp.v[j])) e.plus.list[[i]] <- rbind(e.plus.list[[i]],c(tmp.v[j],infiles[i])) } #plot(g,vertex.label=V(g)$name) } unique.v <- unique(unlist(v.list)) unique.plus.v <- unique(unlist(v.plus.list)) g <- graph.empty(directed=FALSE) + vertices(unique.v) g.plus <- graph.empty(directed=FALSE) + vertices(unique.plus.v) for(i in 1:length(infile.list)){ for(j in 1:length(e.list[[i]][,1])){ g <- g + edges(e.list[[i]][j,]) } for(j in 1:length(e.plus.list[[i]][,1])){ g.plus <- g.plus + edges(e.plus.list[[i]][j,]) } } plot(g,vertex.label=V(g)$name,vertex.size=3,edge.arrow.mode=0) dev.new() plot(g.plus,vertex.label=V(g.plus)$name,vertex.size=3,edge.arrow.mode=0)
入力追加が簡単にできることの実装確認
- 複数のファイルを指定して、それらのすべての「のべ」として入力
- ファイル名のリストを与える
- すべてのファイルをR上の行列オブジェクトとする
- その上で、すべての行列オブジェクトの「のべ」のノードのグラフを作り、
- エッジを追加する
infiles <- c("正単体.txt","双対.txt","序数.txt","グラフ理論.txt","集合.txt","数.txt","複体.txt") infile.list <- list() for(i in 1:length(infiles)){ infile.list[[i]] <- read.table(infiles[i], sep = "\t", fill =TRUE) } g <- graph.empty() v.list <- list() e.list <- list() for(i in 1:length(infile.list)){ infile <- infile.list[[i]] # 行列の方が好きなので行列にする infile.m <- as.matrix(infile) # エッジに関係するところだけを取り出す infile.m <- infile.m[,1:length(infile.m[1,])] # ノードをユニークにする unique.word <- unique(c(infile.m)) unique.word <- unique.word[which(unique.word != "")] # ノードの名前に順序idをつける v.list[[i]] <- NULL v.list[[i]] <- unique.word e.list[[i]] <- matrix(0,0,2) #g <- g + vertices(v.name) # 行ごとに要素数を数えて for(j in 1:length(infile.m[,1])){ num.kids <- length(which(infile.m[j,] != ""))-1 if(num.kids>=1){ for(k in 1:num.kids){ #g <- g + edges(c(infile.m[i,1],infile.m[i,j+1])) e.list[[i]] <- rbind(e.list[[i]],c(infile.m[j,1],infile.m[j,k+1])) } } } #plot(g,vertex.label=V(g)$name) } unique.v <- unique(unlist(v.list)) g <- graph.empty() + vertices(unique.v) for(i in 1:length(infile.list)){ for(j in 1:length(e.list[[i]][,1])){ g <- g + edges(e.list[[i]][j,]) } } plot(g,vertex.label=V(g)$name,vertex.size=3,edge.arrow.mode=0)
- 入力ファイルはテキストファイルで次の通り
- "正単体.txt"
正単体 正単体 正三角形 正四面体 正五胞体 正多胞体 正n胞体 点 0次元 正単体 線分 1次元 正単体 正三角形 2次元 正四面体 3次元 正五胞体 4次元 正n胞体 n−1次元 頂点 辺 グラフ 頂点 グラフ 辺 ファセット n−1次元 超単体 ファセット 頂点 辺 面 n−1次元ファセット 双対 双対 頂点 n−1次元ファセット 0次元 0 1次元 1 n次元 n n−1次元 n-1
-
- "双対.txt"
双対 裏返し 双対 数学 物理学 双対 正多面体 グラフ 論理 ベクトル空間 アーベル群 圏 双対 問題 定理 双対 電気 磁気 双対 同型 準同型 準 同型 アーベル群 アーベル 群 体 係数体 体 線形写像 双対空間 双対 空間 ベクトル空間 線形写像 双対ベクトル空間 双対群 双対 群 アーベル群 コンパクト群 コンパクト群 コンパクト 群 双対 直積 直和 双対 極限 余極限 双対 電場 磁場 ローレンツ変換 電場 磁場 特殊相対性理論 双対 電場 磁場 || --"序数.txt" >|| 0 1 1 2 2 3 3 n n ∞ 3 n-1 n-1 n
-
- "グラフ理論.txt"
グラフ 頂点 辺 グラフ 集合 グラフ 有向グラフ 無向グラフ グラフ 重みつきグラフ グラフ 接合 隣接 グラフ 距離 直径 グラフ ループ 多重 グラフ 部分グラフ 親グラフ グラフ ウォーク サイクル グラフ 完全グラフ クリーク 部分グラフ 部分 完全グラフ 完全
-
- "集合.txt"
集合 集合 部分集合 冪集合 部分集合 部分 集合 元 要素 集合 写像 集合 系 族 数 文字 記号 集合 濃度 直積集合 集合 直積 集合 帰属 包含 定義 内包的定義 外延的定義 集合 空集合 濃度 充填 空間充填 充填 空間充填曲線 充填曲線 曲線 線 充填曲線 充填 曲線 集合 有限集合 無限集合 有限 無限 無限 ∞ 集合演算 集合 演算 集合演算 和集合 積集合 差集合 対称差 指示関数 和集合 結び 結合 積集合 交わり 交差 集合 商 類別
-
- "数.txt"
数 数 自然数 整数 有理数 実数 複素数 四元数 グロタンディーク宇宙
-
- "複体.txt"
複体 単体 複体 頂点集合 部分集合 族 頂点集合 頂点 集合 組合せ論 複体 頂点 面 準同型 順序集合 集合 順序 順序同型 順序 同型 順序集合 単体的 単体的 単体 的 単体写像 複体の準同型 複体の射 複体の射 複体 写像 単体写像 単体 写像 単体同型 全単射 単体同型 単体 同型 単体同型 位相同型 位相同型 位相 同型
シンプルな入力の実装確認
- 以下の3通りを基本的な入力として実装する
- テキストファイルを引数として入力
- 用語を1つのノードとして入力
- 用語のペアをエッジに結ばれたノード2個として入力
- ある用語が複数の用語と星形グラフになるように入力
- 次の記事のループの内側がその処理
視覚化
- Rではigraphパッケージを使ってグラフオブジェクトを扱ってみる
- igraphパッケージのグラフ表示機能はあまり協力ではなく、適当なグラフ書式でファイル書きだしをしたうえで、グラフ視覚化アプリケーションを使うという手もある
- とはいえ、「シンプル・素朴」、とにかく「簡単」を目指すのであれば、R内でそれなりに見える方がよい
- そのあたりの調査をしてみる
# igraphパッケージのインストールと読み込み install.packages("igraph") library(igraph)
- グラフオブジェクトの作成
# 10 vertices named a,b,c,... and no edges g <- graph.empty() + vertices(letters[1:10]) # Add edges to make it a ring g <- g + path(letters[1:10], letters[1], color="grey") # Add some extra random edges g <- g + edges(sample(V(g), 10, replace=TRUE), color="red") g$layout <- layout.circle if (interactive()) { plot(g) } # The old-style operations g <- graph.ring(10) add.edges(g, c(2,6,3,7) ) delete.edges(g, E(g, P=c(1,10, 2,3)) ) delete.vertices(g, c(2,7,8) )
- グラフオブジェクトの描図にて、ラベル名が操作できないとつらいのでそれの確認
# 日本語フォントも使いたい # 陽本語フォントも使いたい members <- c("竜畑","滋賀腹","陽笠","葵井","竜本","櫓本","腹","粒","町上","堀皮","車(雀)","車(住)","小皮","竹顔","開賀","畑町","玉壁","成畑","皮口") g <- graph.empty() + vertices(members) path.stat.kiso <- c("竜畑","滋賀腹","畑町","町上","陽笠","小皮","成畑","竜本","車(住)","車(雀)","葵井","竜畑") path.stat.ronbun <- c("陽笠","滋賀腹","成畑","葵井","皮口","町上","車(住)","車(雀)","竜畑","陽笠") path.R.kiso <- c("滋賀腹","成畑","陽笠","腹","葵井","堀皮","竹顔","町上","竜畑","竜本","車(雀)","車(住)","小皮","粒","滋賀腹") path.math <- c("櫓本","小皮","玉壁","畑町","竹顔","開賀","車(住)","竜畑","櫓本") # ノードの属性を呼びだす関数V()、呼びだした後、そのうち"$name"で選択的に取り出す plot(g,vertex.label=V(g)$name) g <- g + path(path.stat.kiso,color="red") g <- g + path(path.stat.ronbun,color="blue") g <- g + path(path.R.kiso,color="green") g <- g + path(path.math,color="pink") plot(g,vertex.label=V(g)$name)
- igraphオブジェクトを書きだして、他のアプリケーションで使うために
help(write.graph)