データの説明

261人の子供たちから得られた年齢別骨密度。

フォーマット

• idnum: 識別コード
• age: 測定時の年齢
• gender: 性別
• spnbmd: 骨密度

チェック

テーブル全体について理解する

> dim(bone)
[1] 485   4

> names(bone)
[1] "idnum"  "age"    "gender" "spnbmd"
> sapply(bone[1,], class)
    idnum       age    gender    spnbmd 
"integer" "numeric"  "factor" "numeric" 

> str(bone)
'data.frame':   485 obs. of  4 variables:
 $ idnum : int  1 1 1 2 2 2 3 3 3 4 ...
 $ age   : num  11.7 12.7 13.8 13.2 14.3 ...
 $ gender: Factor w/ 2 levels "female","male": 2 2 2 2 2 2 2 2 2 1 ...
 $ spnbmd: num  0.01808 0.06011 0.00586 0.01026 0.21053 ...

> head(bone)
  idnum   age gender      spnbmd
1     1 11.70   male 0.018080670
2     1 12.70   male 0.060109290
3     1 13.75   male 0.005857545
4     2 13.25   male 0.010263930
5     2 14.30   male 0.210526300
6     2 15.30   male 0.040843210

> summary(bone)
     idnum            age           gender        spnbmd         
 Min.   :  1.0   Min.   : 9.40   female:259   Min.   :-0.064103  
 1st Qu.: 60.0   1st Qu.:12.70   male  :226   1st Qu.: 0.005858  
 Median :124.0   Median :15.40                Median : 0.026591  
 Mean   :151.5   Mean   :16.10                Mean   : 0.039252  
 3rd Qu.:240.0   3rd Qu.:19.15                3rd Qu.: 0.064127  
 Max.   :384.0   Max.   :25.55                Max.   : 0.219913

個々の項目についてチェックする

> unique(bone$gender)
[1] male   female
Levels: female male

> table(bone$gender)
female   male 
   259    226

クロス集計

missing valueをみつける – gender

> any(is.na(bone$gender))
[1] FALSE

mising valueを見つける – spnbmd

boxplot(bone$spnbmd ~ bone$spnbmd != 0)

データに関するメモ

• idnum, ageでユニークになる
• idnum, ageでデータを追いかけてもあまり意味がなさそう
• ageあるいは男女別で層別にする
• 数値データはspnbmdのみ
• age, gender, spnbmdで回帰分析できそう

Tidy Data

Rで与えられているデータなのでTidyである前提で扱う。

Exploratory

メモ

• 年齢と骨密度は相関しているはず
• 男女で差があるはず
• 個人の年齢別についてはなにか意味があるか

やってみること

• 年齢と骨密度の散布図、男女で層別
• 年齢別ヒストグラム
• 年齢別男女別ヒストグラム
• 骨密度の平均と分散の算出

対象者別観察数

> barplot(table(bone$idnum), col="blue")

• 観察数は最大で３、半数位が1となっている。IDが後半になると観察数が少なくなる傾向がある。

骨密度の男女別概観

> boxplot(bone$spnbmd ~ as.factor(bone$gender), col=c("red", "blue"), varwidth=TRUE)

平均が男女で大きく異なることを予測していたがそれほど変わらない。女子が広がりが大きい。これは外れ値の出方にも共通している。

骨密度の分布をみる

hist(bone$spnbmd, breaks=50, col="blue", main="Spine bmd")

平滑にして男女別で比べてみる

dens  <- density(bone$spnbmd)
dens.m <- density(bone$spnbmd[which(bone$gender=="male")])
dens.w <- density(bone$spnbmd[which(bone$gender=="female")])
plot(dens, lwd=3, col="black")
lines(dens.m, lwd=3, col="blue")
lines(dens.f, lwd=3, col="red")

• 男女別で骨密度に大きな違いは見られない。ただし年齢別にすると異なる可能性がある。
• 骨密度の分布は0.01-0.0.3付近にピークがあり、ロングテールで0.25まで伸びている。
• 正規分布とはいえない。

年齢と骨密度の散布図

 plot(spnbmd ~ age, data=bone, col=as.numeric(gender) + 1)

• 男女別にするとトレンドがある、ただし線形回帰ではない
• 年齢が高くなるほど分散が小さいので予測可能
• 年齢が低いときにははずれ値がある。これをはずして予測はできないか。
• 移動平均でのプロットがあると便利かも

年齢別男女別で骨密度を見てみる

agegroup <- cut2(bone$age, g=5)
plot(spnbmd ~ age, data=bone, col=agegroup, cex=0.5, pch=as.numeric(bone$gender)+1)

モデル