廿TT

譬如水怙牛過窓櫺 頭角四蹄都過了 因甚麼尾巴過不得

ソーシャルバズマーケティングの後、傾向線(トレンド)が変わっているか。

追記

この記事に興味をもたれた方は、先に

(R+Google アナリティクス)バズやキャンペーンの事後の効果を図示する - 廿TT
をご覧ください。こちらのほうが主張も R のコードも整理されています。

はじめに

2014年を振り返って、Google アナリティクスで当ブログのセッション数を見てみる。

f:id:abrahamcow:20150110102014p:plain

バズった(炎上した、ともいう)時期が2回くらいある。

以前に「急にセッション数(訪問数)が増えるときは、ソーシャルメディアの寄与が大きい。ただしソーシャルでなにが受けるのかはわからないので、コントロールがむずかしい」というようなことを書いた。

f:id:abrahamcow:20150101161635p:plain
RGoogleAnalytics で変化の要因を読みとく(変化量と寄与率のグラフ+散布図) - 廿TT

でも、ぼくにはコントロールはむずかしいけど、ちゃんとした経営基盤があるところなら自覚的にソーシャルで集客することも可能だろう。

例えばバーグハンバーグバーグにエイプリルフール企画を頼むとか。
株式会社バーグハンバーグバーグ

そのとき期待されるのは、できれば一時の集客に終わることなく、ソーシャルメディア経由で認知してくれたユーザーが定着して、その後のサイトへのアクセスが底上げされるかどうかだろう。

そこで、バズった前後でセッション数の傾向が変わっているか調べてみる。

傾向線を引く(R + Google アナリティクスによる実践)

まずは Google アナリティクスから API でデータを引っ張ってくる。

その方法は、

を参照。

f:id:abrahamcow:20150110104029p:plain

日別でみるとデータに一週間単位の周期性があるようなので、そのへんを無視するために、週次でデータを取得することにする。
時系列データを可視化する折れ線グラフのピリオドの選び方、意外とむずかしい。 - 廿TT

#オーサライズ
library("RGoogleAnalytics")
query <- QueryBuilder()
access_token <- query$authorize()

(ここでアクセストークンをコピペ)

ga <- RGoogleAnalytics()
ga.profiles <- ga$GetProfileData(access_token)
sta <-"2013-05-01"
en <- "2014-12-31"
query$Init(start.date = sta,
           end.date = en,
           dimensions = "ga:nthWeek", #ga:weekだと1年間分のデータしかくれないようだ
           metrics = "ga:sessions",
           max.result = 10000,
           table.id = paste("ga:",ga.profiles$id[1],sep="",collapse=","),
           access_token=access_token)
SS<- ga$GetReportData(query)
#以上でデータ取得完了

#head(SS)
#tail(SS)
len <-dim(SS)[1]
SS2 <-SS[-c(1,len),] # データの最初の行と最後の行は除く
#(一週間が7日でなく変なところで切れてしまうので)
SS2[,1]<-as.numeric(SS2[,1]) #数値化
Date <-seq.Date(from=as.Date(sta),to=as.Date(en),by="week")
#length(Date)

x <-Date[-c(1,len)] #日付オブジェクトを生成

#とりあえずプロット
#nihongo() #macユーザーは日本語のフォントを指定
plot(x,SS2$sessions,type="o",pch=20,ylab="セッション", xlab="", xaxt="n")
axis.Date(1,format="20%y/%m", at = seq(min(x),max(x),"3 month"))
abline(h=3000,lty=2)

f:id:abrahamcow:20150110104207p:plain

変化点や異常値を検出する方法はいろいろあるが、
R changepoint パッケージちょっと試した - でたぁっ 感動と失敗の備忘録 など)
ぼくは目視で3000以上のところは「バズ」とみなすことにする。

pp <- which(SS2$sessions>3000)

term1 <- 1:(pp[1]-1)
term2 <- (pp[1]+1):(pp[2]-1)
term3 <- (pp[2]+1):(len-2)

term1d <- x[1:(pp[1]-1)]
term2d <- x[(pp[1]+1):(pp[2]-1)]
term3d <- x[(pp[2]+1):(len-2)]

#プロット
plot(x,SS2$sessions,type="o",pch=20,ylab="セッション", xaxt="n")
lines(cbind(term1d,3000),col="magenta4",lwd=4)
lines(cbind(term2d,3000),col="darkgoldenrod3",lwd=4)
lines(cbind(term3d,3000),col="cyan4",lwd=4)
axis.Date(1,format="20%y/%m", at = seq(min(x),max(x),"3 month"))
legend("topleft",c("期間1","期間2","期間3"),lty=1,lwd=4,
       col=c("magenta4","cyan4","darkgoldenrod3"))

f:id:abrahamcow:20150110104627p:plain

2回のバズの前後で期間を3分割してみた。

このみっつの期間それぞれに、最小二乗法で傾向線を引いてみる。
最小二乗法について

fit1 <-lm(SS2$sessions[term1]~term1) #傾向線の当てはめ
fit2 <-lm(SS2$sessions[term2]~term2)
fit3 <-lm(SS2$sessions[term3]~term3)

pre1 <- predict(fit1)
pre2 <- predict(fit2)
pre3 <- predict(fit3)

#プロット
plot(x,SS2$sessions,type="l",xlab="",ylab="セッション",lwd=4,col="grey20",xaxt="n")
lines(term1d,pre1,col="magenta4",lwd=4)
lines(term2d,pre2,col="darkgoldenrod3",lwd=4)
lines(term3d,pre3,col="cyan4",lwd=4)
grid()
legend("topleft",c("期間1","期間2","期間3"),lty=1,lwd=4,
       col=c("magenta4","darkgoldenrod3","cyan4"))
axis.Date(1,format="20%y/%m", at = seq(min(x),max(x),"3 month"))

f:id:abrahamcow:20150110104955p:plain

こんな風だ。

期間 1 から 2 では、傾向線の底(切片)が上がっている。

この観点からいくと、1 回目のバズはいいバズり。

期間 2 から 3 では、傾向線の形に大きな変化は見られない。

この観点からいくと、2 回目のバズは一時のバズり。

傾向線の切片と傾きはこんなだった。

期間 2 では切片、傾きともに増加している。

切片 傾き
期間 1 -32.1 4.55
期間 2 -19.67 13.5
期間 3 -1160.64 26.77
coef_tab <-rbind(
coef(fit1),
coef(fit2),
coef(fit3)
)
rownames(coef_tab)<-c("期間1","期間2","期間3")
coef_tab
round(coef_tab,2)

2014年1月にバズった記事は、

というやつで、統計よりの話題。

2014年10月にバズった記事は、

で、妖怪とヒップホップの話している。

このブログは統計よりの話題のほうが多いので、そっちのほうがユーザーが定着しやすいと解釈できる。
(妖怪関連の日記もっと書きたいけど、妖怪はむずかしすぎる。)

ソーシャルマーケティングとかやる方は、こんな感じでデータを見てみるといいかもしれない。

回帰診断(そもそもこんなことやっていいの?)

今回やった傾向線の当てはめは「回帰分析」という。

ぼくは「回帰分析するときは、残差プロットは必ず書くべき」と教わってきた。

残差プロットは、傾向線から各点の距離(ズレの距離=残差)を散布図にしたものだ。

f:id:abrahamcow:20150110110534p:plain

理想的には図の左上みたいに、残差がまったく不規則に変動しているべき。

統計学ではズレ(誤差)を確率変数(random value)とみなしているので、ランダムに変動していなければ、そもそもの前提が成立しない。

右上、左下、右下とそれぞれの期間ごとの残差プロットを見ていくとちょっとランダムらしくない意味のありそうな動きが残っているのが気になる。

しかし、今回の目的は「データを要約する傾向線を引くこと」なので、まあいいんじゃないかな、と思う。

どうなんだろう。時系列とか信号処理に詳しい人だったら、インパルスなんとかとか、なんとかフィルターとか、もっと高度なことをやると思う。

今後の課題とさせていただく。

参考文献(本文中に言及のないもの)

本エントリは、田中孝文『Rによる時系列分析入門』(pp.63-67)の真似だ。
(でも田中先生本人にこれを見せたら、「そんなことやってねえよ!」と怒られるかもしれないが)

Rによる時系列分析入門

Rによる時系列分析入門

グラフの描き方は、
グラフのX軸に日付を入れる - My Life as a Mock Quant
を参照した。

追記(ggplot2版)

おなじようなことを ggplot2 で。

len <-dim(SS)[1]
pp <- which(SS2$sessions>3000)

group <- rep(1,len-2)
group[pp[1]] <- 2
group[(pp[1]+1):(pp[2]-1)] <- 3
group[pp[2]] <- 4
group[(pp[2]+1):(len-2)] <- 5 
SS2$group<-group

date1 <- seq.Date(as.Date(sta),as.Date(en),by="week")
SS2$Week <- date1[-c(1,len)]

#head(SS2)

library(ggplot2)
library(scales)

theme_set(theme_bw(15,"HiraKakuPro-W3"))

ggplot(SS2,aes(x=Week,y=sessions,group=group))+
  geom_line()+
  geom_point()+
  scale_x_date(labels = date_format("20%y/%m")) +
  scale_y_continuous(labels = comma) +
  geom_smooth(method="lm", colour="black", linetype=2, fill="tomato")+
  labs(x="年/月(週次)", y="セッション数")

f:id:abrahamcow:20150124203849p:plain

こちらのほうがきれいかな?

赤い帯は傾向線の95%信頼区間です。
ggplot2 の stat_smooth で描かれる半透明の帯は標準誤差でなく信頼区間 - 廿TT

参考:ggplot2についてちょっと勉強した(1) - もうカツ丼でいいよな