R言語を用いて回帰分析（S字曲線回帰）を行ってみた ～エストニアにおける電子投票拡散プロセスの成長モデリング例〜
Tere！
雪降る北欧でブルブル震えながら、数量経済学などを勉強しているとみたです！
今回は、エストニアにおける電子投票拡散プロセスの成長モデリングを行うために、R言語を用いてS字曲線回帰を行ってみました！
そしてその過程を備忘録として書いておきます。
（R言語を用いたS字曲線回帰について記述している日本語のブログを見つけられなかったので…）
文系の方でも、研究・論文を書く際などに回帰分析を行うことが多いと思うのですが、R言語を利用するとスピーディーに描画できるので、よかったら参考にしてみてください！
最終目標
エストニアにおける電子投票を採用している8つ選挙に関するデータを使用し、
（恒久的に成長することがない天井のある対象の場合（～率など）は、S字曲線回帰を行うのが良いケースが多いのではないのでしょうか。ちなみに、今回求められた線形成長モデルだと24回目には電子投票率が100パーセントを超えてしまいます。笑）
手順
今回はR言語を用いた回帰分析の備忘録なので、遠回りになりますが、
線形モデルを作成した後に、S字モデルを出力します。
したがって、以下のように基本的な回帰分析の流れをアレンジしてコードを書いていきます。
①データをインプットし、２変数のデータをプロットした散布図を作成
まず、電子投票者のシェアと選挙に関するデータをリンクから直接収集します。
# Import the data
evote=read.table(url("http://www.ut.ee/kristjan.vassil/wp-content/evote_aggregated_workshop.csv"),
header = T,sep=";",dec=",")
そして、データをプロットさせ、散布図を作成。
plot(evote$election,evote$evoter_share,xlab="election",ylab="Share",col="skyblue",pch=16,ylim=c(0,0.4),cex=2)
②一次関数を仮定した後、係数を求め、回帰式を決定
今回の対象は電子投票の拡散プロセスなので、
evoters=b0+b1⋅election と方程式を仮定して、
この一次関数を、下のコードを入力することで、データにフィットさせます。
# Run the regression
linear_model=lm(evoter_share~election, data=evote)
# Get parameters of the function
coef(linear_model)
すると、
## (Intercept) election
## -0.009857143 0.042523810
という結果が出てきました。
これによって、
y切片（b０）は、-0.009857143
傾き(b1)は、0.042523810と分ります。
ということで、
# compute the fitted values
predicted_linear=-0.009857143 + 0.042523810*evote$election
# alternatively we can use built-in function
# predict(linear_model,newdata=data.frame(election=evote$election)
# how the vector predicted_linear looks like
predicted_linear
を入力して、予測できるそれぞれの選挙の値を求めます。
## [1] 0.03266667 0.07519048 0.11771429 0.16023810 0.20276191 0.24528572
## [7] 0.28780953 0.33033334
このような結果が求められました。
③線形関数グラフを出力（平均絶対誤差（MAE）も求める）
必要なデータが揃ったら、以下のコードでグラフを出力させます！
plot(evote$election,evote$evoter_share,xlab="election",ylab="Share",col="skyblue",pch=16,ylim=c(0,0.4),cex=2)
lines(evote$election,predicted_linear,lwd=2,lty="dashed")
いい感じに描けました。
ラインがデータクラウドの上下をどのように通過するかを見てみると、遠く離れた点はありませんね。
これは、電子投票の増加が8つの選挙にわたってかなり直線的であることを意味しています。
つまり、電子有権者の選挙ごとの増加は、ほぼ一定です。
ついでに、後で比較するため、
適合度（この関数がデータにどの程度適合しているか）も計算してみましょう。
具体的には実際のシェアと予測されたシェアの間の平均絶対差を求めます。
このような適合度は平均絶対誤差（MAE）と呼ばれ、値が小さいほどモデルのデータへの適合度が高くなります。
MAE=mean(abs(evote$evoter_share-predicted_linear))
MAE
と入力すると、
## [1] 0.02367857
と出力されました。MAEは0.024ですね。
平均2.4％の絶対誤差があると解釈できます。
④対数ロジスティック関数（S曲線）を出力
最終目標のパートでも書いたように、今回の対象のグラフは右肩上がりにずっと伸び続けることはないので、線形成長モデルは将来的にはうまく機能しなくなります。
（ちなみに、上記の線形成長モデルだと24回目には電子投票率が100パーセントを超えてしまいます笑）
よって、対数ロジスティック関数（S曲線）を出力します。
y=a/(1+ce^(-b⋅log(x)), aを0.6（投票率は60パーセントまで伸びる）と仮定し、
loglogistic06=nls(y~0.6/(1+c*exp(-b*log(x))),start=list(b=0.2,c=20))
coef(loglogistic06)
から
## b c
## 1.502672 20.364245
という結果が出てきたので、これをグラフ化します。
predicted_loglogistics06=0.6/(1+20.36*(exp(-1.50*log(t))))
plot(t,predicted_loglogistics06,type="l",lwd=2,ylim=c(0,1),xlab="election",ylab="Share",lty="dashed")
points(evote$election,evote$evoter_share,col="skyblue",pch=16,cex=2)
ちなみに、MAEは、
MAE=mean(abs(evote$evoter_share-predicted_loglogistics06[1:8]))
MAE
より、## [1] "0.03154756" と出てきます。
