StatsBeginner: 初学者の統計学習ノート

統計学およびR、Pythonでのプログラミングの勉強の過程をメモっていくノート。たまにMacの話題。

メモ:Rのts型のインデックス(年・四半期・月情報)を文字列として取り出す

Rのts型(時系列型)のデータについているインデックス("1980 Q1"みたいな)を、文字列情報として取り出す方法が、ぱっとググって分からなかったのですが、とりあえず以下のようにしたらできました。

> library(vars)
> data(Canada)
> 
> t <- as.yearqtr(index(Canada))
> head(t)
[1] "1980 Q1" "1980 Q2" "1980 Q3"
[4] "1980 Q4" "1981 Q1" "1981 Q2"
> class(t)
[1] "yearqtr"
> 
> t <- as.character(t)
> head(t)
[1] "1980 Q1" "1980 Q2" "1980 Q3"
[4] "1980 Q4" "1981 Q1" "1981 Q2"
> class(t)
[1] "character"


たぶん、元データが四半期ではなく月単位のデータだったら、yearqtrの部分をyearmonにするのだと思います。

なぜ「p < .05」で「統計的に有意」なのか?――5%基準の由来について

 以前も書いたんですが、p値が0.05を下回るかどうかにとらわれる慣習を問題視する人が最近は増えてきていて、たしかにその理由はよく理解できる一方で、p値が過剰にバッシングされている気もします。しかしそんなことより、個人的には、なぜ統計的有意性の判定基準が多くの分野で慣例的に0.05(5%)になっているのかという、その由来のほうが気になります。


 帰無仮説が正しいときにそれを棄却してしまう(第一種の過誤と呼ばれる)危険率が5%未満であれば「統計的に有意」と言われるわけですけど、この5%という閾値に客観的な必然性がないことは誰でも分かりますね。しかし実際には様々な分野で、5%基準で検定結果を報告(あわせて1%基準や10%基準での有意性も報告されたりはする)している研究が多数存在するわけです。


 この5%という基準の由来について、フィッシャーが「20年に1回ぐらいは間違っても研究者として許されるだろ」と発言したのが始まりであるという説をよく聞きます。フィッシャーは植物学者なので実験を1年に1回というペースでしか行うことができず、「20回に1回(20年に1回)ぐらいは間違った結論を出しても許してほしいよな!」と言ったという話です。
 ただ、これは単なる都市伝説だったようです。


 「5%基準」の由来を調べた論文を以前読んだのですが、
 On the Origins of the .05 Level of Statistical Significance


 アブストラクトを適当に訳しておくと、

フィッシャーの『Statistical Methods for Research Workers』よりも昔の、統計や確率に関する文献を調査すると、確かに統計的有意性に関する"5%"基準を正式に唱えたのはフィッシャーが最初であることは確かなのだが、この考え方自体はもっと昔に遡ることが分かる。偶然性の仮説を棄却するための習慣的な基準は、世紀の変わり目ぐらいから徐々に形成されていった。統計的有意性に関する初期の言及は、「確率誤差」の観点から行われている。これら初期の習慣が、フィッシャーによって採用され言及されたのである。


 この論文によると、昔は統計的有意性の判断基準として「確率誤差(ここに解説があった。)3つ分」という基準がよく使われていたらしく、これは正規分布なら「標準偏差2つ分」ぐらいに相当し、だいたい95%ぐらいになる。これが「5%基準」の由来のようです。
 つまり、確率誤差3つ分(とか標準偏差2つ分)であれば計算しやすいというか、扱いやすいので、そのへんを基準にしてものを考える習慣が5%基準に転じたのであるということのようです。

Macでひらがな・カタカナの濁点・半濁点が分離してしまったのを元に戻すスクリプト

昨日のエントリで、テキストエディタの「CotEditor」のスクリプト機能の使い方を書きました。その機能をつかって、濁点・半濁点が分離してしまったテキストを元に戻すツールを作ります。


こういうやつをなんとかしたいわけです。
f:id:midnightseminar:20190816235923p:plain



原因がよくわからないし、悩まされているのは私だけなのかも知れないのですが、Macを使っていると、PDF上から文字をコピペしたときに、濁音・半濁音のひらがな・カタカナが、1文字ではなく清音+濁点or半濁点という2文字に分離してしまう現象があります。


たとえば、Wordで以下のように入力します。ここの「ぶ」は普通の「ぶ」1文字です。
f:id:midnightseminar:20190817000024p:plain


これを、PDFで保存して、PDF上の文字列をコピーします。
f:id:midnightseminar:20190817000103p:plain


そして、たとえばエクセルに貼り付けます。比較のために、Wordからコピーした分も貼り付けてあります。
f:id:midnightseminar:20190817000119p:plain


このように、「ぶ」が「ふ」と「゛」に分かれてしまいました。
これは困るので、テキストファイル上にペーストした上で、CotEditorのスクリプトで置換できるようにしておきます。


具体的には、スクリプトは以下のように書きました。
なんかもっと美しい書き方があるような気がしてならないのですが、私にはわからないので、濁音・半濁音を全部並べることにしました。

#!/usr/bin/env python
# -*- coding: utf-8 -*-
# %%%{CotEditorXInput=AllText}%%%
# %%%{CotEditorXOutput=ReplaceAllText}%%%

import sys
import re

kana_before = ["が","ぎ","ぐ","げ","ご","ざ","じ","ず","ぜ","ぞ","だ","ぢ","づ","で","ど","ば","び","ぶ","べ","ぼ","ぱ","ぴ","ぷ","ぺ","ぽ","ガ","ギ","グ","ゲ","ゴ","ザ","ジ","ズ","ゼ","ゾ","ダ","ヂ","ヅ","デ","ド","バ","ビ","ブ","ベ","ボ","パ","ピ","プ","ペ","ポ"]

kana_after = ["が","ぎ","ぐ","げ","ご","ざ","じ","ず","ぜ","ぞ","だ","ぢ","づ","で","ど","ば","び","ぶ","べ","ぼ","ぱ","ぴ","ぷ","ぺ","ぽ","ガ","ギ","グ","ゲ","ゴ","ザ","ジ","ズ","ゼ","ゾ","ダ","ヂ","ヅ","デ","ド","バ","ビ","ブ","ベ","ボ","パ","ピ","プ","ペ","ポ"]

# 標準入力でテキストをまるごと受け取る
all_text = sys.stdin.read()

# 1個1個置き換えていく
for i in range(len(kana_before)):
	all_text = re.sub(kana_before[i], kana_after[i], all_text)

sys.stdout.write(all_text)


スクリプトの冒頭ですが、1行目はPythonインタープリタの置き場。
2行目は文字コードの宣言で、これを書いてないとエラーが出ました。(私はテキストファイルは基本的にUTF-8でしか使わないので、utf-8と書いておいた。)
3行目は、テキストファイル内の文字を全部取るという意味です。これが標準入力経由でPythonに渡ります。
4行目は、テキストファイル内の文字を全部置換するという意味です。標準出力経由でPythonからCotEditorに渡される文字列に置き換わります。


今回はとくにショートカットは指定しないことにしました。つまりスクリプトは、単に「dakuten.py」という名前で、CotEditorのスクリプトフォルダに入れてあります。
するとこのように、ショートカットキー無しで、一覧から選択する形で実行できるようになります。
f:id:midnightseminar:20190816234554p:plain


実際やってみたら、無事置き換わってくれました。

CotEditor(テキストエディタ)上の選択範囲をタグで囲むショートカットをPythonで書く

Macでテキストエディタを使うならCotEditorがいいと昔から思っているのですが、CotEditorには、ショートカットの処理とか、あるいは編集中のテキスト上にファイルをドラッグ&ドロップしたときに自動的にテキストを入力するような処理を、自分で追加していける機能があります。
今回、選択範囲をで囲むショートカットをPythonで書いて、追加してみました。
単にHTMLのタグを入れたいだけなら、ふつうに入力支援機能のあるエディタを使えばいいですが、スクリプトを自分で書けるといろいろ柔軟なショートカットを設定できますね。
やりたいことはすごい簡単なのに、ネットでパッとわかる資料がなかったのでメモしておきます。

CotEditorのスクリプト機能

ちなみに、ショートカットでカーソルの位置に文字列を挿入するだけの処理なら、CotEditorの「環境設定」→「キーバインド」→「スニペット」で設定できるのですが、「文字列をタグで挟む」といった複雑なことはできないようです。
スクリプトの機能だと、bashやPythonやJavaScriptなどで書いたスクリプトを組み込むことができ、ショートカットキーによってそのスクリプトを起動するような設定もできて便利です。


具体的なやり方は、CotEditorのメニューの「ヘルプ」→「CotEditorスクリプトガイド」からマニュアルをみることができます。主に、

  • スクリプトメニューをカスタマイズする
  • UNIXスクリプトとの連携
  • CotEditorスクリプトのファイル名規則


といったページを見ておけばだいたいのことはわかると思います。
以下、実際にやってみます。

スクリプトを書く

まずスクリプトを書きますが、上記のマニュアルに書いてあるように、スクリプトの冒頭には、

  • python(インタープリタ)の置き場所
  • このスクリプトにやらせたい仕事は何なのか


をコメントで宣言してあげる必要があります。
たとえば今回書いたのは以下のようなスクリプトなんですが、

#!/usr/bin/env python
# %%%{CotEditorXInput=Selection}%%%
# %%%{CotEditorXOutput=ReplaceSelection}%%%

import sys
selected_text = sys.stdin.read()
output_text = '<B>' + selected_text  + '</B>'
sys.stdout.write(output_text )


1行目は、Pythonインタープリタの置き場所の指定です。もちろんここは「#!/usr/bin/python」とかでも動くのですが、envにしておくと、インタープリタの置き場所が違った場合(バージョン管理ツールを使っている場合など)でも適宜発見して起動してくれます(下記の記事のとおり)。
「#!/usr/bin/python」と「#!/usr/bin/env python」の違い - 座敷牢日誌


2行目は、CotEditor上で選択箇所の文字列をとってきますよ、という意味。「Selection」のところは、他にもいろいろな引数があって、マニュアルに載っています。


3行目は、選択箇所の文字列を置換しますよ、という意味。同じく、「ReplaceSelection」のところは、他にもいろいろな引数があります。


Pythonのコード自体は、標準入力経由で文字列を受け取って、適当に処理をして、標準出力でCotEditorに引き渡すという内容です。
Print関数でも引き渡せるのですが、末尾に改行が無駄に追加されてしまうので、標準出力のstdoutを使いました。
↓の記事に書いてあるように、print関数でもend引数を設定すれば末尾に改行のない状態で出力できるはずなのですが、やってみたところ、CotEditorから呼び出したときによくわからないエラーが出たので、とりあえず標準出力の関数を使っておきました。
Python Tips: 改行をうまく扱いたい - Life with Python

スクリプトを保存し、実行権限を与える

上述の内容のスクリプトを、今回は、


bolding.^~b.py


というファイル名にして、スクリプト置き場である、


~/Library/Application Scripts/com.coteditor.CotEditor


という場所に保存しました。


なお、ファイル名の「.^~b」の部分は、「control + option + B」というキー操作を意味しています。ルールはマニュアルの「CotEditorスクリプトのファイル名規則」をみればわかりますが、ファイル名内の記法によって、どのキーにスクリプトの処理を割り当てるかを指定するわけです。


そして、スクリプトを保存しただけではCotEditorからの実行権限がないので、ターミナルから、chmodで755などの権限設定を行う必要があります。

スクリプトを使ってみる

ここまでの作業を行うと、下記の画像のように、メニューのスクリプト一覧に今回つくったスクリプトが表示されます。


f:id:midnightseminar:20190815151100p:plain


ファイル名称を先程のようなルールに従って作っていなければ、ショートカットキーは割り当てられません。
その場合は、この一覧から選択することによって、スクリプトを実行することになります。


実際に文字列を選択して「control + option + B」下記のように、無事、テキストをタグで囲むことができました。


f:id:midnightseminar:20190815151224p:plain
f:id:midnightseminar:20190815151240p:plain

Rで連立方程式を解く練習(例:超小型の日本経済マクロ計量モデル)

先日、『gretlで計量経済分析』という本に載っている二段階最小二乗法の演習をRでやってみるエントリ(リンク)を書いたのですが、同じ本の次の章は「マクロ計量モデル入門」となっていて、1980年から2009年までの日本経済のデータを用い、5本の構造方程式と2本の定義式、7つの内生変数と9つの外生変数からなる超小型のマクロ計量モデルをつくるというものでした。
Rで連立方程式を解く方法の確認がてら、Rで実行してみます。
最近、研究室の学生にRの使い方をイチから教えてるのですが、これをさらに単純化して練習問題に使えるかも……?

データは本のサポートページからダウンロードできるものですが、「model.gdt」というファイルをgretlで読み込んでcsvで書き出したものを、Rに読み込ませて使いました。
 
 

準備

データは↓のようなイメージです(画像は一部です)。


f:id:midnightseminar:20190808022913p:plain

library(lmtest)
library(car)
library(nleqslv)

# パラメータ推定用データを読み込みます
d_macro <- read.csv('data/csv/model.csv', header=T)

# obsという最初の列の列名称を、なんとなく、YEARに変更しておきます
colnames(d_macro)[1] <- "YEAR"


元データは1980年から2009年までの日本のマクロ経済のデータですが、最大で「2期前」を取るラグ変数があることから、教科書では全て「1982年以降」のデータでパラメータを推定しているので、ここで1、2行目はカットしておきます。

d_macro <- d_macro[3:30,]

 
 

構造方程式(推計式)群のパラメータ推定

この章では、著者によると「内生性が顕著でなく、結果があまり違わないので、全て2SLSではなくOLSで推定する」とのことなので、それに合わせます。二段階最小二乗法にするなら先日のエントリの方法になりますが、そんなに手間は変わらないです。


内生変数になる「民間最終消費支出」「民間企業設備投資」「輸入」「民間可処分所得」「利子率」を推計する回帰モデルを作っていきます。
モデルの説明もコメントで書いておきますが、たとえば民間最終消費支出は、

### (1)民間最終消費支出
# CP = α + β1*YD_1 + β2*WH_1
# CP: 民間最終消費支出
# YD_1: 1期前の民間可処分所得
# WH_1: 1期前の家計金融資産残高

# 回帰分析でパラメータを推定
est1 <- lm(data=d_macro, formula=CP~YD_1 + WH_1)


こういうふうになります。
推定はもうこれでできているんですが、あとで連立方程式を解く処理のところで使いやすいように、predict()をラップして「説明変数を与えると、予測値(理論値)を吐き出す」ようにしておきます。

CP_fn <- function(YD_1, WH_1){
  YD_1 <- as.numeric(YD_1); WH_1 <- as.numeric(WH_1)
  prd <- predict(est1,data.frame(YD_1=YD_1, WH_1=WH_1))
  return(prd)
}


as.numeric()しているのは、事情があります。後でここには、外生変数をまとめたデータフレームから特定の行を抜き出したあとに列名称で値を探して入れることにしたのですが、データフレームの列名称を要素名として持ったままの数字を引っ張ってくると、ここでdata.frame()内での列名称指定が無視されてしまいました。
なので、ごちゃごちゃするけどas.numeric()を挟むことにしました。
なお、predict()関数には、newdataという引数にデータフレーム型でデータを与える必要があります。


他の変数についても同じようにやっていきます。

### (2)民間企業設備投資
# IP = α + β1*(GDP_1-GDP_2) + β2*INT_l1 + β3*IP_1
# IP, IP_1: 当期と1期前の民間企業設備投資
# GDP_1, GDP_2: 1期前と2期前の実質GDP
# INT: 利子率

est2 <- lm(data=d_macro, formula=IP ~ dGDP12 + INT_1 + IP_1)
IP_fn <- function(GDP_1, GDP_2, INT_1, IP_1){  # 引き算は中で計算する
  GDP_1 <- as.numeric(GDP_1); GDP_2 <- as.numeric(GDP_2)
  INT_1 <- as.numeric(INT_1); IP_1 <- as.numeric(IP_1)
  prd <- predict(est2,data.frame(dGDP12=(GDP_1-GDP_2), INT_1=INT_1, IP_1=IP_1))
  return(prd)
}

### (3)輸入
# IM = α + β1*IM_1 + β2*GDP
# IM, IM_1: 当期と1期前の輸入

est3 <- lm(data=d_macro, formula=IM ~ IM_1 + GDP)
IM_fn <- function(IM_1, GDP){
  IM_1 <- as.numeric(IM_1); GDP <- as.numeric(GDP)
  prd <- predict(est3,data.frame(IM_1=IM_1, GDP=GDP))
  return(prd)
}

### (4)民間可処分所得
# YD = α + β1*(GDP-TAX)
# TAX: 租税

GDPTAX <- d_macro$GDP - d_macro$TAX
est4 <- lm(data=d_macro, formula=YD ~ GDPTAX)
YD_fn <- function(GDP, TAX){  # 引き算は中で計算する
  GDP <- as.numeric(GDP); TAX <- as.numeric(TAX)
  prd <- predict(est4, data.frame(GDPTAX=(GDP-TAX)))
  return(prd)
}

### (5)利子率(LM方程式)
# INT = α + β1*ln(GDP) + β2*ln(M2CDN)
# M2CDN: マネーストック

est5 <- lm(data=d_macro, formula=INT ~ l_GDP + l_M2CDN)
INT_fn <- function(GDP, M2CDN){  # 対数化は中で
  GDP <- as.numeric(GDP); M2CDN <- as.numeric(M2CDN)
  prd <- predict(est5, data.frame(l_GDP=log(GDP), l_M2CDN=log(M2CDN)))
  return(prd)
}


ところで、5番目の利子率の式は、教科書とはやり方を変えています。
GDPも内生変数なので、ln(GDP)で説明されるINTはGDPと同時に決まるという構造ですが、gretlでは連立方程式を解かせるときに、「内生変数として計算されたGDPのlogを取って、別の内生変数の説明変数にする」という処理が書けない(?)らしいので、教科書ではちょっと変なやり方で代用していました。


どういうやり方かというと、推定用元データ上は、ln(GDP)はエクセルか何かで予め計算してあって、元データのテーブルに一つの変数として入っているのですが、その上でまず、
ln(GDP)〜GDP
という回帰分析を行っています。(つまり、対数を取る処理を線形モデルで代用している…)
この回帰分析の結果を使って、GDPをln(GDP)ではない何かに変形したものを、疑似ln(GDP)としてINTの説明変数に入れているわけです。


しかしここではそんなことはせずに、普通に、GDPのlogをとってそれをINTの予測に用いるようにしておきます。
なので、教科書とは、最終の結果が少しずれます。(ここを教科書どおりにすると最終結果がピッタリ一致することは確認しました。)
 
 

lmの結果をまとめてCSV出力する

べつにやる必要はないのですが、上の回帰分析の結果をまとめて表にして出力する関数も書いておきます。

# 関数定義
save_lm_results <- function(model, model_name='none'){
  sum     <- summary(model)
  coef    <- sum$coefficients
  R2      <- c(sum$r.squared, NA, NA, NA)
  Adj_R2  <- c(sum$adj.r.squared, NA, NA, NA)
  # ダービンワトソン検定(p<.05だと系列相関あり)
  DW_test <- c(dwtest(model)$statistic, NA, NA, dwtest(model)$p.value)
  # Breusch-Godfrey検定(p<.05だと系列相関あり)
  BG_test <- c(bgtest(model)$statistic, NA, NA, bgtest(model)$p.value)
  results <- rbind(coef,R2, Adj_R2, DW_test, BG_test)
  
  if(length(model$coefficients)-1 >= 2){  # 説明変数が2個以上あるならVIFを計算する
    VIF <- c(NA, vif(model), NA, NA, NA, NA)
  } else{
    VIF <- c(NA, NA, NA, NA, NA, NA)
  }
  
  results <- cbind(results, VIF)
  
  # モデル名を指定しない場合はformulaをファイル名にする
  if(model_name=='none'){
    output_name <- as.character(paste(model$call$formula[2], model$call$formula[1], model$call$formula[3], sep=''))
  } else{
    output_name <- model_name
  }
  write.csv(results, paste('results/lm_result_', output_name, '.csv', sep=""), row.names=TRUE, quote=FALSE)
}

# 実行(空のリストがコンソール上に出力されるけど気にしない)
lapply(X=list(est1, est2, est3, est4, est5), FUN=save_lm_results)

 
 

恒等式(定義式)群の定義

マクロモデル中の定義式(パラメータを推定するのではなく変数間の定義上の関係を記述するもの)を記述しておきます。

### (6)国内総生産
# GDP = CP + IP + CG + IG + IH + ST + EX - IM
# CG: 政府最終消費支出
# IG: 公的資本形成
# IH: 住宅投資
# ST: 在庫投資
# EX: 輸出
GDP_fn <- function(CP, IP, CG, IG, IH, ST, EX, IM){
  def <- CP + IP + CG + IG + IH + ST + EX - IM
  return(def)
}

### (7)名目国内総生産
# GDPN = GDP*GDPDEF/100
# GDPDEF: GDPデフレータ
GDPN_fn <- function(GDP, GDPDEF){
  def <- GDP*GDPDEF/100
  return(def)
}

 
 

外生変数テーブルを作る

さてここからは、推定されたパラメータをつかってシミュレーションを行っていきます。
外生変数をどうやって与えようかなと思ったのですが、なんとなく、データフレームに整理しておいて、そのうち1行を選択して与えると、全ての外生変数を読み込んで内生変数を導いてくれるような組み立てがわかりやすいかなと思い、そうしてみました。


まず、パラメータの推定に使ったデータから、外生変数として使用する変数群を抜き出してまとめます。

Exog_df <- d_macro[,c(
  'YEAR',
  'YD_1', 'WH_1',                     # CPの説明変数(他との重複は除く)
  'GDP_1', 'GDP_2', 'INT_1', 'IP_1',  # IPの説明変数( 〃 )
  'IM_1',                             # IMの説明変数( 〃 )
  'TAX',                              # YDの説明変数( 〃 ) 
  'M2CDN',                            # INTの説明変数( 〃 )
  'CG', 'IG', 'IH', 'ST', 'EX',       # GDPの定義に使う( 〃 )
  'GDPDEF'                            # GDPN(名目GDP)の定義に使う( 〃 )
)]

# 1982年以降のデータだけ抜き出す
Exog_df <- subset(Exog_df, Exog_df$YEAR >= 1982)


上記で抜き出した外生変数のテーブルには、外生というよりも「先決内生変数」と言われるものが混じっていて、たとえば「1期前のGDP」であれば、前のサイクルで推定された内生変数であるGDPの値を、当期の外生変数のようにして使うというものです。
先決内生変数については、見間違えないように、必要なもの以外はデータをNAに置き換えておくことにします。
1期のラグ変数なら1982年だけ残し、2期のラグ変数なら1983年まで残しておく必要があります。

# NAに置き換える関数
remove_future_data <- function(df, valname, lag){
  colnum <- which(colnames(df)==valname)
  df[(lag+1):nrow(df),colnum] <- rep(NA, (nrow(df)-lag))
  return(df)
}

# 先決内生変数の使わない値を置き換え
Exog_df <- remove_future_data(df=Exog_df, valname='IP_1', lag=1)
Exog_df <- remove_future_data(df=Exog_df, valname='IM_1', lag=1)
Exog_df <- remove_future_data(df=Exog_df, valname='YD_1', lag=1)
Exog_df <- remove_future_data(df=Exog_df, valname='INT_1', lag=1)
Exog_df <- remove_future_data(df=Exog_df, valname='GDP_1', lag=1)
Exog_df <- remove_future_data(df=Exog_df, valname='GDP_2', lag=2)

 
 

内生変数の値を得る

「外生変数を与えると、連立方程式を解いて内生変数を返してくれる」という処理を書いていきます。
連立方程式を解くnleqslv()の使い方は次の通り。
未知数が並んだベクトルだけを引数に取る関数(f0とする)を定義して、nleqslv()に、関数foと「未知数の初期値ベクトル」を与えると、未知数の値をちょっとずつ変えてf0に与えながら、f0がゼロになる未知数の組み合わせを探してくれます。
つまりf0は、連立方程式が解けたらゼロベクトルになるように記述しておく必要があります。


たとえば、


INT = α + β1*ln(GDP) + β2*ln(M2CDN)


というような関係を想定しているのであれば、移項して、


INT -(α + β1*ln(GDP) + β2*ln(M2CDN))


というように記述しておくことになります。
で、以下のように定義する関数で、1期分の外生変数を与えると、その期の内生変数が得られます。
xの並び順に注意が必要です。

# 内生変数を計算する関数
get_endo <- function(init, exo, year){
  e <- subset(exo, exo$YEAR==year)
  fn0 <- function(x){
    # xはCP,IP,IM,YD,INT,GDP,GDPNの順
    output <- c(
      x[1] - CP_fn(e$YD_1, e$WH_1),                                   # CP=の方程式
      x[2] - IP_fn(e$GDP_1, e$GDP_2, e$INT_1, e$IP_1),                # IP=の方程式
      x[3] - IM_fn(e$IM_1, x[6]),                                     # IM=の方程式
      x[4] - YD_fn(x[6], e$TAX),                                      # YD=の方程式
      x[5] - INT_fn(x[6], e$M2CDN),                                   # INT=の方程式
      x[6] - GDP_fn(x[1], x[2], e$CG, e$IG, e$IH, e$ST, e$EX, x[3]),  # GDP=の方程式
      x[7] - GDPN_fn(x[6], e$GDPDEF)                                  # GDPN=の方程式
    )
    return(output)
  }
  solution <- nleqslv(x=init, fn=fn0, method = "Newton")
  return(solution$x)
}


内生変数を保存するテーブルを作っておきます。

Endog_df <- data.frame(YEAR = Exog_df$YEAR,
                       CP   = rep(NA, nrow(Exog_df)), 
                       IP   = rep(NA, nrow(Exog_df)), 
                       IM   = rep(NA, nrow(Exog_df)), 
                       YD   = rep(NA, nrow(Exog_df)), 
                       INT  = rep(NA, nrow(Exog_df)), 
                       GDP  = rep(NA, nrow(Exog_df)),
                       GDPN = rep(NA, nrow(Exog_df))
                       )


次に、先ほど定義した関数を繰り返し使って各期の内生変数を順次求めていき、外生変数テーブルと内生変数テーブルをともに1期ずつ更新していく関数を書いておきます。

simulate <- function(init, exo_df, endo_df){
  for (i in 1:nrow(exo_df)){

    # iサイクル目の外生変数セット(1行だけのデータフレームの形)
    exo <- exo_df[i,]
    
    # iサイクル目の解を求める
    sol <- get_endo(init=init, exo=exo_df, year=exo_df$YEAR[i])

    # 内生変数テーブルのi行目を更新
    endo_df[i,'CP']   <- sol[1]
    endo_df[i,'IP']   <- sol[2]
    endo_df[i,'IM']   <- sol[3]
    endo_df[i,'YD']   <- sol[4]
    endo_df[i,'INT']  <- sol[5]
    endo_df[i,'GDP']  <- sol[6]
    endo_df[i,'GDPN'] <- sol[7]

    # 得られた内生変数を、外生変数テーブルのy+1年の行に先決内生変数
    # として上書きする(ただしiが終わりの年を超えるまで)
    if(i<nrow(exo_df)){
    exo_df[i+1,'IP_1']  <- sol[2]
    exo_df[i+1,'IM_1']  <- sol[3]
    exo_df[i+1,'YD_1']  <- sol[4]
    exo_df[i+1,'INT_1'] <- sol[5]
    exo_df[i+1,'GDP_1'] <- sol[6]
    # 2サイクル目からはGDP_2(の3行目以降)も更新する
    if(i>=2){
      exo_df[i+1,'GDP_2'] <- endo_df[(i-1),'GDP'] 
      }
    }
  }
  output <- list(endo_df, exo_df)
  return(output)
}


ではいよいよ下記でシミュレーションを実行します。
内生変数の初期値は、全部0とかにしててもきちんと推計できましたが、推計に使った元データの平均値を取って入れるようにしておきます。

# 内生変数の初期値(元データの平均)
initial <- c(mean(d_macro$CP), mean(d_macro$IP), mean(d_macro$IM), mean(d_macro$YD),
             mean(d_macro$INT), mean(d_macro$GDP), mean(d_macro$GDPN))

# シミュレーション実行
results <- simulate(init=initial, exo_df=Exog_df, endo_df=Endog_df)

# 結果の取り出し
Endo_results <- results[[1]]
Exo_results  <- results[[2]]

# 結果の保存
write.csv(Endo_results, 'results/Endo_results.csv', quote=FALSE, row.names=FALSE)
write.csv(Exo_results, 'results/Exo_results.csv', quote=FALSE, row.names=FALSE)


得られた結果を推計に使った元データと比較してみます。
GDPとINT(利子率)の予測値と実績値を並べておきます。実線が実績値、破線が予測値(シミュレーション値)です。

xlim=c(1982,2009)
ylim=c(300000, 600000)
plot(x=1982:2009, d_macro$GDP, type='l', lty=1, 
     xlim=xlim, ylim=ylim, ylab="GDP")
par(new=TRUE)
plot(x=1982:2009, Endo_results$GDP, type='l', lty=2, 
     xlim=xlim, ylim=ylim, axes = FALSE, xlab="", ylab="")

xlim=c(1982,2009)
ylim=c(0, 10)
plot(x=1982:2009, d_macro$INT, type='l', lty=1, 
     xlim=xlim, ylim=ylim, ylab="INT")
par(new=TRUE)
plot(x=1982:2009, Endo_results$INT, type='l', lty=2, 
     xlim=xlim, ylim=ylim, axes = FALSE, xlab="", ylab="")


f:id:midnightseminar:20190808023021p:plain
f:id:midnightseminar:20190808023036p:plain


教科書に従ってOLSで推定しましたが、2SLSにしても大して手間はかからないと思います。

researchmapにCSVで論文のデータを投入するときの注意点

ResearchmapにCSVで論文のデータを投入するときの注意点として、

  • 英語のタブからダウンロードしたフォーマットを使っているなら、英語のタブからインポートしなければならない。
  • 説明書きに、情報がないセルにはnullを入れろと書いてあるが、べつに入れなくてもデータは読み込める。
  • 同じ論文が含まれている場合、上書きで更新はしてくれないので、上書きを伴うのであればデータをいったん全削除してからインポートする。
  • 元データをエクセルで管理している場合、単にCSVで吐き出すのではなく、ダブルクォーテーション付きにしなければならないので、たとえばこのページのやり方でCSV作成をする。(簡単にいうと、エクセル上でダブルクォーテーション付きにした上で、それをテキストエディタにコピペし、タブをカンマに置換する)

忘れそうなのでメモしました。
しかし今年7月に仕様の変更があるらしいですが。
更新していく上では一番最後の点がめんどくさいので、変換するプログラムを自分で用意したほうが楽な気もします。

Rで二段階最小二乗法の演習(『gretlで計量経済分析』を参考に)

『gretlで計量経済分析』という教科書があって、入門的な統計分析を非常にわかりやすく解説していると思いました。
学部レベルの人に統計分析を教える上では、関心の対象が政治や経済なのであれば、こういう「経済ネタ」で統計学が学べる本が良いのかもしれない。(私は最初は心理学系の本で勉強した。)
gretl(グレーテル)というソフトの使い勝手は私はよく知りませんが、見た感じ、初学者向けにはGUIもわかりやすくて良いんじゃないでしょうか。


ところで、第8章でごく簡単なマクロ経済モデルを材料にして二段階最小二乗法を実行するという演習があり、内生性の問題とその解決法としての操作変数法・二段階最小二乗法について説明するのに、なかなか分かりやすい事例だなと思いました。
しかし、gretlを使っていく予定はないので、以下のようにRで実行しました。

OLSでの推定

以下のように超単純なマクロモデルを考える。

Ct = α + βYt + ut
Yt = Ct + It

1つめの式を変形すると、
Yt = α/(1-β) + It/(1-β) + ut/(1-β)

ここで、
C:消費、Y:所得、I:投資、u:撹乱項、0 < β < 1

これらはようするに、消費は所得だけの関数として決まり、所得は、消費と投資の合計に一致する、というモデルを想定している。
最初の式で、説明変数にYtが入っているが、Ytにはutが入っているわけなので、説明変数と撹乱項が相関しており内生性があるということになる。内生性があると、OLSが一致推定になるための条件を満たさないので、サンプルサイズを増やしても真の値に近づいていかないことになる。そのためOLSでは妥当な推定ができない。


まずパラメータの真の値を自分で設定した上で、乱数で変数を作成し、生成された変数からOLSでパラメータを推定してみて、真の値とズレてしまう様子を確認する。

# ========== OLSで推定する ========== #

# まず、αとβの真の値を設定しておく。
alpha <- 2.5
beta <- 0.6

# 以下は、乱数からデータ系列をつくって、OLSで推定したパラメータを返すという処理を繰り返す関数。

repeat_ols <- function(para, n, T, sd){

  # あとで結果を並べるために設けておく空のベクトル
  alpha_output_ols <- c()
  beta_output_ols <- c()
  
  # 処理はn回繰り返させる
  for (i in 1:n) {
  
    # 投資Itは1から始まって毎期0.5ずつ増えることにする。全部でT期分。
    It <- seq(from=1, by=0.5, length.out=T)
    
    # 変形後の上式からYtをつくる。撹乱項utは正規乱数。
    set.seed(i)
    ut <- rnorm(n=T, mean=0, sd=sd)
    Yt <- (alpha/(1-beta)) + (It/(1-beta)) + (ut/(1-beta))

    # Ctをつくる
    Ct <- alpha + beta*Yt + ut
    
    # CをYに回帰してαとβをOLSで推定する。
    model_cy_ols <- lm(Ct ~ Yt)  # OLS推定
    alpha_est_ols <- model_cy_ols$coefficients[1]  # αの推定値
    beta_est_ols <- model_cy_ols$coefficients[2]  # βの推定値
    
    # 繰り返し推定した結果を並べておく
    alpha_output_ols <- c(alpha_output_ols, alpha_est_ols)
    beta_output_ols <- c(beta_output_ols, beta_est_ols)
    }
  
  # 出力
  if(para=='alpha'){
    return(alpha_output_ols)
  }
  if(para=='beta'){
  return(beta_output_ols)
  }
}

# 1000回推定して結果を取り出す
alpha_results_ols <- repeat_ols(para='alpha', n=1000, T= 100, sd=5)
beta_results_ols <- repeat_ols(para='beta', n=1000, T= 100, sd=5)

# 推定した1000個のα・βの平均を確認する
mean(alpha_results_ols)
mean(beta_results_ols)
> mean(alpha_results_ols)
[1] -0.4664703
> mean(beta_results_ols)
[1] 0.6419773
# ヒストグラムをかいてみる
hist(alpha_results_ols, breaks=20)
hist(beta_results_ols, breaks=20)


f:id:midnightseminar:20190515125702p:plain
f:id:midnightseminar:20190515125712p:plain


αもβも真の値(それぞれ2.5、0.6)からけっこうズレていることが分かる。

二段階最小二乗法で推定してみる

次に、内生性のあるモデルでもバイアスなく推定してくてるという噂の二段階最小二乗法をやってみます。
二段階最小二乗法が何であるかはググってどこかで見てもらえればと思いますが、あるモデル式の説明変数の中にある内生変数を、「内生変数 = α + β1外生変数1 + β2外生変数2 + ε」という形の回帰分析により、「外生変数だけで完全に説明できる部分と、それ以外の誤差」に分けます。「外生変数だけで完全に説明できる部分」というのは、この回帰分析の結果得られるαとβを用いた「予測値」のことで、内生変数のかわりにこれを使うことで、被説明変数の撹乱項と相関が生まれるのを防ぐことができるわけです。

# ========== 二段階最小二乗法で推定してみる ========== #
# さっきと同様に、αとβの真の値を設定
alpha <- 2.5
beta <- 0.6

# 推定を繰り返す関数
repeat_2sls <- function(para, n, T, sd){
  alpha_output_2sls <- c()
  beta_output_2sls <- c()
  
  # n回繰り返させる
  for (i in 1:n) {

    # 投資Itは1から始まって毎期0.5ずつ増えることにする。全部でT期分。
    It <- seq(from=1, by=0.5, length.out=T)
    
    # 変形後の上式からYtをつくる。撹乱項utは正規乱数。
    set.seed(i)
    ut <- rnorm(n=T, mean=0, sd=sd)
    Yt <- (alpha/(1-beta)) + (It/(1-beta)) + (ut/(1-beta))
    
    # Ctをつくる
    Ct <- alpha + beta*Yt + ut
    
    # ここから二段階の推定を行う。
    # まず、Y~Iの回帰分析をOLSでやります。
    model_yi <- lm(Yt ~ It)
    
    # パラメータの推定値を取り出します
    const_yi <- model_yi$coefficients[1]
    coef_yi <- model_yi$coefficients[2]
    
    # 上記パラメータからYの予測値を作ります
    Yt_pred <- const_yi + coef_yi*It
    
    # ちなみにこれは、predict関数を使って
    # Yt_pred <- predict(model_yi)
    # としても同じものが得られます。
    
    # 上の予測値を使って、二段階目の回帰をします。
    model_cy_2sls <- lm(Ct ~ Yt_pred)
    
    # パラメータの推定値を取り出します
    alpha_est_2sls <- model_cy_2sls$coefficients[1]
    beta_est_2sls <- model_cy_2sls$coefficients[2]
    
    alpha_output_2sls <- c(alpha_output_2sls, alpha_est_2sls)
    beta_output_2sls <- c(beta_output_2sls, beta_est_2sls)
  }
  
  # 出力
  if(para=='alpha'){
    return(alpha_output_2sls)
    }
  if(para=='beta'){
    return(beta_output_2sls)
    }
}

# 1000回推定して結果を取り出す。
alpha_result_2sls <- repeat_2sls(para='alpha', n=1000, T=100, sd=5)
beta_result_2sls <- repeat_2sls(para='beta', n=1000, T=100, sd=5)

# 推定値の平均を確認
mean(alpha_result_2sls)
mean(beta_result_2sls)
> mean(alpha_result_2sls)
[1] 2.524852
> mean(beta_result_2sls)
[1] 0.5996154
# ヒストグラムをかいてみる
hist(alpha_result_2sls, breaks=20)
hist(beta_result_2sls, breaks=20)


f:id:midnightseminar:20190515125839p:plain
f:id:midnightseminar:20190515125851p:plain


かなり「真の値」(α=2.5、β=0.6)に近い結果きました。

上記2つの計算方法の結果を比較

sd(撹乱校の標準偏差=ばらつき)を変えてみて、両者の結果を比較します。

> # OLSでsdを1〜10まで変えてβを推定してみる
> for(i in 1:10){
+ b <- mean(repeat_ols(para='beta', n=1000, T=100, sd=i))
+ print(b)
+ }
[1] 0.6018791
[1] 0.6073759
[1] 0.6162016
[1] 0.6279157
[1] 0.6419773
[1] 0.6578006
[1] 0.6748069
[1] 0.6924639
[1] 0.7103121
[1] 0.7279768
> 
> # 2SLSでsdを1〜10まで変えてβを推定してみる
> for(i in 1:10){
+   b <- mean(repeat_2sls(para='beta', n=1000, T=100, sd=i))
+   print(b)
+ }
[1] 0.6000004
[1] 0.5999623
[1] 0.5998856
[1] 0.59977
[1] 0.5996154
[1] 0.5994214
[1] 0.5991876
[1] 0.5989136
[1] 0.5985988
[1] 0.5982427


OLSの推定のほうは、撹乱項の標準偏差を大きくしていくにつれ、推定のバイアスもどんどん大きくなってますが、2SLSのほうは結果が安定してますね。

2SLSの部分にパッケージをつかってみる

二段階最小二乗法は、semパッケージのtsls関数で簡単に実行できるので、それを使うように書き換えたものも置いておきます。

# パッケージの読み込み
library(sem)

# αとβの真の値を設定
alpha <- 2.5
beta <- 0.6

# 推定を繰り返す関数
repeat_2sls_sem <- function(para, n, T, sd){
  alpha_output_2sls_sem <- c()
  beta_output_2sls_sem <- c()
  
  # n回繰り返させる
  for (i in 1:n) {

        # 投資Itは1から始まって毎期0.5ずつ増えることにする。全部でT期分。
    It <- seq(from=1, by=0.5, length.out=T)
    
    # 変形後の上式からYtをつくる。撹乱項utは正規乱数。
    set.seed(i)
    ut <- rnorm(n=T, mean=0, sd=sd)
    Yt <- (alpha/(1-beta)) + (It/(1-beta)) + (ut/(1-beta))
    
    # Ctをつくる
    Ct <- alpha + beta*Yt + ut
    
    # tsls関数で2SLS(カンタン!!)
    model_tsls_sem <- tsls(Ct ~ Yt,  ~ It, data=data.frame(It, ut, Yt, Ct))
    
    alpha_est_2sls_sem <- model_tsls_sem$coefficients[1]
    beta_est_2sls_sem <- model_tsls_sem$coefficients[2]
    
    alpha_output_2sls_sem <- c(alpha_output_2sls_sem, alpha_est_2sls_sem)
    beta_output_2sls_sem <- c(beta_output_2sls_sem, beta_est_2sls_sem)
  }
  
  # 出力
  if(para=='alpha'){
    return(alpha_output_2sls_sem)
    }
  if(para=='beta'){
    return(beta_output_2sls_sem)
    }
}

# 1000回推定して結果を取り出す。
alpha_results_2sls_sem <- repeat_2sls_sem(para='alpha', n=1000, T=100, sd=5)
beta_results_2sls_sem <- repeat_2sls_sem(para='beta', n=1000, T=100, sd=5)


# 推定値の平均を確認
mean(alpha_results_2sls_sem)
mean(beta_results_2sls_sem)

# ヒストグラムをかいてみる
hist(alpha_results_2sls_sem, breaks=20)
hist(beta_results_2sls_sem, breaks=20)

# 2SLSでsdを1〜10まで変えてβを推定してみる
for(i in 1:10){
  b <- mean(repeat_2sls_sem(para='beta', n=1000, T=100, sd=i))
  print(b)
}


結果はさっきと同じになります(乱数のシードも揃えてるので)ので省略します。

IS-LM分析

教科書に沿って、IS-LM分析を行います。
データは、教科書のサポートサイトにあるものを使います。
https://www.nippyo.co.jp/shop/download/35.html
このデータの、islm.gdtというデータを、gretlで開いてCSVでエクスポートしておけば、Rでインポートして使えます。


IS方程式は、
lnGDPN <- α1 + β11INT + β12lnINV + u1


LM方程式は、
INT <- α2 + β21GDPN + β22lnM2CDN + u2

ここで、
GDPNは名目GDP、
INVは名目投資(民間設備投資、民間住宅投資、在庫投資の合計)、
INTは名目長期金利、
M2CDNはマネーストック
であり、lnは対数値です。


サポートサイトのデータは、1980年から2009年の日本の時系列データになっていて、変数名が、lnGDPNは「l_GDPN」、lnINVは「l_I」、lnM2CDNは「l_M2CD」になっています。

# ========== ISLM分析を二段階最小二乗法でやってみる ========== #
# パッケージの読み込み
library(sem)

# データの読み込み
data <- read.csv('data/csv/islm.csv', header=T)  # データの置き場所は各自の環境に合わせて

# IS方程式を求めるための二段階最小二乗法
tsls(data$l_GDPN ~ data$INT + data$l_I, ~ data$l_M2CD + data$l_I, data=data)

# ばらして二段階それぞれを計算しても同じ値になる
model_int_m2 <- lm(data$INT ~ data$l_M2CD + data$l_I)
INT_pred <- predict(model_int_m2)
model_gdp <- lm(data$l_GDPN ~ INT_pred + data$l_I)

model_gdp$coefficients[1]  # α1
model_gdp$coefficients[2]  # β11
model_gdp$coefficients[3]  # β12


# LM方程式を求めるための二段階最小
tsls(data$INT ~ data$l_GDPN + data$l_M2CD, ~ data$l_M2CD + data$l_I, data=data)

# ばらして二段階それぞれを計算しても同じ値になる
model_gdp_m2 <- lm(data$l_GDPN ~ data$l_M2CD + data$l_I)
GDP_pred <- predict(model_gdp_m2)
model_int <- lm(data$INT ~ GDP_pred + data$l_M2CD)

model_int$coefficients[1]  # α2
model_int$coefficients[2]  # β21
model_int$coefficients[3]  # β22


出力結果は下に貼り付けます。

> tsls(data$l_GDPN ~ data$INT + data$l_I, ~ data$l_M2CD + data$l_I, data=data)

Model Formula: data$l_GDPN ~ data$INT + data$l_I

Instruments: ~data$l_M2CD + data$l_I

Coefficients:
(Intercept)    data$INT    data$l_I 
 6.40360864 -0.05130671  0.59363934 
> tsls(data$INT ~ data$l_GDPN + data$l_M2CD, ~ data$l_M2CD + data$l_I, data=data)

Model Formula: data$INT ~ data$l_GDPN + data$l_M2CD

Instruments: ~data$l_M2CD + data$l_I

Coefficients:
(Intercept) data$l_GDPN data$l_M2CD 
   26.97856    14.70982   -13.88998 


ちなみに教科書の本文では、「二段階最小二乗法で推定された、IS方程式の利子率INTのパラメータは6.403」と書いてありますが、これは見るところを間違ってますね(定数項を報告してしまっている)。正しくは「-0.051」です。LM方程式のほうも記述が間違っています。
(出力自体は、上記の結果と教科書に載っているgretlの結果は一致しています。)


OLSでも推定してみて、ズレがどれぐらいあるか確認しておきましょう。

> # OLSでも推定してみて違いを検証
> lm(data$l_GDPN ~ data$INT + data$l_I)

Call:
lm(formula = data$l_GDPN ~ data$INT + data$l_I)

Coefficients:
(Intercept)     data$INT     data$l_I  
    5.95760     -0.04657      0.63120  

> lm(data$INT ~ data$l_GDPN + data$l_M2CD)

Call:
lm(formula = data$INT ~ data$l_GDPN + data$l_M2CD)

Coefficients:
(Intercept)  data$l_GDPN  data$l_M2CD  
     80.019        3.020       -7.491  


IS方程式のほうはある程度近い値ですが、LM方程式はだいぶ違いますね。