3次元データを折れ線グラフで描くときの層の選択

中澤さんが言及している図であるが，

【第290回】 院生指導と講義準備と事務仕事（2020年1月21日）

この図から「フィンランドの出生率の2015年以降の急低下に実質的な意味があるのか，今後持続するのかどうかはわからない。」というのを導くって，図の読み取りが難しい？

横軸と年代を入れ替えて以下のような図にすると，わかりやすいような気がするのだけど。

20-24 はずっと前から下がって，1/4 にもなっている。25−29 は 1970 年頃が谷でその後持ち直したが 1990-1994 をピークに下がっている。30−34  は 1970 年頃が谷でその後持ち直していたが 2005-2009 から下がっている。35-39 は2010-2014 から下がっている。

素人だからよく分からないのではあるが。もとの図よりはわかりやすいような気がする。

if (!require(wpp2019)) { install.packages("wpp2019", dep=TRUE); library(wpp2019) }
data(tfr)
data(percentASFR)
SY <- 1950+0:13*5
EY <- 1955+0:13*5
TFRFinland <- subset(tfr, name=="Finland")[, sprintf("%4d-%4d", SY, EY)]
pASFRFinland <- subset(percentASFR, name=="Finland")[, c("age", sprintf("%4d-%4d", SY, EY))]
ASFRFinland <- pASFRFinland
for (i in 0:13) {
 ASFRFinland[, i+2] <- pASFRFinland[, i+2]/100*TFRFinland[1, i+1]
}

color = c("black", "red", "blue", "brown", "aquamarine4 ", "magenta", "purple")
old = par(las=1, tck=-0.01, mar=c(3, 3, 1.5, 2), mgp=c(1.2, 0.3, 0), bty="l",
  cex.axis=0.6, cex.lab=0.8)
data = ASFRFinland[, 2:15]
colnames(data) = sprintf("%4d-%4d", SY, EY-1)
matplot(t(data), type="l", lwd=2,
 ylim=c(0, 1), xaxt="n",
 col= color, lty=1,
 xlab="year", ylab="ASFR")
title(main=list("ASFR by age in Finland from 1950 to 2020", cex=0.9))
legend = sprintf("%d-%d", 3:9*5, 3:9*5+4)
legend[4] = paste0("age\n", legend[4])
text(14, data[, 14], legend, cex=0.6, col=color, xpd=TRUE, pos=4)
axis(1, at=1:14, label=colnames(data))
par(old)

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

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）につづく