2012-09-18

機械に教える医学学習３

診断集合 R

昨日の続き
昨日は、亜集合を要素とする集合が２つあったときに、その包含関係を測る話だった
今日は、亜集合の要素がグラフ上のノードにあるとして、包含関係(０，１の関係)から量的な関係に広げる話
- 以下で定める「距離」の定め方はあくまでも一つのやり方なので、拡張・変更・検討に値する(が処理の手順はこれでよいだろう)
なぜ、包含関係ではなくて、「包含関係を０(最短距離)」とした測度を持ち込むか、というと、「確たること(０)」と、それに近いことを「連想する」という手続きを持ち込みたいから

# ノードリストとノードリストとの総当たり距離を返す
# ノードリストを２つ使う
s <- s.list[[1]]
d <- d.list[[1]]

# ノードリストとノードリストとのノードペアについて、グラフ上の最短距離を測り
# 第１(または２）ノードリストの個々のノードについて、第２（または１）ノードリストのいずれかのノードへの最短距離を測り
# その最大値をもって、第１(または２）ノードリストから第２（または１）ノードリストへの「距離」とする

dist.btwn.node.sets <- function(g,s,d,weights = NULL){
# ノードリストsのノードからノードリストdのノードへの最短距離を計算する
	sh.pts <- sh.paths.btwn.lists(g,s,d,weights = NULL)
# sのそれぞれのノードから、dのノードへの最短距離のうちの最短な長さを計算する
	min.sh.pts1 <- apply(sh.pts,1,min)
# dのそれぞれのノードから、sのノードへの最短距離のうちの最短な長さを計算する
	min.sh.pts2 <- apply(sh.pts,2,min)
# sのそれぞれのノードからの最短距離のうち最大のものを選ぶ
	max.min.sh.pts1 <- max(min.sh.pts1)
# dのそれぞれのノードからの最短距離のうち最大のものを選ぶ
	max.min.sh.pts2 <- max(min.sh.pts2)
	return(list(d1 = max.min.sh.pts1,d2 = max.min.sh.pts2,d.vector1 = min.sh.pts1,d.vector2 = min.sh.pts2,d.matrix = sh.pts))
}

上の定義を使って、昨日の「包含関係」の情報を拡張する
- 包含関係は、sのすべてのノードについて、dのノードへの最短距離を計算し、その中の最小値をとり、その最小値をsのすべてのノードについて評価して、最大値を取ったときに、0であるなら、それを「sはdに包含される」と言った
- 今、この0:包含を拡張して、値を取らせることで、「包含までに必要な距離」を出している

# ノード数を指定
n.v <- 20
# ある症候について、３通りの用語セットを与える

s.list <- list()

s.list[[1]] <- sample(1:n.v,3)
s.list[[2]] <- sample(1:n.v,3)
s.list[[3]] <- sample(1:n.v,3)

# ある診断名について、２通りの用語セットを与える
d.list <- list()

d.list[[1]] <- sample(1:n.v,8)
d.list[[2]] <- sample(1:n.v,7)


dist.btwn.node.sets(g,s,d)

# 症候の用語セットのリストと、診断名の用語セットのリストをとって、総当たり比較する関数
# 総当たりの上、その場合の症候の要素数と診断名の要素数と、２つの共通要素数/症候の要素数という比の値を返す
diff.dig2 <- function(s.list,d.list,g,weight = NULL){
	#s.l <- lapply(s.list,sort)
	# 念のため２つの要素セットのリストについて、要素重複をなくす
	s.l <- lapply(s.list,unique)
	#d.l <- lapply(d.list,sort)
	d.l <- lapply(d.list,unique)
	# 返り値を格納する３次元アレイ
	ret <- array(0,c(length(s.l),length(d.l),3))
	# すべての要素セット同士の総当たり
	for(i in 1:length(s.l)){
		for(j in 1:length(d.l)){
			tmp <- dist.btwn.node.sets(g,s.l[[i]],d.l[[j]])

			ret[i,j,] <- c(length(s.l[[i]]),length(d.l[[j]]),tmp$d1)
		}
	}
	return(ret)
}

diff.dig2(s.list,d.list,g)