[]バイナリデータでリスクパターンの探索

利用ライブラリ:library(ggplot2)
主な関数   :ggplot(Data, aes(xmin=, xmax=, ymin=, ymax=, fill=)) + 
         geom_rect(alpha=) +
         scale_x_continuous(breaks=, labels=);
        ifelse(),
        paste(, sep="")
        table()


検査項目を2値に落としてパターンを探索してみた。

5000人のデータでやると、50人(1%)以上居るパターンは意外に少なかった(17パターン)。

リスクが重複しているパターンは人数が少ないんだろうけど、パターンの数は多い(全部で626パターン)。

表の0、1を表している項目は順番に次の通り。

(体型)_(血圧・血糖・脂質)_(肝機能・尿検査・貧血)_(喫煙・飲酒)_服薬(血圧・血糖・脂質)

12個の項目があるので、理論的には4096通りのパターンがある。


0_000_000_00_000 0_000_000_01_000 0_000_000_10_000 0_000_000_11_000
608 507 363 185
0_000_010_00_000 0_001_000_00_000 0_001_000_01_000 0_001_000_10_000
50 139 125 95
0_100_000_00_000 1_000_000_00_000 1_000_000_01_000 1_000_000_10_000
76 142 130 107
1_000_000_11_000 1_001_000_00_000 1_001_000_01_000 1_001_000_10_000
85 68 78 57
1_001_000_11_000
51

ただ上の表の合計は2866人。

残りの約半数が少人数のパターンを持っていることになる。

つまり17パターンで2866人、残りの609パターンで2252人だった。

健診的には残りの対象者の方が大事になってくるけど、こっからどういう解析をしたもんかな。。。

また、各カテゴリのリスク割合は次のグラフで確認。

上の項目に入れていない変数もある。

f:id:isseing333:20100509190418j:image



コードは↓です(リスク判定の閾値もここで確認できます)。

#yが健診データ
yBin <- y
yBin$BMI <- ifelse(25 <= y$BMI, 1, 0)
yBin$waist <- ifelse(90 <= y$waist, 1, 0)
yBin$FBS <- ifelse(126 <= y$FBS, 1, 0)
yBin$HbA1c <- ifelse(6.1 <= y$HbA1c, 1, 0)
yBin$SBP <- ifelse(140 <= y$SBP, 1, 0)
yBin$DBP <- ifelse(90 <= y$DBP, 1, 0)
yBin$TG <- ifelse(300 <= y$TG, 1, 0)
yBin$HDL <- ifelse(y$HDL <= 34, 1, 0)
yBin$LDL <- ifelse(150 <= y$LDL, 1, 0)
yBin$AST <- ifelse(61 <= y$AST, 1, 0)
yBin$ALT <- ifelse(61 <= y$ALT, 1, 0)
yBin$G_GT <- ifelse(101 <= y$G_GT, 1, 0)
yBin$UA <- ifelse(7 <= y$UA, 1, 0)
yBin$HB <- ifelse(y$HB <= 12, 1, 0)
yBin$Ht <- ifelse(y$Ht <= 40, 1, 0)
yBin$RBC <- ifelse(y$RBC <= 400, 1, 0)
yBin$WBC <- ifelse(10000 <= y$WBC, 1, 0)
yBin$smoke <- ifelse(1 <= y$smoke, 1, 0)
yBin$drink <- ifelse(1 <= y$drink, 1, 0)
yBin$US <- ifelse(2 <= y$US, 1, 0)
yBin$UP <- ifelse(2 <= y$UP, 1, 0)
yBin$UB <- ifelse(2 <= y$UB, 1, 0)

#------それぞれの項目を組み合わせた変数
yBin$Physic <- ifelse(yBin$BMI==1 | yBin$waist==1, 1, 0)
yBin$BP <- ifelse(yBin$SBP==1 | yBin$DBP==1, 1, 0)
yBin$BS <- ifelse(yBin$FBS==1 | yBin$HbA1c==1, 1, 0)
yBin$LP <- ifelse(yBin$TG==1 | yBin$HDL==1 | yBin$LDL==1, 1, 0)
yBin$Liver <- ifelse(yBin$AST==1 | yBin$ALT==1 | yBin$G_GT==1, 1, 0)
yBin$Urine <- ifelse(yBin$US==1 | yBin$UP==1 | yBin$UB==1, 1, 0)
yBin$Anemia <- ifelse(yBin$HB==1 | yBin$Ht==1 | yBin$RBC==1, 1, 0)

yBinCat <- yBin[, c(1, 14, 18, 22:24, 28:37)]
yBinCat$RiskPattern <- paste(yBin$Physic, "|", yBin$BP, yBin$BS, yBin$LP, "|", yBin$Liver, 
	yBin$Urine, yBin$Anemia, "|", yBin$smoke, yBin$drink, "|", yBin$drug_bp, yBin$drug_bs, 
	yBin$drug_lp, sep="")
length(RiskPattern <- table(yBinCat$RiskPattern))	#パターンの数
table(RiskPattern)

RiskPattern[RiskPattern >= 50]			#50人以上居るパターンを確認→17パターンしかない
RiskPattern[50 > RiskPattern & RiskPattern >= 10]

#------リスク割合を棒グラフで確認
Risk <- data.frame(apply(yBinCat[, c(-1, -4, -17:-19)], 2, table))
Risk2 <- data.frame(label=1:ncol(Risk), Prop=as.numeric(round(Risk[2, ]/nrow(yBinCat)*100, digits=0)))

library(ggplot2)
ggplot(Risk2, aes(xmin=label-0.5, xmax=label+0.5, ymin=0, ymax=Prop, fill=factor(label))) + geom_rect(alpha=0.5) + 
	scale_x_continuous(breaks=1:ncol(Risk), labels=colnames(Risk)) 


ページTOPへ