広告/統計/アニメ/映画 等に関するブログ

広告/統計/アニメ/映画 等に関するブログ

Rで時系列データをクール単位で集計する

過去何度か時系列のエントリーで「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         薄型テレビ 3036144  207  160
4         薄型テレビ 3749114  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)

f:id:yyhhyy:20171112175845p:plain

四半期(クオーター)データにする

「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  

四半期データのグラフになりました。

f:id:yyhhyy:20171112180012p:plain

データフレームにする

データフレームにすると残念ながらts型で割り振ってくれた名称が消えてしまうため、データフレームにするには、時系列パートの列名が必要になる。 1

列名の元となるデータを用意する

dmn_1 <- c("2014年","2015年","2016年","2017年")
dmn_2 <- c("1Q","2Q","3Q","4Q")

組み合わせて結合する

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 2014年1Q
2 2014年2Q
3 2014年3Q
4 2014年4Q
5 2015年1Q
6 2015年2Q

ただし、今回のデータは2016年の3Qで終了ですので、数を絞る必要があります。 一度転置させないといけません。

dmn <- t(dmn)
TIME_dmn <- dmn[1:14]
head(TIME_dmn)
[1] "2014年1Q" "2014年2Q"
[3] "2014年3Q" "2014年4Q"
[5] "2015年1Q" "2015年2Q"

列名を使ってデータをデータフレーム化

先程用意した列名を使いながら、時系列データをデータフレーム化します。

dat_q <- data.frame(TIME=TIME_dmn,薄型テレビ_合計 = c(dat_t_q))
head(dat_q)
           TIME 薄型テレビ_合計
1 2014年1Q            1503
2 2014年2Q            1110
3 2014年3Q            1215
4 2014年4Q            1662
5 2015年1Q            1464
6 2015年2Q            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,薄型テレビ_29型以下 = 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,薄型テレビ_30_36型 = 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,薄型テレビ_37_49型 = 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,薄型テレビ_50型以上 = 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 薄型テレビ_合計 薄型テレビ_29型以下 薄型テレビ_30_36型
1 2014年1Q            1503                   430                    511
2 2014年2Q            1110                   336                    323
3 2014年3Q            1215                   321                    411
4 2014年4Q            1662                   457                    524
5 2015年1Q            1464                   536                    447
6 2015年2Q            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)

f:id:yyhhyy:20171112190139p:plain


  1. ほんとはもっとスマートな手法があると良いのですが。。。