Photo by Alan Emery on Unsplash
HistDataパッケージのGaltonFamiliesのデータは、1886年、Galtonが作成したクロス表のデータを基に作成されたものです。
まずは、データを呼び出し、str()関数、head()関数を使ってみます。
934行8列のデータフレームです。家族番号、父親、母親の身長、父親と母親の身長の中間、子どもの数、何番目の子どもか、性別、子どもの身長が変数です。
ヘルプに出ているコードを実行します。
scatterplot()関数を使って、両親の身長をX軸、子どもの身長をY軸にした散布図を描いています。男の子と女の子で別々に描いています。赤いほうが男の子なので男の子のほうが全体的に身長が高いですね。
t.test()関数で本当にそうか検定してみます。
var.test()関数で男の子と女の子の身長は分散が同じとは言えないとわかりましたので、wilcox.test()関数を使いました。p値が2.2e-16より小さいということなので、男の子と女の子の身長は統計的に有意な差があることが確認できました。
ヘルプのコードに戻ります。
女の子の身長に1.08を掛け算してから散布図を描いています。回帰線がほとんどおんなじになりました。
次のヘルプのコードを実行します。
女の子の身長に5.2を足してから散布図を描いています。これもほとんど同じ回帰線になっています。
次のヘルプのコードを実行します。
母親の身長と父親の身長の散布図をsunflowerplot()関数で描いています。母親と父親の相関はあまりないのでしょうか。
ここでヘルプのコードは終了です。
母親の身長と父親の身長に相関があるかないか、調べてみましょう。
p値が0.1669と15%よりも大きな値ですので、父親と母親の身長には相関はあるとは言えないです。
子どもの身長を父親と母親の身長で回帰分析してみます。
父親の身長も母親の身長も有意な変数ですね。
genderとchildNumも説明変数に入れてみます。
gendermaleの係数が4.09677とあります。これは男の子のほうが女の子より4.09677身長が高いということです。childNumの係数はマイナスです。これは、長男、長女よりも次男、次女、三男、三女のほうが身長が低いということですね。弟や妹はまだ小さいのかもしれません。
以下が今回のコードです。
# 2022-04-03
# HistData - GaltonFamilies
#
library(HistData)
data("GaltonFamilies")
#
str(GaltonFamilies)
#
head(GaltonFamilies)
#
#
## reproduce Fig 2 in Hanley (2004)
library(car)
scatterplot(childHeight ~ midparentHeight | gender, data = GaltonFamilies,
ellipse = TRUE, levels = 0.68,
legend.coords = list(x = 64, y = 78))
#
# 男の子と女の子の身長差の検定
boy <- GaltonFamilies$childHeight[GaltonFamilies$gender == "male"]
girl <- GaltonFamilies$childHeight[GaltonFamilies$gender == "female"]
var.test(boy, girl)
wilcox.test(boy, girl)
#
# multiply daughter's heights by 1.08
GF1 <- within(GaltonFamilies,
{childHeight <- ifelse(gender == "female", 1.08*childHeight,
childHeight)})
scatterplot(childHeight ~ midparentHeight | gender, data = GF1,
ellipse = TRUE, levels = 0.68,
legend.coords = list(x = 64, y = 78))
#
# adds 5.2 to daughters heights
GF2 <- within(GaltonFamilies,
{childHeight <- ifelse(gender == "female", 5.2 + childHeight,
childHeight)})
scatterplot(childHeight ~ midparentHeight | gender, data = GF2,
ellipse = TRUE, levels = 0.68,
legend.coords = list(x = 64, y = 78))
#
############################################
# relationship between heights of parents #
############################################
Parents <- subset(GaltonFamilies, !duplicated(GaltonFamilies$family))
with(Parents, {
sunflowerplot(mother, father, rotate = TRUE, pch = 16,
xlab = "Mother's Height",
ylab = "Father's Height")
dataEllipse(mother, father, add = TRUE, plot.points = FALSE,
center.pch = NULL, levels = 0.68)
abline(lm(father ~ mother), col = "red", lwd = 2)
}
)
#
# 父親と母親の身長に相関はあるか
chichi <- GaltonFamilies$father[GaltonFamilies$childNum == 1]
haha <- GaltonFamilies$mother[GaltonFamilies$childNum == 1]
cor.test(chichi, haha)
#
# 子どもの身長を父親と母親の身長で回帰分析
reg <- lm(childHeight ~ father + mother, data = GaltonFamilies)
summary(reg)
#
# 性別、何番目の子どもかも加えて回帰分析
reg2 <- lm(childHeight ~ father + mother + gender + childNum,
data = GaltonFamilies)
summary(reg2)
