[R program]特定健診の健診結果を利用した健康分布

俗にメタボ健診と呼ばれますが、特定健康診査というものがあります。

生活習慣病の予防事業の一環ですが、検査値をもとにして法定階層化を行い、心疾患系のリスク状況をレベル付けします。

リスクレベルは、低い方から情報提供群・動機づけ支援群・積極的支援群と分かれます。

このリスク分け以外にも、例えばヘルスケアコミッティー（HCC）という会社が健康分布という図でリスクを見やすく表現しています。

今回はこの健康分布をRで描いてみました。

まず空のプロットを描いて、各リスク割合に応じて四角を描いていくことで次のような図になります。

f:id:isseing333:20100617210122j:image

光沢を付けすぎてファイルサイズが大きくなってしまいましたが、普通の四角を描けば回避できますね。

grad関数を自作で作ってそこで光沢を付けているので、これをrectに変えて中身も適した形にすれば光沢はなくなります。

先に服薬者の割合等をデータから作っておくことが必要ですね。

今回は適当な値を入れてありますので、このままコピペで絵が描けます。


コードはこちらです↓

library(plotrix)
col.1=smoothColors("white",5,"#7E7E7E")
col.2=smoothColors("#DCD8E8",5,"#213E65")
col.3=smoothColors("#C3D8E9",5,"#0C273A")

green.1<-"#759242"
blue.1<-"#143b66"
yellow.1<-"#D76704"
red.1<-"#983836"

grad<-function(x1,x2,y1,y2,col,angl=1,num=100){
	if(angl==1){
		for(i in 1:num*0.7){
			lines(c(x1,x2),c(y1+(y2-y1)*i/num,y1+(y2-y1)*i/num),col=smoothColors(col,num*0.7,"white")[i])
		}
		for(i in num*0.7+1:num){
			lines(c(x1,x2),c(y1+(y2-y1)*i/num,y1+(y2-y1)*i/num),col=smoothColors("white",num*0.3,col)[i-num*0.7])
		}
	}
	else{
		for(i in 1:num*0.7){
			lines(c(x1+(x2-x1)*i/num,x1+(x2-x1)*i/num),c(y1,y2),col=smoothColors(col,num*0.7,"white")[i])
		}
		for(i in num*0.7+1:num){
			lines(c(x1+(x2-x1)*i/num,x1+(x2-x1)*i/num),c(y1,y2),col=smoothColors("white",num*0.3,col)[i-num*0.7])
		}

	}
}



Drug <- 18
Jushin <- 42
JushinNoShido <- 70
JushinShido <- 30
Mibyou <- 40
MibyouNoHiman <- 60
MibyouHiman <- 40
MibyouNoHiman.0 <- 60*0.4	#未病の割合をかけておく
MibyouNoHiman.1 <- 20*0.4
MibyouNoHiman.2 <- 10*0.4
MibyouNoHiman.3 <- 5*0.4
MibyouNoHiman.4 <- 5*0.4
MibyouHiman.0 <- 40*0.4
MibyouHiman.1 <- 20*0.4
MibyouHiman.2 <- 15*0.4
MibyouHiman.3 <- 15*0.4
MibyouHiman.4 <- 10*0.4

par(mar=c(0, 0, 0, 0))
plot(c(-30, 130), c(-5, 140), type="n")
rect(-100, -100, 1000, 1000, col="white")

#---服薬者
text(-15, Drug/2, "服薬者", cex=1.2)
text(100, Drug-3, paste(round(Drug, digits=1), "%", seq=""), adj=0, cex=1)

grad(0, 100, 0, Drug, col="gray")
#text(50, Drug/2, "服薬者", cex=1.2)

#---受診勧奨者
text(-15, Drug+5+Jushin/2, "受診勧奨\n対象者\n（未服薬者）", cex=1.2)
text(100, Drug+5+Jushin-3, paste(round(Jushin, digits=1), "%", seq=""), adj=0, cex=1)

grad(0, JushinNoShido, Drug+5, Drug+5+Jushin, col="gray", num=500)
text(JushinNoShido/2, Drug+5+Jushin/2, "非対象者", cex=1.1)
text(0, Drug+5+Jushin-3, paste(round(JushinNoShido*Jushin/100, digits=1), "%", seq=""), adj=0, cex=0.8)

grad(JushinNoShido, 100, Drug+5, Drug+5+Jushin, col=yellow.1, num=500)
text(JushinNoShido+JushinShido/2, Drug+5+Jushin/2, "特定保健指導\n対象者", cex=1.1)
text(JushinNoShido, Drug+5+Jushin-3, paste(round(JushinShido*Jushin/100, digits=1), "%", seq=""), adj=0, cex=0.8)

#---未病者
text(-15, Drug+Jushin+10+Mibyou/2, "未病者", cex=1.2)
text(100, 110-3, paste(round(Mibyou, digits=1), "%", seq=""), adj=0, cex=1)

#非肥満
grad(0, MibyouNoHiman, Drug+Jushin+10, Drug+Jushin+10+MibyouNoHiman.4, col=red.1)
grad(0, MibyouNoHiman, Drug+Jushin+10+MibyouNoHiman.4, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3, col=yellow.1)

grad(0, MibyouNoHiman, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2, col=green.1)
text(0, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2-3, paste(round(MibyouNoHiman.2, digits=1), "%", seq=""), adj=0, cex=0.8)

grad(0, MibyouNoHiman, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2+MibyouNoHiman.1, col=blue.1)
text(0, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2+MibyouNoHiman.1-3, paste(round(MibyouNoHiman.1, digits=1), "%", seq=""), adj=0, cex=0.8)

grad(0, MibyouNoHiman, Drug+Jushin+10+MibyouNoHiman.4+MibyouNoHiman.3+MibyouNoHiman.2+MibyouNoHiman.1, 110, col="gray", num=500)
text(0, 110-3, paste(round(MibyouNoHiman.0, digits=1), "%", seq=""), adj=0, cex=0.8)

text(MibyouNoHiman/2, 113, "非肥満")

#肥満
grad(MibyouNoHiman, 100, Drug+Jushin+10, Drug+Jushin+10+MibyouHiman.4, col=red.1)
grad(MibyouNoHiman, 100, Drug+Jushin+10+MibyouHiman.4, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3, col=yellow.1)
text(120, 110-MibyouHiman.0-MibyouHiman.1-MibyouHiman.2-MibyouHiman.3/2, "リスク3個", cex=1)

grad(MibyouNoHiman, 100, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2, col=green.1)
text(MibyouNoHiman, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2-3, paste(round(MibyouHiman.2, digits=1), "%", seq=""), adj=0, cex=0.8)
text(120, 110-MibyouHiman.0-MibyouHiman.1-MibyouHiman.2/2, "リスク2個", cex=1)

grad(MibyouNoHiman, 100, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2+MibyouHiman.1, col=blue.1)
text(MibyouNoHiman, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2+MibyouHiman.1-3, paste(round(MibyouHiman.1, digits=1), "%", seq=""), adj=0, cex=0.8)
text(120, 110-MibyouHiman.0-MibyouHiman.1/2, "リスク1個", cex=1)

grad(MibyouNoHiman, 100, Drug+Jushin+10+MibyouHiman.4+MibyouHiman.3+MibyouHiman.2+MibyouHiman.1, 110, col="gray", num=500)
text(MibyouNoHiman, 110-3, paste(round(MibyouHiman.0, digits=1), "%", seq=""), adj=0, cex=0.8)
text(120, 110-MibyouHiman.0/2, "リスク0個", cex=1)

text(MibyouNoHiman+MibyouHiman/2, 113, "肥満")

ページTOPへ