裏 RjpWiki

文字通り,RjpWiki の裏を行きます
R プログラム コンピュータ・サイエンス 統計学

素の R で,データスクレイピングとプロット

2020年01月23日 | ブログラミング

2020年センター数1Aの箱ひげ図をRとggplot2で描いてみる

であるが,ggplot2 というのが気に入らない。

まず,データの取得であるが,Excel で 12 のシートがあるからと怖じ気づいたようだが,以下のようにすればよい。簡単とはいえないかもしれないが,手作業するより気は楽だ。なお,tidyverse なども使わない。

2020/01/25:追記 誤って,一箇所だけバグのあるソースコード(下記に赤字で示した箇所)を掲載してしまいました。

より簡単な方法(プログラム)を投稿しました。
素の R で,データスクレイピングとプロット(その4)

=====================

# https://www.mhlw.go.jp/toukei/saikin/hw/life/ckts15/dl/ckts15-06.xls
# 図表データのダウンロード
# 統計表1-1〜1-12 が「市区町村別平均寿命」

# install.packages("readxl")

library(readxl)

# データが 3 段組み(最終ページは 2 段組み)になっているので分解と結合
for (page in 1:12) {
  data = as.data.frame(read_excel("ckts15-06.xls", sheet = page+4))
  # stopifnot(data[3,1] == "市区町村") # データ開始行の確認
  data = data[-(1:3),]
  colnames(data) = rep(letters[1:5], 3)[1:ncol(data)]
  # stopifnot((page != 12 && ncol(data) == 14) || # 段組み数の確認
  #  (page == 12 && ncol(data) == 9))
  if (page == 1) {
    data2 = rbind(data[1:4], data[6:9], data[11:14])
  } else if (page != 12) {
    data2 = rbind(data2, data[1:4], data[6:9], data[11:14])
  } else {
    data2 = rbind(data2, data[1:4], data[6:9])
  }
}
# 列名は,都道府県・市郡 name1, 区町村 name2,男 male,女 female
colnames(data2) = c("name1", "name2", "male", "female")

# 都道府県名が の行は除いて良いか確認
# data2[is.na(data2$name1),]
data2 = data2[!is.na(data2$name1),]
data2 = data2[!is.na(data2[,3]),] # 米原市の後の不正な1行を除く
n = nrow(data2) # 1965 行
pref.code = integer(n) # 都道府県コード
pref.count = 0
for (i in 2:n) {
  cap =substr(data2$name1[i], 1, 1)
  if (cap != " ") { # 先頭1文字が全角空白でなければ都道府県名
    pref.count = pref.count+1
    # cat(pref.count, data2$name1[i], "\n") # 47都道府県コードが表示されることを確認
  } else {
    pref.code[i] = pref.count # 該当行に都道府県コードを付与
  }
}

data3 = data2
# 各行に都道府県コード pref.code を追加
data3$pref.code = pref.code
# 文字データを数値に変換。但し,欠損値 "…" があることに注意。
data3$male = as.numeric(gsub("…", NA, data3$male))
data3$female = as.numeric(gsub("…", NA, data3$female))
# 都道府県・市郡 name1, 区町村 name2 の正規化
data3$name1 = gsub(" ", "", data3$name1)
data3$name2 = gsub("0", "", data3$name2)
data3$name2 = gsub(" ", "", data3$name2)
data3$name2[is.na(data3$name2)] = "" # name1 == 宮城県 で,name2 = を空に

data4 = data3
# 特別区を持つ市をまとめたデータ行の区分として,pref.code = -1 とする
rownames(data4) = seq_len(nrow(data4))
special = NULL # 特別区を持つ市の名前を記録
for (i in seq_len(nrow(data4))) {
  if (data4$name1[i] == "東京都区部") { # これは特別中の特別
    data4$pref.code[i] = -1
    # print(data4[i, ])
  } else if (grepl("市", data4$name1[i]) && grepl("区", data4$name2[i])) {
    special = c(special, data4$name1[i])
    # print(data4[i, ])
  }
}
special = unique(special) # ユニークな特別区のリスト
for (i in seq_len(nrow(data4))) {
  # name1 が特別区のある市の名前で,name2 が空の場合が特別区をまとめたデータ行
  if (data4$name1[i] %in% special && data4$name2[i] == "") {
    data4$pref.code[i] = -1
    # print(data4[i,])
  }
}

all.data = data4 # 最終的なデータフレーム

write.csv(all.data, "all.csv", row.names=FALSE)

必要のないデータも含んでいるので,以下のように必要なデータ(男の市区町村別データ)だけを取り出して boxplot で描画する。

par(las=1, bty="l", mar=c(4, 4, 2, 0.5), mgp=c(2, 0.4, 0), tck=-0.005)
df = read.csv("all.csv")
df2 = df[df$pref.code == 0,]
pref.name = unique(factor(df2$name1))[-1]
df2 = df[df$pref.code > 0,]
means = by(df2$male, df2$pref.code, mean, na.rm=TRUE)
boxplot(df2$male ~ df2$pref.code, horizontal=TRUE,
 xlab= "", ylab="",
 main = "平成27年度の都道府県別(市区町村別)平均寿命",
 at=rank(-means), names=pref.name,
 cex.axis=0.6, col="gray", range=0, whisklty=1, outline=TRUE)
points(means, rank(-means), pch = 19, cex=0.3, col="red")
mtext("平均寿命(歳)", side=1, line=1.5)
mtext("都道府県", side=2, line=2.3, las=0)
mtext("https://www.mhlw.go.jp/toukei/saikin/hw/life/ckts15/dl/ckts15-06.xls に基づき作図", side=1, line=2.5, adj=1, cex=0.8)

これで綺麗な図が描ける。図中の赤丸はおまけで示した平均値。

素の R で,データスクレイピングとプロット(その2)につづく

コメント (1)   この記事についてブログを書く
« 今すぐ 1000万円を儲ける方法 | トップ | 3次元データを折れ線グラフで... »
最新の画像もっと見る

1 コメント

コメント日が  古い順  |   新しい順
Unknown (3PapG0rua)
2020-08-06 19:29:04
> なお,tidyverse なども使わない。
readxlパッケージもtidyverseの一部では。

コメントを投稿

ブログ作成者から承認されるまでコメントは反映されません。

ブログラミング」カテゴリの最新記事