TSA014 - waseda2bun_r @ ウィキ

 ・国内のみ

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)