線分をまとめる

  • 線分がオーバーラップしているときに、それをまとめて、線分のある場所とない場所とを区別したい
  • いかにも、関数が転がっていそうなのに検索語が悪いのか見つからない
  • 次元が上がれば計算幾何アルゴリズム的(こちら)なことなので、それなりに見つかる感じだが、1次元では簡単すぎてだれも作ってくれていないということか…
  • と言うわけで、やっつけで作る
# sは始点・終点座標を1列とした2列の行列
segment.union <- function(s){
# 線分数
	n.seg <- length(s[,1])
# 始点・終点の順・逆が混ざっていても気にせずまとめるとする
# 線分ごとに値でソート
	my.seg.1 <- t(apply(s,1,sort))
# 始点の値で線分に順番
	ord <- order(my.seg.1[,1])
# 線分を並べ替え
	my.seg.2 <- my.seg.1[ord,]
# 端の値の大小をラベルづけ
	st.end <- rep(0:1,n.seg)
# 端の値の順に処理
	loc <- c(t(my.seg.2))
	loc.ord <- order(loc)
	loc.ordered <- loc[loc.ord]
	st.end.ordered <- st.end[loc.ord]
# 小さい方から見て行って、線分のオーバーラップ具合をcurrentで
# そのときのユニオン線分の始点をnew.stに格納
# ユニオン線分数をcntで数える
	new.st <- c()
	current <- 0
	cnt <- 0
	ret <- list()
	for(i in 1:length(loc)){
		if(st.end.ordered[i]==0){
			if(length(new.st)==0){
				new.st <- loc.ordered[i]
			}
			current <- current + 1
		}else{
			if(current==1){
				cnt <- cnt+1
				ret[[cnt]] <- c(new.st,loc.ordered[i])
				new.st <- c()
			}
			current <- current - 1
		}
	}
	ret
}
s <- matrix(c(5,3,2,8,4,10,13,15,16,19,11,11),byrow=TRUE,ncol=2)
segment.union(s)
> segment.union(s)
[[1]]
[1]  2 10

[[2]]
[1] 11 11

[[3]]
[1] 13 15

[[4]]
[1] 16 19
  • ぐちゃぐちゃ、作業メモ
s <- matrix(c(5,3,2,8,4,10,13,15,16,19),byrow=TRUE,ncol=2)
n.seg <- length(s[,1])
id <- 1:n.seg
y <- rep(id,2)
plot(c(s),y,col=c(rep(1,n.seg),rep(2,n.seg)))
for(i in 1:n.seg){
	segments(s[i,1],i,s[i,2],i)
}

my.seg.1 <- t(apply(s,1,sort))
ord <- order(my.seg.1[,1])
my.seg.2 <- my.seg.1[ord,]

plot(c(my.seg.2),y,col=c(rep(1,n.seg),rep(2,n.seg)))
for(i in 1:n.seg){
	segments(my.seg.2[i,1],i,my.seg.2[i,2],i)
}


st.end <- rep(0:1,each=n.seg)
st.end
loc <- c(my.seg.2)
loc.ord <- order(loc)
loc.ordered <- loc[loc.ord]
st.end.ordered <- st.end[loc.ord]

new.st <- c()
new.end <- c()
current <- 0
cnt <- 0
ret <- list()
for(i in 1:length(loc)){
	if(st.end.ordered[i]==0){
		if(length(new.st)==0){
			new.st <- loc.ordered[i]
		}
		current <- current + 1
	}else{
		if(current==1){
			cnt <- cnt+1
			ret[[cnt]] <- c(new.st,loc.ordered[i])
			new.st <- c()
		}
		current <- current - 1
	}
}
ret