世界で一番わかりやすい心電図ベクトルを目指す - 驚異のアニヲタ社会復帰の予備

MikuHatsune2013-01-11

心電図というものは各心筋の電気活動を心臓という臓器で見た全体がもつ電位ベクトルというものを、体の各部位に取り付けられた電極で観測してグラフ化しているという。
電極の付け方で、胸部誘導という、6つの電極をつけるやり方があるのだが、これは胸を水平に切ったとして、そのときの心臓の電気活動を記録する。
ベクトル心電図はカージオイドとなり、こんな感じの記録が取れる。
心臓の形から実際にどんなカージオイドっぽい形（関数）が取れるのかはめんどくさすぎるので、今回は $a=1$ とした簡単なカージオイドからベクトル心電図→胸部誘導心電図の変換をしてみる。
極座標表示ではx軸から反時計回りを角の正方向とするが、胸部誘導の置き方は第3, 4象限になる。
各誘導と心ベクトルのなす角をもううろ覚えな内積の公式からゴリ押しで求めつつ、原点から各誘導に向かうベクトルに正射影ベクトルを作り、原点から誘導に正射影ベクトルが向いているなら正の電位が、反対を向いているなら負の電位が観測される、という仕組みである。

#極座標で考えつつxy座標にもする。
Vs <- c(4/3, 3/2, 19/12, 5/3, 11/6, 0) * pi #胸部誘導の置く角度
ra <- 4 #胸部誘導を置く遠さ。あまり関係ない。
Vs_xy <- cbind(ra*cos(Vs), ra*sin(Vs)) #胸部誘導の座標
theta <- seq(0, 2, length=10000) * pi #心ベクトルの回転
a0 <- 1 #心ベクトルの長さ
#心ベクトルの座標
#カージオイドを採用する。
x0 <- a0*(1+cos(theta))*cos(theta)
y0 <- -a0*(1+cos(theta))*sin(theta)

#カージオイドを回転させたかったら
kaiten <- function(vec, psi){
	rot <- matrix(c(cos(psi), sin(psi), -sin(psi), cos(psi)), 2, 2)
	c(rot %*% vec)
}
rot0 <- 0 # 1/8*pi
#回転させないけれども0度回転させておく。
xy <- apply(cbind(x0, y0), 1, kaiten, psi=rot0)
x0 <- xy[1, ]
y0 <- xy[2, ]

#カージオイドがなぜかうまく描けない。描けるところをとってくる。
p0 <- 10 * (seq(ceiling(length(theta) / 10)) - 1) + 1
card0 <- c((length(p0)/2):1, rev(tail(seq(p0), length(p0)/2)))
x1 <- x0[p0][card0]
y1 <- y0[p0][card0]

#心ベクトルがx軸となす角度を求める。
acos1 <- acos(x1 / sqrt(rowSums(cbind(x1, y1) ^2)))
acos2 <- rep(0, length(y1))
for(l in seq(y1)){
	acos2[l] <- c(acos1[l], 2*pi - acos1[l])[1 + (y1[l] < 0)]
}
#V1-V6までの誘導と、心ベクトルがなす角を一気に求める。
ECGs <- t(cos(mapply(rep, acos2, length(Vs)) - Vs)) * sqrt(rowSums(cbind(x1, y1) ^ 2))

#プロットのレイアウト
L0 <- matrix(c(8, 2, 1, 3, 6, 4, 7, 5), nr=2, nc=4)
#胸部誘導のの付け方は赤黄緑茶黒紫と順番が決まっている。
leadcolor <- c("red", "yellow", "green", "brown", "black", "violet")
for(i in seq(x1)){
	#png()
	layout(L0)
	par(mar=c(4, 2, 2, 1)* 0.3)
	plot(x1, y1, type="l", xlab="", ylab="", axes=FALSE)
	abline(v = 0, h = 0, lty=2)
	arrows(x0=0, y0=0, x1=x1[i], y1[i], length=0.1)
	points(x1[i], y1[i], col=4, pch=16, cex=2)
	for(k in seq(Vs)){segments(0, 0, Vs_xy[k, 1], Vs_xy[k, 2], lty=3, col=leadcolor[k])}
	
	#各誘導の電位
	for(j in seq(Vs)){
		plot(ECGs[, j], type="l", xlab="", ylab="", axes=FALSE, ylim=range(ECGs), col=leadcolor[j])
		legend("topleft", legend=paste("V", j, sep=""), bty="n", cex=1.8)
		points(i, ECGs[i, j], col=4, pch=16, cex=2)
	}
	#空欄埋め用
	plot(0, type="n", axes=FALSE, xlab="", ylab="")
	#dev.off()
}