waseda2bun_r @ ウィキ

本サイトについて

2012-12-11T22:30:04+09:00

*本サイトについて用途：ほかのサイトの避難所（おもに画像保管用）や作業場です。作成者：キーワードM（ヒント　苗字：埼玉県の某都市に同じ） **構成 -親サイト（当面未リンク） -本サイト --あれこれ ---[[R覚書]] ---[[作図001]] ---[[R関数保管場所]] ---[[R基本操作01]] ---[[R基本操作02]] ---[[乱数の発生]] ---[[乱数001]] ---[[データ保管場所001]] --統計 ---[[基本統計量001]] ---[[p value]] ---[[分布001]] ---[[仮説検定001]] ---[[仮説検定002]] ---[[t.test001]] ---[[平均001]] ---[[分散001]] ---[[OLS001]] ---[[OLS002]] ---[[確率001]] ---[[正規分布001]] ---[[カイ２乗分布01]] ---[[t分布001]] ---[[t分布002]] ---[[t分布003]] ---[[ｆ分布001]] ---[[ｆ分布002]] ---[[F.test001]] ---[[ロジット001]] ---[[grangertest001]] --TSA ---[[TSA001]] ---[[TSA002]] ---[[TSA003]] ---[[TSA004]] ---[[TSA005]]　IIP ---[[TSA006]]　ARモデル ---[[TSA007]]　ARIMAモデル、GDP・EX ---[[TSA008]]　ARIMAモデル、GDP・EX ---[[TSA009]]　ARIMAモデル、予測 ---[[TSA010]]　単位根　民間投資 ---[[TSA011]]　局面比較 ---[[TSA012]]　トレンド ---[[TSA013]]　曲線 ---[[TSA014]]　IIP・機械受注 ---[[TSA015]] --[[ベイズ統計]] ---[[ベイズ統計001]] --学部講義 ---[[20101005]] ---[[20101019]] ---[[hamori2009_2]] --マクロ経済系 ---[[国際比較001]] ---[[国際比較002]] ---[[国際比較003]] ---[[Rで財政学]] ---[[金融政策]] ---[[アメリカ恐慌]] --ファイナンス系 ---[[入門01]] ---[[ドル-円（日次）]] ---[[ドル-円（月次）]] ---[[Ｄ社株価001]] --自然科学系？（というか娯楽系） ---[[矢島町]] ---[[矢島町（年次）]] **リンク -別サイト --ttps://sites.google.com/site/gretl4econometrica/ **参考にしているサイト（順不同） +直リンはしていません。 +R以外の情報も扱っているサイトも多いため必ずしもトップページをリンクしていません。 -ttp://mjin.doshisha.ac.jp/R/ -ttp://faculty.washington.edu/ezivot/econ584/notes/unitroot.pdf -ttp://www.stat.pitt.edu/stoffer/tsa2/R_time_series_quick_fix.htm -ttp://www.fides.dti.ne.jp/q-gmz/E_Views/E_Views_7.pdf -ttp://d.hatena.ne.jp/syou6162/20071116/1195205852 -ttp://www7.atwiki.jp/hayatoiijima/pages/34.html -ttp://www-h.yamagata-u.ac.jp/~yamaguch/R_1.pdf -ttp://cse.naro.affrc.go.jp/iwatah/toukei/r/2006/Rstat_06.pdf -ttp://www.statistics.co.jp/reference/R/statR_5_reg.pdf

hamori2009_2

2012-06-04T23:40:48+09:00

羽森2009　2-4を別年次で再現

x <- read.table("JPN_C_RGDP_9410.csv",sep=",",skip=1);x

y <- x[,3]#RGDP
z <- x[,2]#C
y <- log(y)
z <- log(z)

y;z;l=z~y;l#線形の関係
plot(l);ans1=lm(l);print(ans1);abline(ans1)
summary(ans1)

（参考文献）

羽森（2009）第二章

アメリカ恐慌

2012-06-04T23:02:35+09:00

1.仙台市のデータ

http://www.city.sendai.jp/kikaku/seisaku/toukei/toukeijihou/special_edition/215/sp2/h_3.html

x <- read.table("us_gnp_u_29-40.csv",sep=",",skip=1);x

y <- x[,5]#U
z <- x[,4]#GNP

y;z;l=z~y;l#線形の関係
plot(l);ans1=lm(l);print(ans1);abline(ans1)
summary(ans1)

ｆ分布002

2011-07-09T00:26:50+09:00

#出典：東京大学教養学部統計学教室[2007],p231,練習問題11.5より作成
#（１）x1とx2の平均の差の信頼係数95％（p231）
#（２）ふたつの母平均は異なるか。またx1のほうが大きいか（p243あたり参照）
#（３）母分散は等しいか

#(1)-(2)はt分布003参照
#(3)
#分散の比F

x1=c(7.97,7.66,7.59,8.44,8.05,8.08,8.35,7.77,7.98,8.15)
x2=c(8.06,8.27,8.45,8.05,8.51,8.14,8.09,8.15,8.16,8.42)

m1 = mean(x1);v1 =var(x1);n1=length(x1);df1=n1-1
m2 = mean(x2);v2 =var(x2);n2=length(x2);df2=n2-1

s1= sum((x1-m1)^2)/(n1-1)
s2= sum((x2-m2)^2)/(n2-1)
F= s1/s2
#　F分布

# F1<F<F2であれば帰無仮説を棄却しない
#以下は有意水準５％

F1 = qf(0.95,n1-1,n2-1);F1
F2 = qf(0.05,n1-1,n2-1);F2
#もしくは…
var.test(x1,x2)

関連：www23.atwiki.jp/waseda2bun_r/pages/79.html　t分布003

t分布003

2011-07-09T00:21:08+09:00

練習問題

出典：出典：東京大学教養学部統計学教室[2007]

問題A

#出典：東京大学教養学部統計学教室[2007],p252,練習問題12.1より作成
#x1は製品の重さである。
#母平均は100（g）としてよいか。有意水準5％で検定せよ
#解法1
x1=c(101.1,103.2,102.1,99.2,100.5,101.3,99.7,100.5,98.9,101.4)
m1 = mean(x1);v1 =var(m1);n1=length(x1);df1=n1-1
#　95%信頼区間
t1 = qt(1-0.05/2,df1);t1 #統計量
u1 = (1/(n1-1))*sum((x1-m1)^2)
T1 = m1-t1*sqrt(u1/n1)
T2 = m1+t1*sqrt(u1/n1)
T1;T2
#解法2＝もっと簡単にする方法
t.test(x1)

問題B

#出典：東京大学教養学部統計学教室[2007],p252,練習問題12.2より作成
#x1は男性の賃金、x2は女性の賃金である（単位：千円）。
#（１）賃金格差の検定をせよ（母分散は等しい、有意水準５％）
#（２）母分散は等しいと仮定せず同様の検定
#（３）母分散は等しいか？有意水準１％

#（１）
x1=c(154,183,165,174,189,172,150,157,179,165)
x2=c(142,159,160,140,170,138,152,145,150,144)

m1 = mean(x1);v1 =var(m1);n1=length(x1);df1=n1-1
m2 = mean(x2);v2 =var(m2);n2=length(x2);df2=n2-1
#合併した分散sを導出　
#同書（10.18）参照
s1= sum((x1-m1)^2)
s2= sum((x2-m2)^2)

s=(s1+s2)/(n1+n2-2)
s=sqrt(s)
#統計量
t1 = (m1-m2)/s*sqrt(1/n1+1/n2)
#自由度
df = n1+n2-2
t2 = qt(1-0.05/2,df);

問題C

#出典：東京大学教養学部統計学教室[2007],p231,練習問題11.5より作成
#（１）x1とx2の平均の差の信頼係数95％（p231）
#（２）ふたつの母平均は異なるか。またx1のほうが大きいか（p243あたり参照）
#（１）省略
#（２）
x1=c(7.97,7.66,7.59,8.44,8.05,8.08,8.35,7.77,7.98,8.15)
x2=c(8.06,8.27,8.45,8.05,8.51,8.14,8.09,8.15,8.16,8.42)

m1 = mean(x1);v1 =var(x1);n1=length(x1);df1=n1-1
m2 = mean(x2);v2 =var(x2);n2=length(x2);df2=n2-1

s={(n1-1)*v1+(n2-1)*v2}/(n1+n2-2)
s^0.5
df3=df1+df2
#統計量
t= (m1-m2)/{s^0.5*sqrt(1/m1+1/n1)}
#両側検定
T1 = qt(1-0.05/2,df3);T1

#片側検定
T2 = qt(1-0.05,df3);T2

問題Cについて

・両側・左片側とも仮設検定棄却（＝原問題の薬の効果あり）

t分布002

2011-07-08T17:36:57+09:00

t検定

#母分散が未知＝t分布
#　（１）簡単にする方法

#　参考　赤間・山口[2006],p109-110

#平均が50のデータ・正規分布の乱数100個を発生
x1 = rnorm(100,50,1);x1
t.test(x1)

x2 = rnorm(100,50,10);x2
t.test(x2)

#平均が50のデータ・正規分布の乱数10000個を発生

x3 = rnorm(10000,50,1);x3
t.test(x3)

x4 = rnorm(10000,50,10);x4
t.test(x4)

#　（２）定義にしたがい導出
# 基本データ
m1 = mean(x1);v1 =var(m1);n1=length(x1);df1=n1-1
#　95%信頼区間
t1 = qt(1-0.05/2,df1);t1 #統計量
u1 = (1/(n1-1))*sum((x1-m1)^2)
T1 = m1-t1*sqrt(u1/n1)
T2 = m1+t1*sqrt(u1/n1)
T1;T2

TSA015

2010-11-25T22:27:10+09:00

data <- read.table("87-98and98-2007iip_kikai.csv",sep=",",skip=1,header=FALSE)

#設定

iip98 <- data[,4]
kikai98 <- data[,3]
iip87 <- data[,8]
kikai87 <- data[,7]

kikai87 <- log(kikai87)
kikai87 <- log(kikai98)

#0を取り除く
iip98 <- iip98[!is.na(iip98)]
iip87 <- iip87[!is.na(iip87)]
kikai98 <- kikai87[!is.na(iip98)]
kikai87 <- kikai87[!is.na(iip87)]

#ca <- ifelse(is.na(a), 0, a)
# NA を 0 に置き換える

#時系列にする
ts.iip98 <- ts(iip98,start=c(1998,1),frequency=12)
ts.kikai98 <- ts(kikai98,start=c(1998,1),frequency=12)
ts.iip87 <- ts(iip87,start=c(1978,4),frequency=12)
ts.kikai87 <- ts(kikai87,start=c(1978,4),frequency=12)

#(1)iip98andkikai98
#単位根
adf.test(ts.iip98)
PP.test(ts.iip98)
kpss.test(ts.iip98)
adf.test(ts.kikai98)
PP.test(ts.kikai98)
kpss.test(ts.kikai98)

#ラグをとる
adf.test(diff(ts.iip98))$p.value
kpss.test(diff(ts.iip98))$p.value
PP.test(diff(ts.iip98))$p.value

adf.test(diff(ts.kikai98))$p.value
kpss.test(diff(ts.kikai98))$p.value
PP.test(diff(ts.kikai98))$p.value

#２階のラグ
d2.iip98 <- lag(ts.iip98,2)
adf.test(d2.iip98)$p.value
kpss.test(d2.iip98)$p.value

#
d3.iip98 <- lag(ts.iip98,3)
adf.test(d3.iip98)$p.value
kpss.test(d3.iip98)$p.value

#
d4.iip98 <- lag(ts.iip98,4)
adf.test(d4.iip98)$p.value
kpss.test(d4.iip98)$p.value

#(2)iip87andkikai87
#単位根
adf.test(ts.iip87)
PP.test(ts.iip87)
kpss.test(ts.iip87)
adf.test(ts.kikai87)
PP.test(ts.kikai87)
kpss.test(ts.kikai87)

#ラグをとる
adf.test(diff(ts.iip87))$p.value
kpss.test(diff(ts.iip87))$p.value
PP.test(diff(ts.iip87))$p.value

adf.test(diff(ts.kikai87))$p.value
kpss.test(diff(ts.kikai87))$p.value
PP.test(diff(ts.kikai87))$p.value

d.iip87 <- lag(ts.iip87)
d.kikai87 <- lag(ts.kikai87)

#VARモデル
u2 <- ts.union(d.iip87,d.kikai87)
ar(u2,order.max=12)$aic　#最大12
ar(u2,order.max=12)$SBIC

v2 <-　data.frame(d.iip87,d.kikai87)
var2　<-　VAR(v2,p=3,type="const") #3が最小
impulse2　<-irf(var2,impulse="d.kikai87",response=c("d.iip87","d.kikai87"))
plot(impulse2,main="kikai to iip")
summary(var2)

#同時点相関がfull recursive（同時点相関の行列が下三角）な場合
#矢野氏のHPより

require(vars)
data(Canada)
var.2c <- VAR(Canada, p = 2, type = "const")
amat <- diag(4)
amat[2,1] <- NA
amat[3,1] <- NA
amat[3,2] <- NA
amat[4,1] <- NA
amat[4,2] <- NA
amat[4,3] <- NA

#amatの対角成分は当然すべて1で、NAと指定した部分の数値が推定される[今回の場合、下三角行列]。）

svar.2c <- SVAR(var.2c, estmethod = "logLik", Amat = amat, Bmat = NULL, hessian = TRUE, method="BFGS")
svarirf <- irf(svar.2c, impulse = "e", boot =FALSE)
plot(svarirf)

TSA014

2010-11-19T22:58:43+09:00

・国内のみ

data <- read.table("iip_kikai.csv",sep=",",skip=1,header=FALSE)
ts.data <- ts(data,start=c(1978,4),frequency=12)#log
plot(ts.data)
iip <- ts.data[,3]
zen <- ts.data[,4]
seizou <- ts.data[,5]

M <- max(iip,zen,seizou)
m <- min(iip,zen,seizou)

plot(iip,col=1,ylim=c(m,M))
lines(zen,col=2);lines(seizou,col=3)
hanrei <- c("IIP","受注（全体）","受注（製造業のみ）")
legend(1988,140,legend=hanrei,col=c(1,2,3),lty=1)#落ち込んでそうな時期に凡例

bunkai1 <- decompose(iip,type="multiplicative");plot(bunkai1)
bunkai2 <- decompose(zen,type="multiplicative");plot(bunkai2)
bunkai3 <- decompose(seizou,type="multiplicative");plot(bunkai3)

tr1 <- bunkai1$trend
tr2 <- bunkai2$trend
tr3 <- bunkai3$trend

ttl <- "trendの比較"
yl <- "2005.03=100"
plot(tr1,col=1,main=ttl,ylab=yl,ylim=c(50,145))
lines(tr2,col=2);lines(tr3,col=3)
hanrei <- c("IIP","受注（全体）","受注（製造業のみ）")
legend(1988,140,legend=hanrei,col=c(1,2,3),lty=1)#落ち込んでそうな時期に凡例

・海外追加版

data <- read.table("iip_kikai.csv",sep=",",skip=1,header=FALSE)
ts.data <- ts(data,start=c(1978,4),frequency=12)#log
plot(ts.data)
iip <- ts.data[,3]
zen <- ts.data[,4]
seizou <- ts.data[,5]
fd <- ts.data[,6]

ttl1 <- "IIPと主要需要者別機械受注額の指数化"
M <- max(iip,zen,seizou,fd)
m <- min(iip,zen,seizou,fd)

plot(iip,col=1,ylim=c(m,M),ylab="（2005.03=100）",main=ttl1)
lines(zen,col=2);lines(seizou,col=3);lines(fd,col=4)
hanrei <- c("IIP","受注（全体）","受注（製造業のみ）","受注（海外)")
legend(1985,160,legend=hanrei,col=c(1,2,3,4),lty=1)#落ち込んでそうな時期に凡例

bunkai1 <- decompose(iip,type="multiplicative");plot(bunkai1)
bunkai2 <- decompose(zen,type="multiplicative");plot(bunkai2)
bunkai3 <- decompose(seizou,type="multiplicative");plot(bunkai3)
bunkai4 <- decompose(fd,type="multiplicative");plot(bunkai4)
tr1 <- bunkai1$trend
tr2 <- bunkai2$trend
tr3 <- bunkai3$trend
tr4 <- bunkai4$trend

ttl2 <- "IIPと主要需要者別機械受注額の指数化（トレンド）"
ttl <- "trendの比較"
yl <- "2005.03=100"
plot(tr1,col=1,main=ttl1,ylab=yl,ylim=c(50,165))
lines(tr2,col=2);lines(tr3,col=3);lines(tr4,col=4)
hanrei <- c("IIP","受注（全体）","受注（製造業のみ）","受注海外")
legend(1988,140,legend=hanrei,col=c(1,2,3,4),lty=1)#落ち込んでそうな時期に凡例

d.iip <- diff(log(iip))
d.zen <- diff(log(zen))
d.seizou <- diff(log(seizou))
d.fd <- diff(log(fd))

d.u1 <- ts.union(d.iip,d.seizou)
ar(d.u1,order.max=12)$aic　#最大12

library(tseries)
library(vars)　#念のため読み込ませる。

v2 <-　data.frame(d.iip,d.seizou)
var2　<-　VAR(v2,p=6,type="const") #6が最小
impulse2　<-irf(var2,impulse="d.seizou",response=c("d.iip","d.seizou"))
plot(impulse2,main="d.seizou to d.iip")

d.u2 <- ts.union(d.iip,d.zen)
ar(d.u2,order.max=12)$aic　#最大12

v2 <-　data.frame(iip,zen)
var2　<-　VAR(v2,p=11,type="const") #11が最小
impulse2　<-irf(var2,impulse="zen",response=c("iip","zen"))
plot(impulse2,main="d.zen to d.iip")

v2 <-　data.frame(iip,zen)
var2　<-　VAR(v2,p=6,type="const") #6が最小
impulse2　<-irf(var2,impulse="seizou",response=c("iip","seizou"))
plot(impulse2,main="seizou to iip")

v2 <-　data.frame(iip,seizou)
var2　<-　VAR(v2,p=6,type="const") #6が最小
impulse2　<-irf(var2,impulse="zen",response=c("d.iip","zen"))
plot(impulse2,main="d.zen to d.iip")

adf.test(iip)
PP.test(iip)

adf.test(diff(iip))$p.value
adf.test(diff(iip))$p.value

adf.test(zen)
PP.test(zen)
adf.test(diff(zen))$p.value

d.iip <- diff(log(iip))
d.zen <- diff(log(zen))

d.u1 <- ts.union(d.iip,d.zen)
ar(d.u1,order.max=12)$aic　#最大12

#
v2 <-　data.frame(d.iip,d.zen)
var2　<-　VAR(v2,p=11,type="const") #11が最小
impulse2　<-irf(var2,impulse="d.zen",response=c("d.iip","d.zen"))
plot(impulse2,main="d.zen to d.iip")

var2　<-　VAR(v2,p=5,type="const") #5で実施
impulse2　<-irf(var2,impulse="d.zen",response=c("d.iip","d.zen"))
plot(impulse2,main="d.zen to d.iip")

#その（２）製造
adf.test(seizou)
PP.test(seizou)
d.seizou <- diff(log(seizou))
adf.test(diff(zen))$p.value
#階差をとると単位根なし

#AIC
d.u3 <- ts.union(d.iip,d.seizou)
ar(d.u3,order.max=12)$aic　#最大6

#モデル設定

v3 <-　data.frame(d.iip,d.seizou)

var3　<-　VAR(v3,p=6,type="const") #11が最小
impulse3　<-irf(var3,impulse="d.seizou",response=c("d.iip","d.seizou"))
plot(impulse3,main="d.seizou to d.iip")

causality(var3,cause="iip")
summary(var3)
#海外受注

d.fd <- diff(log(fd))
adf.test(seizou)
PP.test(seizou)
d.seizou <- diff(log(fd))
adf.test(diff(fd))$p.value
#階差をとると単位根なし

#AIC
d.u4 <- ts.union(d.iip,d.fd)
ar(d.u4,order.max=12)$aic　#最大5

v4 <-　data.frame(d.iip,d.fd)
var4　<-　VAR(v4,p=5,type="const") #5で実施
impulse4　<-irf(var4,impulse="d.fd",response=c("d.iip","d.fd"))
plot(impulse4,main="d.fd to d.iip")

causality(var4,cause="iip")
summary(var4)

grangertest001

2010-11-15T15:51:50+09:00

国際比較003

2010-11-04T12:26:31+09:00

#data <- read.table("C:/tochnex3.csv",sep=",",skip=2,header=FALSE)

data <- read.table("tochnex3.csv",sep=",",skip=2,header=FALSE)
ts.data <- ts(data,start=c(1999),frequency=1)
tyoku <- ts.data[,2]
kougyou <- ts.data[,3]
shion <- ts.data[,9]
hitai <- ts.data[,13]
tai <- ts.data[,15]

#ぷらすになっているもの

max1　<-　max(kougyou,hitai,tyoku)
min1　<-　min(kougyou,hitai,tyoku)
ttl1　<-　"日本の対中国貿易　品目ごとの輸入額-輸出額の推移"
yl="単位：１０００ドル"
plot(hitai,ylab=yl,ylim=c(min1,max1),lty=1,main=ttl1)
lines(tyoku,lty=2);lines(kougyou,lty=3)
hanrei1 <- c("非耐久消費財","食糧・直接消費財"," 工業用原料")
legend(locator(1),legend=hanrei1,lty=c(1,2,3))

#マイナスのもの
max2　<-　max(shion,tai)
min2　<-　min(shion,tai)
plot(shion,ylab=yl,ylim=c(min2,max2),lty=1,main=ttl1)

lines(tai,lty=2)

hanrei2 <- c("資本財","耐久消費財")
legend(locator(1),legend=hanrei2,lty=c(1,2))

kohbu <- ts.data[,5]#鉱物性燃料
car <- ts.data[,18]#乗用車
max3　<-　max(car,kohbu)
min3　<-　min(car,kohbu)
plot(kohbu,ylab=yl,ylim=c(min3,max3),lty=1,main=ttl1)
lines(car,lty=2)
abline(h=0)
hanrei3 <- c("鉱物性燃料","乗用車")
legend(locator(1),legend=hanrei3,lty=c(1,2))

____

#data <- read.table("C:/tochnex3.csv",sep=",",skip=2,header=FALSE)

#ぷらすになっているもの

max1　<-　max(tai,hitai,tyoku)
min1　<-　min(tai,hitai,tyoku)
ttl1　<-　"日本の対中国貿易　品目ごとの輸入額-輸出額の推移"
yl="単位：１０００ドル"
plot(hitai,ylab=yl,ylim=c(min1,max1),lty=1,main=ttl1)
lines(tyoku,lty=2);lines(tai,lty=3)
hanrei1 <- c("非耐久消費財","食糧・直接消費財","耐久消費財")
legend(locator(1),legend=hanrei1,lty=c(1,2,3))

#マイナスのもの
max２　<-　max(shion,kougyou)
min２　<-　max(shion,kougyou)
matplot(1999:2009,shion,kougyou,main=ttl1,ylab=yl)

____