[データ解析]バイナリデータでリスクパターンの探索
利用ライブラリ: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人だった。
健診的には残りの対象者の方が大事になってくるけど、こっからどういう解析をしたもんかな。。。
また、各カテゴリのリスク割合は次のグラフで確認。
上の項目に入れていない変数もある。
#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))