グラフから「交通の要所」を絵にする

  • ちょっと退屈しのぎ
  • 一端グラフが出来上がったら、「大事なノード」と「大事なエッジ」は、すべてのノード間の最短パスがどれくらい使うか、で評価してもよさそう
  • クラウドからドロネー図を作り、そのグラフでそんな「要所」評価をしてみます
  • この後、エッジの重要度をその建設コスト(長さ)と照らして、工事のプライオリティが決まる、というのが、群衆知の取る戦略になりそうで、それは、粘菌とかのモデル化にも使えそうで、今やっているのは非線形データの特徴づけであるところが本音だけれど、そこにも同様に表れるのではないか…、と。




n <- 1000
t <- rnorm(n)
t <- t/(max(abs(t))) * pi
x <- cos(t)
y <- sin(t)
x. <- x + rnorm(n,0,0.05)
y. <- y + rnorm(n,0,0.05)
plot(x.,y.)

X <- cbind(x.,y.)
library(geometry)

delaunay.X <- delaunayn(X)
plot(X)
delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2])

library(igraph)
g <- graph.edgelist(delaunay.X.2,directed =FALSE)
plot(g)
n.e <- length(delaunay.X.2[,1])
e.weight <- sqrt(apply((X[delaunay.X.2[,1],]-X[delaunay.X.2[,2],])^2,1,sum))
path.cnt <- rep(0,n.e)
path.cnt.v <- rep(0,n)
for(i in 1:n){
	tmp <- get.shortest.paths(g,i,mode="all",output="epath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp),n.e)
	path.cnt <- path.cnt+tmp.tab
	tmp.v <- get.shortest.paths(g,i,mode="all",output="vpath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp.v),n)
	path.cnt.v <- path.cnt.v + tmp.tab
}
path.cnt
path.rank <- rank(path.cnt)
plot(X)
plot(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=rgb(path.cnt/max(path.cnt),1-path.cnt/max(path.cnt),0))
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray((1-path.cnt/max(path.cnt))^5))
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray(1-path.rank/max(path.rank)))
n <- 1000
t <- rnorm(n)
t <- t/(max(abs(t))) * pi*4
x <- cos(t)
#y <- sin(t)
y <- t^2
x. <- x + rnorm(n,0,0.05)
y. <- y + rnorm(n,0,0.05)
plot(x.,y.)

X <- cbind(x.,y.)
library(geometry)

delaunay.X <- delaunayn(X)
plot(X)
delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2])

library(igraph)
g <- graph.edgelist(delaunay.X.2,directed =FALSE)
plot(g)
n.e <- length(delaunay.X.2[,1])
e.weight <- sqrt(apply((X[delaunay.X.2[,1],]-X[delaunay.X.2[,2],])^2,1,sum))
path.cnt <- rep(0,n.e)
path.cnt.v <- rep(0,n)
for(i in 1:n){
	tmp <- get.shortest.paths(g,i,mode="all",output="epath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp),n.e)
	path.cnt <- path.cnt+tmp.tab
	tmp.v <- get.shortest.paths(g,i,mode="all",output="vpath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp.v),n)
	path.cnt.v <- path.cnt.v + tmp.tab
}
path.cnt
path.rank <- rank(path.cnt)
plot(X)
plot(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=rgb(path.cnt/max(path.cnt),1-path.cnt/max(path.cnt),0))
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray((1-path.cnt/max(path.cnt))^5))
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray(1-path.rank/max(path.rank)))
points(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

plot(X,pch=20,cex=0.1)
ord <- order((1-path.cnt/max(path.cnt))^5,decreasing=TRUE)
segments(X[delaunay.X.2[ord,1],1],X[delaunay.X.2[ord,1],2],X[delaunay.X.2[ord,2],1],X[delaunay.X.2[ord,2],2],col=gray((1-path.cnt[ord]/max(path.cnt))^5))

# 交通量で重要性を計りつつ、整備費用というコストとのバランスを取る
n <- 1000
t <- rnorm(n)
t <- t/(max(abs(t))) * pi*4
x <- cos(t)
#y <- sin(t)
y <- t^2
x. <- x + rnorm(n,0,0.05)
y. <- y + rnorm(n,0,0.05)
plot(x.,y.)

X <- cbind(x.,y.)
library(geometry)

delaunay.X <- delaunayn(X)
plot(X)
delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2])

library(igraph)
g <- graph.edgelist(delaunay.X.2,directed =FALSE)
plot(g)
n.e <- length(delaunay.X.2[,1])
e.weight <- sqrt(apply((X[delaunay.X.2[,1],]-X[delaunay.X.2[,2],])^2,1,sum))
path.cnt <- rep(0,n.e)
path.cnt.v <- rep(0,n)
for(i in 1:n){
	tmp <- get.shortest.paths(g,i,mode="all",output="epath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp),n.e)
	path.cnt <- path.cnt+tmp.tab
	tmp.v <- get.shortest.paths(g,i,mode="all",output="vpath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp.v),n)
	path.cnt.v <- path.cnt.v + tmp.tab
}
path.cnt
path.rank <- rank(path.cnt)
plot(X)
plot(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=rgb(path.cnt/max(path.cnt),1-path.cnt/max(path.cnt),0))
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray((1-path.cnt/max(path.cnt))^5))
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray(1-path.rank/max(path.rank)))
points(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

plot(X,pch=20,cex=0.1)
ord <- order((1-path.cnt/max(path.cnt))^5,decreasing=TRUE)
segments(X[delaunay.X.2[ord,1],1],X[delaunay.X.2[ord,1],2],X[delaunay.X.2[ord,2],1],X[delaunay.X.2[ord,2],2],col=gray((1-path.cnt[ord]/max(path.cnt))^5))

# 交通量で重要性を計りつつ、整備費用というコストとのバランスを取る
n <- 1000
t <- seq(from=0,to=1,length=n)*2*pi*5
t <- t/(max(abs(t))) * pi*4
R <- seq(from=0,to=1,length=n)*5
x <- cos(t)*R
y <- sin(t)*R
#y <- t^2
x. <- x + rnorm(n,0,0.05)
y. <- y + rnorm(n,0,0.05)
plot(x.,y.)

X <- cbind(x.,y.)
library(geometry)

delaunay.X <- delaunayn(X)
plot(X)
delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2])

library(igraph)
g <- graph.edgelist(delaunay.X.2,directed =FALSE)
plot(g)
n.e <- length(delaunay.X.2[,1])
e.weight <- sqrt(apply((X[delaunay.X.2[,1],]-X[delaunay.X.2[,2],])^2,1,sum))
path.cnt <- rep(0,n.e)
path.cnt.v <- rep(0,n)
for(i in 1:n){
	tmp <- get.shortest.paths(g,i,mode="all",output="epath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp),n.e)
	path.cnt <- path.cnt+tmp.tab
	tmp.v <- get.shortest.paths(g,i,mode="all",output="vpath",weight=e.weight)
	tmp.tab <- tabulate(unlist(tmp.v),n)
	path.cnt.v <- path.cnt.v + tmp.tab
}
path.cnt
path.rank <- rank(path.cnt)
plot(X)
plot(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

delaunay.X.2 <- rbind(delaunay.X[,1:2],delaunay.X[,2:3],delaunay.X[,c(3,1)])
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=rgb(path.cnt/max(path.cnt),1-path.cnt/max(path.cnt),0))
segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray((1-path.cnt/max(path.cnt))^5))
#segments(X[delaunay.X.2[,1],1],X[delaunay.X.2[,1],2],X[delaunay.X.2[,2],1],X[delaunay.X.2[,2],2],col=gray(1-path.rank/max(path.rank)))
points(X,pch=20,cex = (path.cnt.v/max(path.cnt.v)+0.1)*3)

plot(X,pch=20,cex=0.1)
ord <- order((1-path.cnt/max(path.cnt))^5,decreasing=TRUE)
segments(X[delaunay.X.2[ord,1],1],X[delaunay.X.2[ord,1],2],X[delaunay.X.2[ord,2],1],X[delaunay.X.2[ord,2],2],col=gray((1-path.cnt[ord]/max(path.cnt))^5))