過去何度か時系列のエントリーで「xts」が便利だと書いて居たのですが、日足データを月次にすることはできてもクール単位に集計する便利な関数がない、ということに気が付き色々調べました。
事例としてJEITAの「民生用電子機器国内出荷統計」を使ってみます。
ダウンロード先はこちら http://www.jeita.or.jp/japanese/stat/shipment/
データのクオーター化
データについて
上記サイトから集めたデータは以下のような形をしています。
df <- read.csv("data.csv",header=T) head(df)
このように右向きに時系列のデータが並んでいます。
商品名 種別 X1月 X2月 X3月 1 薄型テレビ 合計 416 579 508 2 薄型テレビ 29型以下 103 147 180 3 薄型テレビ 30～36型 144 207 160 4 薄型テレビ 37～49型 114 157 112 5 薄型テレビ 50型以上 54 69 56 6 ブルーレイディスク 合計 216 272 272 7 ブルーレイディスク レコーダ 169 224 208 8 ブルーレイディスク プレーヤ 47 48 64
データの抜粋
このうち薄型テレビの合計だけを取り出します。 列名でデータを抜き出す為に「dplyr」を使います。
library("dplyr", lib.loc="C:/hogehoge/R-3.4.1/library") dat <- df %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "合計") head(dat)
商品名 種別 X1月 X2月 X3月 X4月 X5月 X6月 1 薄型テレビ 合計 416 579 508
ts型にするために
時系列にするためts型にしますが、先ず横向きに並んだデータでは上手く認識しませんので転置します。
head(t(dat))
[,1] 商品名 "薄型テレビ" 種別 "合計" X1月 "416" X2月 "579" X3月 "508" X4月 "309"
最初の2行は数値ではないので、3行目からのデータを使います。
head(t(dat[1,3:ncol(dat)]))
1 X1月 416 X2月 579 X3月 508 X4月 309 X5月 345 X6月 456
ts型にする
今回のデータは2014年1月からの月次データでしたので、スタートは2014,1、頻度は12ということになります。
dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) print(dat_t)
自動的に月名が割り当てられます。 なおデータフレームではないので「print」でデータ確認します。
Jan Feb Mar Apr May Jun Jul Aug Sep Oct 2014 416 579 508 309 345 456 395 305 515 337 2015 392 445 627 339 322 421 364 330 353 371 2016 348 381 510 334 350 332 374 325 374 352 2017 305 362 498 337 329 355 290 297 357
ts型のグラフはts.plotで確認できます
ts.plot(dat_t)
四半期（クオーター）データにする
「aggregate」関数を使います。 四半期データは3ヶ月ごとのため、 12ヶ月単位のデータを4分割することになります。
また、合計値にしたいためファンクションは「sum」を選びます。
dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) print(dat_t_q)
クオーター単位に合計されています。
Qtr1 Qtr2 Qtr3 Qtr4 2014 1503 1110 1215 1662 2015 1464 1082 1047 1529 2016 1239 1016 1073 1420 2017 1165 1021 944
四半期データのグラフになりました。
データフレームにする
データフレームにすると残念ながらts型で割り振ってくれた名称が消えてしまうため、データフレームにするには、時系列パートの列名が必要になる。 1
列名の元となるデータを用意する
dmn_1 <- c("２０１４年","２０１５年","２０１６年","２０１７年") dmn_2 <- c("１Q","２Q","３Q","４Q")
組み合わせて結合する
for分を使って上記の組み合わせを作ります。 空のデータフレームを用意してrbindしていくことと、stringrパッケージを使って文字列を結合することがポイントです。
library("stringr", lib.loc="C:/hogehoge/R-3.4.1/library") dmn <- as.data.frame(NULL) for(i in 1:4){ for(j in 1:4){ dat <- str_c(dmn_1[i],dmn_2[j],sep='', collapse=NULL) dat <- as.data.frame(dat) dmn <- rbind(dmn,dat) dat <- NULL } } head(dmn)
dat 1 ２０１４年１Q 2 ２０１４年２Q 3 ２０１４年３Q 4 ２０１４年４Q 5 ２０１５年１Q 6 ２０１５年２Q
ただし、今回のデータは2016年の3Qで終了ですので、数を絞る必要があります。 一度転置させないといけません。
dmn <- t(dmn) TIME_dmn <- dmn[1:14] head(TIME_dmn)
[1] "２０１４年１Q" "２０１４年２Q" [3] "２０１４年３Q" "２０１４年４Q" [5] "２０１５年１Q" "２０１５年２Q"
列名を使ってデータをデータフレーム化
先程用意した列名を使いながら、時系列データをデータフレーム化します。
dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_合計 = c(dat_t_q)) head(dat_q)
TIME 薄型テレビ_合計 1 ２０１４年１Q 1503 2 ２０１４年２Q 1110 3 ２０１４年３Q 1215 4 ２０１４年４Q 1662 5 ２０１５年１Q 1464 6 ２０１５年２Q 1082
同様のことを複数データに行う
クオーター化を関数化
一連のデータフレームへの変化までを関数にします。
※列名は関数外です。
tv_goukei_func <- function(x){ dat <- df %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "合計") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_合計 = c(dat_t_q)) return(dat_q) }
同様に、サイズ別のデータ用の関数も作ります
tv_goukei_func <- function(x){ dat <- x %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "合計") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_合計 = c(dat_t_q)) return(dat_q) } tv_29_func <- function(x){ dat <- x %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "29型以下") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_２９型以下 = c(dat_t_q)) return(dat_q) } tv_30_func <- function(x){ dat <- x %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "30～36型") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_３０_３６型 = c(dat_t_q)) return(dat_q) } tv_37_func <- function(x){ dat <- x %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "37～49型") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_３７_４９型 = c(dat_t_q)) return(dat_q) } tv_50_func <- function(x){ dat <- x %>% dplyr::filter(商品名 == "薄型テレビ" & 種別 == "50型以上") dat_t <- ts(t(dat[1,3:ncol(dat)]),start = c(2014,1),frequency = 12) dat_t_q <- aggregate(dat_t,nfrequency=4,FUN=sum) dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_５０型以上 = c(dat_t_q)) return(dat_q) }
関数を順番に適応
これらの関数をデータに適応しデータフレームに結合します。
df_tv_goukei <- tv_goukei_func(df) df_tv_29 <- tv_29_func(df) df_tv_30 <- tv_30_func(df) df_tv_37 <- tv_37_func(df) df_tv_50 <- tv_50_func(df) df_q <- dplyr::full_join(df_tv_goukei,df_tv_29) df_q <- dplyr::full_join(df_q,df_tv_30) df_q <- dplyr::full_join(df_q,df_tv_37) df_q <- dplyr::full_join(df_q,df_tv_50) head(df_q)
TIME 薄型テレビ_合計 薄型テレビ_２９型以下 薄型テレビ_３０_３６型 1 ２０１４年１Q 1503 430 511 2 ２０１４年２Q 1110 336 323 3 ２０１４年３Q 1215 321 411 4 ２０１４年４Q 1662 457 524 5 ２０１５年１Q 1464 536 447 6 ２０１５年２Q 1082 330 328
グラフ化
ggplot2を使います
library("reshape2", lib.loc="C:/hogehoge/library") library("ggplot2", lib.loc="C:/hogehoge/library")
日本語の列名は時にggplotで時系列の順番が狂いますので、reorderを使って並べ替えます。 そのために番号を先ず振ります。
df_q$num <- rep(1:nrow(df_q))
今回はfacet_wrapで種類別にし、凡例の位置をtiopへ、また塗りつぶしの色を手動で指定しています。
df_q_m <- melt(df_q,id.vars = c("TIME","num")) head(df_q_m) g <- ggplot(df_q_m,aes(x=reorder(TIME,num),y=value,group=variable,fill=variable)) g <- g + theme_classic() g <- g + geom_bar(stat = "identity",position = "stack") g <- g + facet_grid(variable~.) g <- g + geom_text(aes(x=reorder(TIME,num),y=value,label=value),vjust=-0.5) g <- g + scale_y_continuous(labels = scales::comma,limits =c(0,2200)) g <- g + ylab("") g <- g + xlab("") g <- g + ggtitle("薄型テレビ量販店四半期販売台数数位") g <- g + scale_fill_manual(values = c("brown4", "deepskyblue4", "deepskyblue3", "deepskyblue2", "deepskyblue1")) g <- g + theme(legend.position = "top") g <- g + theme(axis.text.x = element_text(angle = 45, hjust = 1,size=6)) plot(g)
グラフを保存します
ggsave(plot=g,filename = "g-3.png",scale=2,height = 2.5,width = 5)
-
ほんとはもっとスマートな手法があると良いのですが。。。↩
