【第3章測定】練習問題3.9.3「国連総会における投票」

1.データセット・元論文

(1)データセット
  ・第3章の練習問題を解く際に使うデータセットは、以下のリンク先からダウンロードできる。

(2)元論文
  ・この練習問題の元論文を参考のためリンクを貼っておく。

2.練習問題3.9.3「国連総会における投票」

(1)1980年/2000年の理想点の分布
  ①中央値は1980年が-0.09で、2000年が−0.35と小さくなっている
  ②一方、0・10パーセントタイルや70・80・100パーセントタイルが
   大きくなっている
  ③そのため、全体の分布としては1980年から2000年にかけて右方向に
   移動していると思われる

> unvoting <- read.csv("unvoting.csv")
> dim(unvoting)
[1] 9120    6

> summary(unvoting)
      Year        CountryAbb        CountryName     idealpoint        PctAgreeUS    
 Min.   :1946   AFG    :  66   Afghanistan:  66   Min.   :-2.6552   Min.   :0.0000  
 1st Qu.:1972   ARG    :  66   Argentina  :  66   1st Qu.:-0.6406   1st Qu.:0.1395  
 Median :1987   AUL    :  66   Australia  :  66   Median :-0.1644   Median :0.2400  
 Mean   :1985   BEL    :  66   Belarus    :  66   Mean   : 0.0000   Mean   :0.2960  
 3rd Qu.:2001   BLR    :  66   Belgium    :  66   3rd Qu.: 0.7968   3rd Qu.:0.3902  
 Max.   :2012   BOL    :  66   Bolivia    :  66   Max.   : 3.0144   Max.   :1.0000  
                (Other):8724   (Other)    :8724                     NA's   :1       

 PctAgreeRUSSIA  
 Min.   :0.0000  
 1st Qu.:0.5053  
 Median :0.6567  
 Mean   :0.6219  
 3rd Qu.:0.7424  
 Max.   :1.0000  
 NA's   :5  

> ip1980 <- unvoting[unvoting$Year == 1980,]
> ip2000 <- unvoting[unvoting$Year == 2000,]

> par(mfrow = c(1,2))

> hist(ip1980$idealpoint,freq = FALSE,
+      breaks = seq(from = -3,to = 3,by = 0.5),ylim = c(0,0.7),xlab = "idealpoint",main = "1980 idealpoint")
> abline(v = median(ip1980$idealpoint),col = "red",lty = 2)

> hist(ip2000$idealpoint,freq = FALSE,
+      breaks = seq(from = -3,to = 3,by = 0.5),ylim = c(0,0.7),xlab = "idealpoint",main = "2000 idealpoint")
> abline(v = median(ip2000$idealpoint),col = "red",lty = 2)

> round(quantile(ip1980$idealpoint,probs = seq(from=0,to=1,by=0.1)),2)
   0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
-2.36 -1.38 -0.63 -0.30 -0.19 -0.09  0.04  0.22  0.47  1.28  2.32 

> round(quantile(ip2000$idealpoint,probs = seq(from=0,to=1,by=0.1)),2)
   0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
-1.70 -0.99 -0.75 -0.63 -0.49 -0.35 -0.05  0.34  0.94  1.14  2.61 

画像1

(2)アメリカ・ロシア(ソ連)の投票との一致割合
  
①アメリカの投票の一致割合の平均値は低下傾向にある
  ②一方でロシアの投票の一致割合の平均値は上昇傾向にある
  ③これはアメリカの投票と一致する国が減少していることが理由と
   思われるため、アメリカの孤立は次第に高まっていると言える。

> US_time <- tapply(unvoting$PctAgreeUS,unvoting$Year,mean,na.rm =TRUE)
> RU_time <- tapply(unvoting$PctAgreeRUSSIA,unvoting$Year,mean,na.rm =TRUE)

> summary(US_time)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.1169  0.2071  0.3112  0.3381  0.4435  0.6594 

> summary(RU_time)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.2795  0.4852  0.6075  0.5872  0.6898  0.8721 

> par(mfrow=c(1,1))
> plot(names(US_time),US_time,type ="l",ylim = c(0.1,0.9),col ="blue",lwd = 2,xlab = "year",ylab = "PctAgree mean",main = "PctAgreeUS/RUSSIA")
> lines(names(RU_time),RU_time,col ="red",lwd = 2)
> text(1950,0.7,"USA",col = "blue")
> text(1950,0.2,"RUSSIA",col = "red")

画像2

(3)米国・ロシア(ソ連)の理想点の推移
  
①米国の理想店は徐々に上昇している傾向にある
  ②一方、ロシアは1980〜90年に一気に上昇し、その後低下して横ばい
  ③全ての国々の理想点の中央値は徐々に低下傾向にある
  ④米国・ロシアとの投票率の一致割合の動きを説明する際は、アメリカ
   と各国の理想点の乖離によりアメリカの孤立が進んだこともあるが、
   相対的にはロシアの理想点の変化が要因として大きいと思われる。

> par(mfrow =c(1,1))
> plot(names(ip_all),ip_all,type = "l",xlab = "year",ylab = "idealpoint",ylim = c(-3,3),main = "Idealpoint US/RUSSIA")
> lines(unvoting$Year[unvoting$CountryName=="United States of America"],unvoting$idealpoint[unvoting$CountryName=="United States of America"],type = "l",col="blue")
> lines(unvoting$Year[unvoting$CountryName=="Russia"],unvoting$idealpoint[unvoting$CountryName=="Russia"],type = "l",col="red")

> text(1950,0,"median")
> text(1950,2.5,"USA",col ="blue")
> text(1950,-1.5,"RUSSIA",col ="red")

画像3

(4)旧ソ連国の理想点・アメリカとの投票一致割合
  ①旧ソ連諸国(FSU)は、理想点とアメリカとの投票一致の相関係数が
   0.972という高い。
  ②また、非旧ソの諸国も、理想点とアメリカとの投票一致の相関係数が
   0.883と高くなっている。
  ③両陣営とも類似の場所に分布しており、理想点・アメリカとの投票
   一致がともに低いor高くなっている。

> FSU <- c("Estonia","Latvia","Lithuania","Belarus","Moldova",
+          "Ukraine","Armenia","Azerbaijan","Georgia","Kazakhstan",
+          "Kyrgyzstan","Tajikistan","Turkmenistan","Uzbekistan","Russia")

> unvoting$FSU_Flag <- NA

> n <- nrow(unvoting)
> for (i in 1:n) {
+   unvoting[i,7]<- ifelse(unvoting[i,3] %in% FSU,1,0)
+ }

> par(mfrow = c(1,1))
> plot(unvoting2012$idealpoint[unvoting2012$FSU_Flag == 1],unvoting2012$PctAgreeUS[unvoting2012$FSU_Flag == 1],main = "PctAgreeUSA idealpoint",xlab = "idealpoint",ylab = "PctAgreeUSA",col ="red",pch =16)
> points(unvoting2012$idealpoint[unvoting2012$FSU_Flag == 0],unvoting2012$PctAgreeUS[unvoting2012$FSU_Flag == 0],xlab = "idealpoint",ylab = "PctAgreeUSA",col ="blue",pch =17)
> text(-0.5,0.35,"FSU",col = "red")
> text(0.75,0.15,"Not FSU",col = "blue")

> cor(unvoting2012$idealpoint[unvoting2012$FSU_Flag == 1],unvoting2012$PctAgreeUS[unvoting2012$FSU_Flag == 1])
[1] 0.972859

> cor(unvoting2012$idealpoint[unvoting2012$FSU_Flag == 0],unvoting2012$PctAgreeUS[unvoting2012$FSU_Flag == 0])
[1] 0.8832068

画像4

(5)旧ソ連諸国(FSU)/非旧ソ連諸国(NotFSU)の理想点の変化
  ①旧ソ連諸国の理想点は1980年ごろまで-2前後のまま横ばい。1980年
   から2000年まで上昇し1付近まで到達。その後、低下傾向。
  ②非旧ソ連諸国は1990年まで一貫して低下傾向で、それ以降横ばい。
  ③ベルリン崩壊後の1990年代に、両陣営の中央値は逆転して以降、
   旧ソ連諸国の方が高い理想点のまま。

> par(mfrow=c(1,1))
> plot(names(FSU_time),FSU_time,type ="l",col ="red",ylim = c(-2.75,1.75),xlab = "year",ylab = "idealpoint median",main = "idealpoint FSU/NotFSU")
> lines(names(NotFSU_time),NotFSU_time,col ="blue")
> text(1950,0,"NotFSU",col = "blue")
> text(1950,-1.5,"FSU",col = "red")
> abline(v=1989,lty=2)​

画像5

(6)理想点とアメリカとの投票一致割合のクラスター化
  ①2012年のグラフをみると、1989年よりも、直線的に各クラスターの点
   が分布している。
  ②また、2つのクラスターの中心点の距離も2012年の方が1989より短く
   両クラスターは接近していると言える。

> unvoting1989 <- unvoting[unvoting$Year == 1989,]
> ideal_PctAgreeUSA1989 <- cbind(unvoting1989$idealpoint,unvoting1989$PctAgreeUS)
> ideal_PctAgreeUSA2012 <- cbind(unvoting2012$idealpoint,unvoting2012$PctAgreeUS)

> k1989two.out <- kmeans(ideal_PctAgreeUSA1989,centers = 2,nstart = 5)
> k2012two.out <- kmeans(ideal_PctAgreeUSA2012,centers = 2,nstart = 5)

> par(mfrow =c(1,2))
> plot(ideal_PctAgreeUSA1989,col =k1989two.out$cluster + 1 ,xlim = c(-2,3),xlab = "idealpoint",ylab = "PctAgreeUS",main = "1989")
> points(k1989two.out$centers,pch=8,cex=2)

> plot(ideal_PctAgreeUSA2012,col =k2012two.out$cluster + 1 ,xlim = c(-2,3),xlab = "idealpoint",ylab = "PctAgreeUS",main = "2012")
> points(k2012two.out$centers,pch=8,cex=2)

> k1989two.out$centers
        [,1]       [,2]
1 -0.5449349 0.08232694
2  1.2642992 0.28448126

> dist(k1989two.out$centers)
         1
2 1.820493

> k2012two.out$centers
        [,1]      [,2]
1 -0.6714717 0.1641903
2  0.9765320 0.3885653

> dist(k2012two.out$centers)
         1
2 1.663208

画像6

3.練習問題を解いた感想

 ・クラスター分析の結果から知見を導くことが難しいと感じた。その理由は、量的な差異ではなく、あくまでビジュアルの特徴から主張に繋げる必要があるからだと思う。

 ・ビジュアルに明確な特徴があればラクダが、今回は何とも言い辛かった。分析手法や分析対象の背景に関してより深くなれば、分かりやすいストレートな主張を導く手助けになるかもしれないので地道に研鑽を積みたい。


この記事が気に入ったらサポートをしてみませんか?