www.crosshyou.info

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

RのHistDataパッケージのArbuthnot

更新日:2022-01-08

f:id:cross_hyou:20220108082910j:plain

Photo by Annie Spratt on Unsplash 

Rのパッケージで、HistDataというパッケージがあります。これは統計学の世界やビジュアライゼーションの分野で使われた面白い小さなデータセットを集めたパッケージです。このヘルプ文書にいろいろとサンプルコードが記載されていますので、自分の勉強のためにこれからすこしずつ実践してみようと思います。

一番はじめのデータセットは、Arbuthnot というデータセットです。

Arbuthnot's data on male and female birth ratios in London from 1629 - 1710 というもので、Arbuthnotさんが集計したロンドンの男女の出生比率のデータで、1629年から1710年のデータです。

早速、サンプルコードを実践してみます。

f:id:cross_hyou:20220108083712p:plain

まず、str()関数でデータの構造を確認してみました。82行 x 7列のデータフレームです。

Yearは西暦年、Malesは男性の出生数、Femalesは女性の出生数、Plaugeは疫病で死んだ人数(この当時はペストでしょうかね?)、Mortalityは死亡した人数、RatioはMales/Femalesの値です、男女の出生比率ですね。TotalはChristeningsの数だそうです。赤ちゃんの洗礼の数だそうです。千人単位です。なので、9.9は9900人ということです。

それでは早速サンプルコードを実践してみます。

f:id:cross_hyou:20220108084547p:plain

f:id:cross_hyou:20220108084601p:plain

plot()関数で男女の出生比率をプロットして、abline()関数で1.0の水準に水平線を引いています。全ての年で1.0を上回っており、常に男の子のほうが多く生まれていることがわかります。

次のサンプルコードには、loess曲線の追加のコードでした。

f:id:cross_hyou:20220108085252p:plain

f:id:cross_hyou:20220108085305p:plain

loess曲線というのは移動平均みたいなものですね。loess.smooth()関数でそういうデータを生成できるようです。そのデータをlines()関数で描いたプロットに追加しています。loess.smooth()関数のヘルプを見たら、span = というパラメータで曲線のぐにゃぐにゃ度合いを設定できるようです。初期設定は span = 2/3でした。

span = 0.05 のloess曲線も追加してみましょう。

f:id:cross_hyou:20220108090144p:plain

f:id:cross_hyou:20220108090200p:plain

かなりぐにゃぐにゃした緑の曲線が追加されました。

次のサンプルコードは Total をプロットしています。

f:id:cross_hyou:20220108090704p:plain

f:id:cross_hyou:20220108090716p:plain

サンプルコードには1704年の異常値、とありましたが、たしかに1704年ごろの値がガクンと下がっていますね。abline()関数で1704年のところに垂直線を描きます。

f:id:cross_hyou:20220108091047p:plain

f:id:cross_hyou:20220108091058p:plain

たしかに1704年がガクンと下がっていましたね。

以下が今回のコードです。随時更新したり、HistDataパッケージの他のデータセットも試してみようと思います。

 

# 2022-01-08
# HistData - Arbuthnot
#
library(HistData) # HistDataを読み込む
data(Arbuthnot) # Arbuthnotデータを呼び出す
str(Arbuthnot) # データの構造を確認する
#
# 男女の比率をプロット
with(Arbuthnot, plot(Year, Ratio, type = "b",
                     ylim = c(1, 1.2), ylab = "Sex Ratio (M/F)"))
abline(h = 1, col = "red")
#
# loess曲線を追加
Arb.smooth <- with(Arbuthnot, loess.smooth(Year, Ratio))
lines(Arb.smooth$x, Arb.smooth$y, col = "blue", lwd = 2)
#
# span = 0.05 のloess曲線を追加
span0.05 <- with(Arbuthnot, loess.smooth(Year, Ratio, span = 0.05))
lines(span0.05$x, span0.05$y, col = "green", lwd = 2)
#
# Total(洗礼の数)をプロットして1704年の異常値を見る
with(Arbuthnot, plot(Year, Total, type = "b", ylab = "Total Chirntenings"))
#
# 1704年に垂直線を追加
abline(v = 1704, col = "red", lty = 2)
#