一階線形常微分方程式を使った流行語のモデル

モデル化

流行語は話題にする人が増えれば増えるほどさらに流行しやすくなり、ある時期を超えると忘れられていくと考えられる。

このダイナミクスをなるべく簡単な微分方程式で記述したいのでこのような仮説を置いた。

流行語の拡散スピードは話題にされる量に比例する
単位時間経過ごとに流行語を話題にする人は減っていく

これを式で表すとこのようになる。

$\displaystyle \frac{dA}{dt} = rA - kA$

rは流行語の伝達スピードについての係数なので「拡散係数」とよぶことにする。

kは流行の減衰についての係数なので「忘却係数」とよぶことにする。

この方程式は解析的に解け、解は

$\displaystyle A=c\exp((r-k)t)$

となる。

ただし rは話題が飽和する時期 τを超えるとゼロになるものとした。

cは流行の規模に関わるパラメータと解釈できるが、今回は Googleトレンドのデータを使うのであまり意味を持たない。Googleトレンドの「人気度」はもともと適当にスケーリングされている。

キーワードの選定

もう始まってる⁉︎ 2015年流行語大賞候補 - NAVER まとめを参考に2015年の流行語として、とりあえず「ラッスンゴレライ」をチョイスした。

ラッスンゴレライがなんなのかはいまだに把握してない。

Google トレンドより、ラッスンゴレライの人気度を取得してプロットする。

#R のコード
sv_r <- read.csv("~/Downloads/report.csv",skip=4,stringsAsFactors =FALSE)
sv_r <- as.numeric(sv_r[1:52,2])
plot(sv_r,type="b",ylab="人気度",main="ラッスンゴレライ")

f:id:abrahamcow:20150913171424p:plain

折れ線グラフが鮫の背びれのような形になるのが、指数的増加・指数的減少のサインである。

上記のモデルを当てはめた結果をプロットする。フィッティングには minpack.lm パッケージの nls.lm 関数を用いた。

model1 <-function(t,pars){
  k <- pars[1]
  r <- pars[2]
  tau <- pars[3]
  c1 <- pars[4]
  A1 <- c1*exp((r-k)*t)
  A20 <- c1*exp((r-k)*t)
  A2 <- A20*exp(-k*(t-tau))
  ifelse(t<tau,A1,A2)}
pars<-c(k=0.6,r=0.2,tau=22,c1=0)library(minpack.lm)
res_r<-nls.lm(par=pars,fn=function(pars)sv_r-model1(1:52,pars))
plot(sv_r,type="b",ylab="人気度",main="ラッスンゴレライ")
curve(model1(x,res_r$par),add=TRUE)

f:id:abrahamcow:20150913173532p:plain

係数 r、k、τは p 値が十分に低い。

> summary(res_r)

Parameters:
    Estimate Std. Error t value Pr(>|t|)    
k    0.375390.042908.7501.66e-11***
r    0.657180.084437.7844.68e-10***
tau 20.324990.3210463.310<2e-16***
c1   0.334630.263651.2690.21---
Signif. codes:0‘***’ 0.001‘**’ 0.01‘*’ 0.05‘.’ 0.1‘ ’ 1

Residual standard error:10.5 on 48 degrees of freedom
Number of iterations to termination:29 
Reason for termination: Relative error in the sum of squares is at most `ftol'.