政治学経済学 II：格差の測定
矢内 勇生
2015年4月22日
はじめに
架空の所得データ（ここで作成する） を使い、所得格差の測定法を学ぶ。 以下の、Rを使って、所得格差を計算する。 R以外のソフトで実習したい者は、データ をダウンロードし、 自分の好きなソフトでどうぞ（ただし、以下で作るincomes4 [人口を2倍にしたデータ] は含まれていないので、自分で作ること）。
準備
厚生労働省『平成25年 国民生活基礎調査の概況』の所得分布の図 (PDF)を元に、データを作成する。
所得階級は0から100万円ごとに作る。ただし、「2000万円以上」は簡単のため「2000万円から2100万円」とする。また、データサイズ（人口）は1万人とする。
## weight は各階級のパーセント
weights <- c(6.2, 13.2, 13.3, 13.2, 11, 9, 7.3, 6.5, 5.2,
3.8, 3, 2, 1.5, 1.1, .9, .6, .5, .3, .2, .2, 1)
## 各階級の上限値
## 最上位階級の上限値を便宜的に2100万円に設定
ub <- seq(100, 2100, by = 100)
## 人口 n = (m * 100) 人
m <- 100
n <- sum(weights) * m
## 階級比率を維持し、各人の所得をランダムに決定する
incomes <- rep(NA, n)
start <- 0
set.seed(2015-04-22)
for (i in seq_along(weights)) {
add <- weights[i] * m
incomes[(start + 1):(start + add)] <- runif(m * weights[i],
min = ub[i] - 100, max = ub[i])
start <- start + add
}
## データフレームの作成
df <- data.frame(income = incomes)作成されたデータの平均値と中央値は、
(mean.inc <- mean(incomes))## [1] 529.8236(median.inc <- median(incomes))## [1] 440.0597と、なる。また、平均所得金額以下の割合は、
is.below <- incomes <= mean.inc
sum(is.below) / n## [1] 0.594と、なる。いずれも、実際の2013年の所得分配データ（平均値：537.2万円、中央値：432万円、平均以下の割合：60.8%）に近い数値が得られた。
このデータを所得分布のヒストグラムにしてみよう。
#quartz(file = "simulated-inc-dist1.pdf",
# family = "sans", type = "pdf", height = 4, width = 6)
hist(incomes, col = "limegreen",
xlab = "所得（単位：万円）", ylab = "度数",
main = "日本の所得分布 (層化抽出による擬似データ)")
abline(v = c(mean(incomes), median(incomes)),
col = c("red", "blue"), lwd = 2)
legend("topright", lty = 1, lwd = 2, col = c("red", "blue"),
legend = c("平均所得", "中位所得"))
#dev.off()このように、元の図 (PDF) とよく似た図ができる。
様々な格差測度の特徴を捉えるために、以下のデータも作る。
- 全員の所得を2倍にしたデータ：分布全体が等倍になったときの影響を調べる
- 全員に100万円ずつ加えたデータ：分布全体が右にシフトしたときの影響を調べる
- 任意の所得を受け取る人の人数を2倍にする：人口増加の影響を調べる
これらのデータを作り、それぞれの平均値と中央値を確認してみよう。
## 分布全体の等倍：各人の所得を2倍にする
incomes2 <- incomes * 2
(mean.inc2 <- mean(incomes2))## [1] 1059.647(median.inc2 <- median(incomes2))## [1] 880.1193## 分布全体のシフト：各人に100万円を加える
incomes3 <- incomes + 100
(mean.inc3 <- mean(incomes3))## [1] 629.8236(median.inc3 <- median(incomes3))## [1] 540.0597## 人口を2倍にする
incomes4 <- c(incomes, incomes)
(mean.inc4 <- mean(incomes4))## [1] 529.8236(median.inc4 <- median(incomes4))## [1] 440.0597作ったデータを CSV 形式で保存する。
df$income2 <- incomes2
df$income3 <- incomes3
write.csv(df, file = "fake-incomes.csv", row.names = FALSE)不平等の測度
ここでは、様々な格差測度で上で作ったデータの不平等度を確認する。 計算式は、授業のスライドおよび参考文献で確認すること。
範囲
まず、範囲を計算するための関数を定義する。
range <- function(x) {
## Given a vector (of incomes),
## return the Range (of incomes)
E <- (max(x) - min(x)) / mean(x)
return(E)
}この関数を、データに当てはめてみよう。
range(incomes)## [1] 3.960277range(incomes2)## [1] 3.960277range(incomes3)## [1] 3.331486range(incomes4)## [1] 3.960277この測度にはどのような特徴がある？
相対平均偏差
相対平均偏差を計算する関数を定義する。
rel_mean_dev <- function(x) {
## Given a vector (of incomes),
## reuturn the Relative Mean Deviation
M <- sum(abs(x - mean(x))) / (length(x) * mean(x))
return(M)
}この関数を使って各データの不平等度を測ってみよう。
rel_mean_dev(incomes)## [1] 0.5657275rel_mean_dev(incomes2)## [1] 0.5657275rel_mean_dev(incomes3)## [1] 0.4759044rel_mean_dev(incomes4)## [1] 0.5657275この測度にはどのような特徴がある？
分散
分散の計算はvar() 関数でできるが、var()は不偏分散を返すので、 ここでは参考文献の定義通りの計算を行う関数を作る。
pop_var <- function(x) {
## Given a vector (of incomes),
## return the population variance
return(var(x) * (length(x) - 1) / length(x))
}この関数を使って各データの不平等度を測ってみよう。
pop_var(incomes)## [1] 151672.2pop_var(incomes2)## [1] 606688.9pop_var(incomes3)## [1] 151672.2pop_var(incomes4)## [1] 151672.2この測度にはどのような特徴がある？
変動係数
変動係数を計算する関数を定義する。
coef_var <- function(x) {
## Given a vector (of incomes),
## returtn the coefficient of variation
return(sqrt(pop_var(x)) / mean(x))
}この関数を使って各データの不平等度を測ってみよう。
coef_var(incomes)## [1] 0.7350582coef_var(incomes2)## [1] 0.7350582coef_var(incomes3)## [1] 0.6183496coef_var(incomes4)## [1] 0.7350582この測度にはどのような特徴がある？
対数標準偏差
対数標準偏差を計算する関数を定義する。
sd_log <- function(x) {
## Given a vector (of incomes)
## return the standard deviation of logarithm
H <- sqrt(sum((log(x) - log(mean(x)))^2 / n))
return(H)
}この関数を使って各データの不平等度を測ってみよう。
sd_log(incomes)## [1] 0.9902194sd_log(incomes2)## [1] 0.9902194sd_log(incomes3)## [1] 0.6486039sd_log(incomes4)## [1] 1.400382この測度にはどのような特徴がある？
相対平均格差
相対平均格差を計算する関数を定義する。
rel_mean_dif <- function(x) {
## Given a vector (of incomes),
## return the relative mean difference
dd <- expand.grid(x, x)
sum(abs(dd[, 1] - dd[, 2])) / (length(x)^2 * mean(x))
}この関数を使って各データの不平等度を測ってみよう。
rel_mean_dif(incomes)## [1] 0.7814318rel_mean_dif(incomes2)## [1] 0.7814318rel_mean_dif(incomes3)## [1] 0.6573602rel_mean_dif(incomes4)## [1] 0.7814318この測度の特徴は？
ジニ係数
ジニ係数を計算する関数を定義する。
gini <- function(x) {
## Given a vector (of incomes),
## return the Gini coefficient
rel_mean_dif(x) / 2
}この関数を使って各データの不平等度を測ってみよう。
gini(incomes)## [1] 0.3907159gini(incomes2)## [1] 0.3907159gini(incomes3)## [1] 0.3286801gini(incomes4)## [1] 0.3907159この測度の特徴は？
ここで、ローレンツ曲線を描いてジニ係数を視覚的に確認してみよう。 上の結果から、income, income2, income4 のジニ係数は同じことがわかるので、 ローレンツ曲線が一致することが推測される。
cum.inc <- rep(NA, n + 1)
cum.inc2 <- rep(NA, n + 1)
cum.inc3 <- rep(NA, n + 1)
cum.inc4 <- rep(NA, 2*n + 1)
cum.inc[1] <- cum.inc2[1] <- cum.inc3[1] <- cum.inc4[1] <- 0
for (i in 2:n) {
cum.inc[i] <- cum.inc[i - 1] + sort(incomes)[i - 1]
cum.inc2[i] <- cum.inc2[i - 1] + sort(incomes2)[i - 1]
cum.inc3[i] <- cum.inc3[i - 1] + sort(incomes3)[i - 1]
}
for (i in 2:(2*n)) {
cum.inc4[i] <- cum.inc4[i - 1] + sort(incomes4)[i - 1]
}
plot((0:n) / n, cum.inc / sum(incomes), type = "l", col = "black",
ylim = c(0, 1), main = "", ylab = "", xlab = "")
par(new = TRUE)
plot((0:n) / n, cum.inc2 / sum(incomes2), type = "l", col = "orange",
ylim = c(0, 1), main = "", ylab = "", xlab = "")
par(new = TRUE)
plot((0:n) / n, cum.inc3 / sum(incomes3), type = "l", col = "royalblue",
lwd = 2, ylim = c(0, 1), main = "", ylab = "", xlab = "")
par(new = TRUE)
plot((0:(2*n)) / (2*n), cum.inc4 / sum(incomes4), type = "l", col = "tomato",
lwd = 2, ylim = c(0, 1),
main = "ローレンツ曲線", ylab = "所得の割合", xlab = "人口の割合")
abline(a = 0, b = 1, lwd = 2)
abline(h = c(0, 1), v = c(0, 1), col = "gray")
legend(x = .001, y = .95, title="データセット", lty = 1, lwd = 2,
col = c("tomato", "royalblue"),
legend = c("incomes, incomes2, incomes4", "income3"))