crosshyou

主にクロス表(分割表)分析をしようかなと思いはじめましたが、あまりクロス表の分析はできず。R言語の練習ブログになっています。

HistDataパッケージのGaltonFamilies

f:id:cross_hyou:20220403152013j:plain

Photo by Alan Emery on Unsplash 

HistDataパッケージのGaltonFamiliesのデータは、1886年、Galtonが作成したクロス表のデータを基に作成されたものです。

まずは、データを呼び出し、str()関数、head()関数を使ってみます。

f:id:cross_hyou:20220403152333p:plain

934行8列のデータフレームです。家族番号、父親、母親の身長、父親と母親の身長の中間、子どもの数、何番目の子どもか、性別、子どもの身長が変数です。

ヘルプに出ているコードを実行します。

f:id:cross_hyou:20220403152656p:plain

f:id:cross_hyou:20220403152711p:plain

scatterplot()関数を使って、両親の身長をX軸、子どもの身長をY軸にした散布図を描いています。男の子と女の子で別々に描いています。赤いほうが男の子なので男の子のほうが全体的に身長が高いですね。

t.test()関数で本当にそうか検定してみます。

f:id:cross_hyou:20220403153428p:plain

var.test()関数で男の子と女の子の身長は分散が同じとは言えないとわかりましたので、wilcox.test()関数を使いました。p値が2.2e-16より小さいということなので、男の子と女の子の身長は統計的に有意な差があることが確認できました。

ヘルプのコードに戻ります。

f:id:cross_hyou:20220403153917p:plain

f:id:cross_hyou:20220403153927p:plain

女の子の身長に1.08を掛け算してから散布図を描いています。回帰線がほとんどおんなじになりました。

次のヘルプのコードを実行します。

f:id:cross_hyou:20220403154113p:plain

f:id:cross_hyou:20220403154125p:plain

女の子の身長に5.2を足してから散布図を描いています。これもほとんど同じ回帰線になっています。

次のヘルプのコードを実行します。

f:id:cross_hyou:20220403154312p:plain

f:id:cross_hyou:20220403154345p:plain

母親の身長と父親の身長の散布図をsunflowerplot()関数で描いています。母親と父親の相関はあまりないのでしょうか。

ここでヘルプのコードは終了です。

母親の身長と父親の身長に相関があるかないか、調べてみましょう。

f:id:cross_hyou:20220403154950p:plain

p値が0.1669と15%よりも大きな値ですので、父親と母親の身長には相関はあるとは言えないです。

子どもの身長を父親と母親の身長で回帰分析してみます。

f:id:cross_hyou:20220403155326p:plain

父親の身長も母親の身長も有意な変数ですね。

genderとchildNumも説明変数に入れてみます。

f:id:cross_hyou:20220403155812p:plain

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)