京橋のバイオインフォマティシャンの日常

南国のビーチパラソルの下で、Rプログラムを打ってる日常を求めて、、Daily Life of Bioinformatician in Kyobashi of Osaka

R言語で、皆さん憧れの、ランダムウォーク・シミュレーションをやってみた件

はじめに

ランダムウォークと聞いて、その響からも、皆さん、さぞ憧れのところでしょうか。

ランダムウォークとは、英語で書くとRandom walkで、次に進む位置が確率的に無作為(ランダム)に決定される運動のことを指します。

もう少し、噛み砕いて言うと、、ランダムにガチャガチャっと動くやつってことです。高校物理で習ったような、ブラウン運動のモデルでもあります。

この記事では、1次元と2次元のランダムウォークについて紹介します。

ランダムウォークをどう利用するか??ということで、、最後に、 Google検索などで取得した画像にランダムウォークでモーションをつけて可視化してみたいと思います。

それでは、始めましょう。

実行環境

以下が、実行環境です。

実行環境
macOS Big Sur (バージョン11.5.2)
MacBook Air (M1, 2020)
チップ Apple M1
メモリ 16GB

パッケージ準備

今回使用する、Rパッケージを準備します。

#パッケージ・インストール
pack <- c("GoogleImage2Array", "animation", "ggplot2", "gganimate", "rtweet", "tidyverse")
install.packages(pack[!(pack %in% unique(rownames(installed.packages())))])

#ロード
for(n in 1:length(pack)){ eval(parse(text = paste0("library(", pack[n], ")"))) }; rm("n", "pack")

1次元ランダムウォーク

まずは、1次元のランダムウォークを解説します。この運動は、1つの軸上を前後に移動するので、試行回数で展開して挙動を見てみます。

シンプルな実行例としては、-1(後進)あるいは1(前進)をランダムサンプリングするということを、N回試行した後に、cumsum関数で、累積和を求める方法です。また、ランダムサンプリングには、sample関数を使用します。

また、類似のことは、stats::arima.sim関数でもできるようです。今回は、割愛します。

では、実行してみます。

#乱数生成: 省略可
set.seed(123)

#試行回数の設定
n <- 1000

#実行: 初期位置として、最初の0はあった方が良い
x <- c(0, cumsum(sample(c(-1, 1), size=n, replace=TRUE)))

#プロット
plot(x, type="l")

一次元ランダムウォーク

1つだけではなくて、続いて、複数の一次元のランダムウォークを生成してみます。

#空変数の作成
X <- c()

#試行回数の設定
n <- 1000

#実行
for(i in 1:10){
#ランダムウォーク生成
x <- c(0, cumsum(sample(c(-1, 1), size=n, replace=TRUE)))
#列結合
X <- cbind(X, x)
}

#表示
head(X)
#     x  x x x x  x x x  x  x
#[1,] 0  0 0 0 0  0 0 0  0  0
#[2,] 1  1 1 1 1  1 1 1 -1 -1
#[3,] 2  0 0 0 2  0 0 2 -2  0
#[4,] 3 -1 1 1 3 -1 1 3 -3 -1
#[5,] 4 -2 0 2 2 -2 0 4 -4 -2
#[6,] 3 -1 1 1 3 -1 1 3 -5 -3

#プロット
par(mgp=c(2.5, 1, 0))
matplot(X, type="l", lty=1, xlab="Number of trials", 
        col = rainbow(10, alpha = 0.6))

複数の一次元ランダムウォーク

このように試行ごとで、全然パターンが違うというのは、やはり興味深いですね。

次に、これをアニメーション表示してみます。

1000回分の試行をすべてアニメーションにすると、冗長なのとサイズが大きくなるので、初めの100回分のみで、アニメーションを作成してみました。

#試行回数の制限
k <- 100

#アニメーション作成
animation::saveGIF({for(i in 2:k){
matplot(c(1:nrow(X))[1:i], X[1:i,], type="l",
        lty=1, lwd=1.5, col=rainbow(ncol(X), alpha = 0.5),
        xlab="Number of trials", ylab="", xlim=c(0, k),
        ylim=c(min(X[1:k,]), max(X[1:k,])), cex.lab=1.2, cex.axis=1.2)
matpoints(t(rep(i, ncol(X))), t(X[i,]), pch=16, col=rainbow(ncol(X), alpha = 0.7), cex=1.25)
}}, movie.name = "01_motion.gif", interval = 0.1, nmax = k, ani.width = 500, ani.height = 500, dpi=500)

一次元ランダムウォーク・アニメーション

次に、ggplotで作図する場合には、データセットの形式を少し変える必要があります。

#空変数の作成
X <- c()

#試行回数の設定
n <- 1000

#10回の繰り返し実行
for(i in 1:10){
#ランダムウォーク生成
x <- c(0, cumsum(sample(c(-1, 1), size=n, replace=TRUE)))

#DF作成
x1 <- data.frame(trials=0:n, x=x, sim=i)

#行結合
X <- rbind(X, x1)
}

#表示
head(X)
#  trials  x sim
#1      0  0   1
#2      1 -1   1
#3      2  0   1
#4      3  1   1
#5      4  2   1
#6      5  3   1

#プロット
ggplot(data = X, aes(x = trials, y = x, color = factor(sim))) + 
  geom_line(alpha = 0.6) +
  theme(legend.position = "none") 

ggplotでのプロット

2次元ランダムウォーク: 2方向移動

次に、2次元のランダムウォークでは、2方向と全方向の移動を考慮します。

まず、2方向移動は、x軸あるいはy軸の方向にランダムウォークで移動するというものです。

その為、x軸あるいはy軸の方向に前進するか、後進するかをその時その時にランダムで決定されます。

では、実行してみます。

#試行回数の設定
n <- 1000

#実行(1)
x <- sample(c(-1, 1), size=n, replace=TRUE)
#実行(2)
y <- sample(c("x", "y"), size=n, replace=TRUE)

#DF作成
Dat <- data.frame(trials=0:n, x=0, y=0)

#xあるいはy列に割り振る
for(i in 1:n){ Dat[c(i+1),y[i]] <- x[i] }

#累積計算
Dat$cx <- cumsum(Dat$x)
Dat$cy <- cumsum(Dat$y)

#表示
head(Dat)
#  trials  x  y cx cy
#1      0  0  0  0  0
#2      1 -1  0 -1  0
#3      2  0 -1 -1 -1
#4      3  0 -1 -1 -2
#5      4  1  0  0 -2
#6      5  0 -1  0 -3

#プロット
plot(Dat$cx, Dat$cy, type="l", xlab="x", ylab="y")

2方向の二次元ランダムウォーク

何度か実行してみたところ、ヘンテコな幾何学模様が沢山生成されますね。

2次元ランダムウォーク: 全方向移動

次に、全方向移動に移動する場合のランダムウォークを検討します。 この場合には「0から2π(パイ)」の間の一様乱数を生成します。 実際のやり方としては、runif関数で、0から1の間の離散型一様分布の乱数を発生させて、2π、Rでの記法は2*piで補正します。

#試行回数の設定
n <- 1000

#ランダムに値を生成
r_vec <- 2 * pi * runif(n = n, min = 0, max = 1)

#DF作成
Dat <- data.frame(trials=0:n, x=0, y=0)

#集計
Dat$x[2:nrow(Dat)] <- cumsum(cos(r_vec))
Dat$y[2:nrow(Dat)] <- cumsum(sin(r_vec))

#表示
head(Dat)
#  trials         x          y
#1      0 0.0000000 0.00000000
#2      1 0.9454171 0.32586263
#3      2 1.7773490 0.88074037
#4      3 1.1780515 0.08021397
#5      4 1.0230444 1.06812733
#6      5 2.0069765 0.88958413

#プロット
plot(Dat$x, Dat$y, type="l", xlab="x", ylab="y")

全方向移動のランダムウォーク

何度か実行してみたところ、ガチャガチャしてて、ランダムウォークっぽい感じですね。

続いて、複数の二次元のランダムウォークを生成してみます。

#試行回数の設定
n <- 200

#空変数
Z <- c()

#20回の繰り返し実行
for(i in 1:20){
#ランダムに値を生成
r_vec <- 2 * pi * runif(n = n, min = 0, max = 1)

#DF作成
Dat <- data.frame(trials=0:n, x=0, y=0)

#集計
Dat$x[2:nrow(Dat)] <- cumsum(cos(r_vec))
Dat$y[2:nrow(Dat)] <- cumsum(sin(r_vec))

#シミュレーション回数
Dat$sim <- i

#行結合
Z <- rbind(Z, Dat)
}

#表示
head(Z)
#  trials         x         y sim
#1      0 0.0000000 0.0000000   1
#2      1 0.8785386 0.4776714   1
#3      2 1.3394305 1.3651277   1
#4      3 2.3038196 1.6296150   1
#5      4 3.2821351 1.4224948   1
#6      5 3.2640218 0.4226589   1

#プロット
ggplot(data = Z, aes(x = x, y = y, color=factor(sim))) + 
  geom_path(alpha = 0.6) +
  theme(legend.position = "none") 
#注釈: geom_lineではなく、geom_pathを使用すること。

全方向のランダムウォークの繰り返し実験

それでは、ggplot2のアニメーションも以下のように実行できます。

#アニメーション作図
p <- ggplot(Z, aes(x = x, y = y, color=factor(sim))) + 
  geom_point(size = 4, show.legend = F) + 
  geom_path(size = 1, alpha = 0.5) + 
  gganimate::transition_reveal(along = trials) + 
  coord_fixed(ratio = 1) + 
  labs(title = "2D Random Walk", subtitle = "Trials: {frame_along}")

#実行: 40秒くらいかかる
p

#gif画像の出力: 実行時間 60秒くらい
gganimate::animate(p, nframes=max(Z$trials)+1, fps = 10, width = 500, height = 500,
        renderer = gganimate::gifski_renderer("02_motion.gif"))

っgpぉtでのランダムウォーク・アニメーション

ランダムウォークで画像表示のアニメーションを作成してみると、こうなる。

早速、画像を準備します。

それでは、GoogleImage2array関数を使って、Google画像検索をして、猫の画像を取得します。

次に、その画像を使って、アニメーションを作成したいと思います。

#「猫」画像の取得
CatImg <- GoogleImage2array("猫", gl="ja")

#画像表示
display.array(CatImg)

猫画像の一覧

こういう、猫の画像です。

続いて、先程の2次元のランダムウォークの結果を使って、 猫画像それぞれをrasterImage関数で作図してみます。

#実行
animation::saveGIF({for(l in 1:(max(Z$trials)+1)){
#空プロットの作成
plot(Z[,2], Z[,3], type="n", axes = FALSE, xlab="", ylab="")
  
#線の作図
for(m in 1:max(Z$sim)){
Z1 <- Z[Z$sim == m,]
lines(x = Z1$x[1:l], y = Z1$y[1:l], col=rainbow(max(Z$sim), alpha = 0.7)[m])
}

#画像サイズのパラメータ計算(6%)
a1 <- diff(range(Z[,2]))*0.06
b1 <- diff(range(Z[,3]))*0.06

#ラスター画像をプロット
for(n in 1:dim(CatImg$array)[1]){
  ff <- t(as.raster(CatImg$array[n,,,]))
  ZZ <- Z[Z$sim == n,]
  rasterImage(ff, ZZ[l,2]-a1, ZZ[l,3]-b1, 
               ZZ[l,2]+a1, ZZ[l,3]+b1)
}}}, movie.name = "03_motion.gif", interval = 0.1, nmax = max(Z$trials)+1, ani.width = 600, ani.height = 600, dpi=500)

https://github.com/kumeS/Blog/blob/master/R_random_walk/03_motion.gif

さてさて、こう言う感じになります。

実際、ani.width = 1000, ani.height = 1000, dpi=600に変更すると、サイズが27MBくらいになりますが、見易い解像度になります。

ブログにはアップできないのですが、、こちらにアップしています。

twitterから収集した画像を使ってみたら、こうなる。

では、続いて、twitterから収集した画像でもやってみましょう。

クエリは「猫島」にしました。 クエリオプションとして指定した、"filter:media"でメディアを含むツイートだけに(ほぼ?)絞れます。 また、"include_rts = TRUE"では、リツイートも検索に含められます。

また、ライブラリのバージョン(現在"rtweet v1.0.2"を使用)に寄るのか、URL情報は、他の方の記事とはやや違うロケーションに格納されている感じでした。

#検索
tweets <- search_tweets(q="猫島 filter:media", n = 200, include_rts = TRUE) 

#urlを収集
url <- c()
for(n in 1:nrow(tweets)){
  #n <- 1
  a <- tweets$entities[[n]]$media$media_url
  b <- a[!is.na(a)]
  if(any(!is.na(b))){
      url <- c(url, b)
  }
}

#重複を除く
url2 <- unique(url)

#ダウンロード関数の定義
dl_url <- function(dat){
    download.file(dat, destfile = basename(dat), mode ="wb")
    Sys.sleep(0.5)
    }

#ダウンロード実行! 
#url2[1:20] %>% walk(dl_url)

#画像読み込み: ここではEBImageを使います
Img <- c()
for(j in 1:20){
  a <- EBImage::resize(EBImage::readImage(url2[j]), w=64, h=64)
  Img <- EBImage::abind(Img, a, along=4)
}

#attrのdimnames属性を消す
attr(Img, "dimnames") <- NULL

#詳細表示
str(Img)
#num [1:64, 1:64, 1:3, 1:20] 0.101 0.1941 0.0994 0.1437 0.1112 ...

画像はアレイ形式として、重ねていきます。

ちなみに、walk関数というのを初めて知りましたが、こう使うんですね。

続いて、アニメーションを作成します。

#アニメーション実行
animation::saveGIF({for(l in 1:(max(Z$trials)+1)){
#空プロットの作成
plot(Z[,2], Z[,3], type="n", axes = FALSE, xlab="", ylab="")

#線の作図
for(m in 1:max(Z$sim)){
Z1 <- Z[Z$sim == m,]
lines(x = Z1$x[1:l], y = Z1$y[1:l], col=rainbow(max(Z$sim), alpha = 0.7)[m])
}

#画像サイズのパラメータ計算(6%)
a1 <- diff(range(Z[,2]))*0.06
b1 <- diff(range(Z[,3]))*0.06

#ラスター画像をプロット
for(n in 1:dim(Img)[4]){
  ff <- t(as.raster(Img[,,,n]))
  ZZ <- Z[Z$sim == n,]
  rasterImage(ff, ZZ[l,2]-a1, ZZ[l,3]-b1, 
               ZZ[l,2]+a1, ZZ[l,3]+b1)
}}}, movie.name = "04_motion.gif", interval = 0.1, nmax = max(Z$trials)+1, ani.width = 1000, ani.height = 1000, dpi=600)

実際、こうなりました。じゃーん、、、解像度ワル!!

https://github.com/kumeS/Blog/blob/master/R_random_walk/04_motionB.gif

まとめ

ランダムウォークを見ていると、ココロが落ち着くところがありますね。 ヒトの中にも、類似する、ランダム性があるのでしょうね。

あと、Rでの簡易プロットの場合には、タンパク質の立体構造を線図にしたときと、ほぼ同じに見てますね。

参考資料

stackoverflow.com

financetrain.com

www.anarchive-beta.com

www.anarchive-beta.com

note.com

https://qiita.com/swathci/items/59542fb174a01cb079b8

RでODE(常微分方程式)【R言語/ODEを用いて生化学の主要反応速度論モデルを数値的に解いてみたの巻】

はじめに

Rで、常微分方程式(ODE; Ordinary Differential Equation)の初期値問題を扱いたいと思います。

日本の生物系学部の講義では、あまり教えてくれないけども、 生化学・酵素化学の反応速度論は、ODEを一度解いて理解しないと 『酵素反応とは何か??』とかよく分からないまま、講義が終わってしまいます。

当時の私は、生化学で反応速度論をやっている人は「複雑な式を並べて反応モデル」を作り、なんて賢い研究者なのかと憧れを持っていました。 その後、実際には、反応速度論の基礎が分かれば、「誰でもできるやんけ」ということになりましたが。

当然ながら、複雑で解きにくいモデルとか何をモデル化するかとかいう課題もありますし、パソコンの計算性能がまだ脆弱だった時代にODEを解くのは大変な研究であったことは言うまでもありません。

仙人、ODEの課題は難しそうです。どうしましょう・・・

基本さえ分かれば、R言語の数値計算パッケージで簡単に解けてしまうものじゃよ。

それでは、本題に入っていきましょう。

解析解と数値解

数学的な問題の解は、「解析解」と「数値解」に大きく分けられて、両者は対義語ともなります。

解析解とは、数式を変形させて得られる解、つまりは解析式のことを言います。 解析解は必ずしも厳密解ではなく、近似解である場合もあります。

一方、数値解とは、実際に数値を代入して何らかのアルゴリズムを使用して、繰り返し計算して得られる解のことを言います。 ODEを数値的に解く場合、方程式に初期値を与えてみて、各項目の数値を計算することから、初期値問題の数値計算法とも呼ばれます。

解析解については、記事の補足で触れていますが、 今回実際に、Rでやるのは数値解析の内容となります。

今回扱う反応式の事例

  • 一次反応
  • 逐次反応
  • 可逆反応・不可逆反応
  • ミカエリス-メンテンの酵素反応モデル
  • 変則的な反応モデル

について、モデル式、R言語での実行プログラムと、反応モデルを解いた結果のモーションチャートなどを解説していきます。

実行環境

以下が、実行環境です。

実行環境
macOS Big Sur (バージョン11.5.2)
MacBook Air (M1, 2020)
チップ Apple M1
メモリ 16GB

パッケージ準備

今回使用する、Rパッケージを準備します。

#パッケージ・インストール
pack <- c("deSolve", "ggplot2", "animation", "tidyverse", "gganimate", "plotly", "htmltools")
install.packages(pack[!(pack %in% unique(rownames(installed.packages())))])

#ロード
for(n in 1:length(pack)){ eval(parse(text = paste0("library(", pack[n], ")"))) }; rm("n", "pack")

一次反応モデルの数値解析

一次反応モデル

まずは、最もシンプルなモデルである、一次反応モデルについて数値計算してみます。 簡単にして、[A]が減少して、それに伴い、[B]が生成されるモデルです。

それでは、Rで、一次反応モデルの連立方程式を定義します。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  r <- rep(0, length(c))
  r[1] = -k1*c["A"]
  r[2] = k1*c["A"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0、k1=0.5に設定します。時間軸は0.1刻みにします。

cinitのベクトルは、各分子種の初期濃度です。[]は各濃度値であることを示します。 また、parmsには速度定数kをlist型で与えます。 速度定数kは、その値が大きくなると反応速度は速くなり、小さくなると遅くなります。

方程式の作り方としては、1つの矢印ごとに式を作ります。 左辺は状態ではなく、例えばd[A]/dtなので、時間tあたりの[A]の変化量ということになります。

また、重要なポイントとしては、矢印の元は変化量がマイナス(+)となり、矢印の先は変化量がプラス(+)となります。つまりは、速度定数kは必ずプラスの値としますので、[A]は-k[A]の速度で減少して、逆に[B]はk[A]の速度で増加するということになります。

#初期値
cinit <- c(A = 1, B = 0)
parms <- list(k1 = 0.5)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

これで、計算完了です。以下に、deSolve::odeの引数について解説します。

yは、ODEシステムの初期値 (状態)をベクトルで与えます。 ODEシステムにおける変数の現在の推定値です。 name属性がある場合、出力行列のラベルにその名前が使用されます。

timesは、出力の時間列で、timesの最初の値は初期時間にする必要があります。

funcには、時刻tにおけるODEシステム(モデル定義)の微分値を計算するR関数を与えます。 この関数では、y、times、parmsを定義します。 parmsでは、funcの関数に渡されるパラメータを定義します。

methodでは、使用する積分器を指定します。 rkMethodクラスのリスト、あるいは文字列で"lsoda"、"lsode"、"lsodes"、"lsodar"、"vode"、"daspk"、"euler"、"rk4"、"ode23"、"ode45"、"radau"、"bdf"、"bdf_d"、"adams"、"impAdams"あるいは"impAdams_d"、"iteration"のいずれかを指定します。 また、デフォルトで使用される積分器は、「lsoda」です。

それでは、数値計算の結果について観ていきます。

#結果表示
head(Results)
#     time         A          B
#[1,]  0.0 1.0000000 0.00000000
#[2,]  0.1 0.9512284 0.04877161
#[3,]  0.2 0.9048383 0.09516172
#[4,]  0.3 0.8607090 0.13929099
#[5,]  0.4 0.8187322 0.18126785
#[6,]  0.5 0.7788021 0.22119787

#簡易プロット(1) plot関数
plot(Results)

#簡易プロット(2) matplot関数
par(mgp=c(2.5, 1, 0))
matplot(Results[,1], Results[,2:3], type="l", lwd=1.5, xlab="Time", ylab="Abundance ratio", cex.lab=1.25)
legend("right", legend=c("A", "B"), col=c("black", "red"), pch="", lty=c(1,2), lwd=2, cex=1)

簡易プロット(1)

簡易プロット(2)

[A]が一次的に下がって、それに対して、[B]が一次的に増加していくのが分かると思います。

animationパッケージでモーションチャート作成

次に、animationパッケージでアニメーション図を作成してみます。

matplot関数とsaveGIF関数を組み合わせます。

#実行
animation::saveGIF({for(n in 1:nrow(Results)){
matplot(Results[,1][1:n], data.frame(Results[,2][1:n], Results[,3][1:n]), type="l", lty=1, lwd=3, col=c("black", "red"), xlab="Time", ylab="", xlim=c(0,8), ylim=c(0,1), cex.lab=2, cex.axis=2)
legend("right", legend=c("A", "B"), col=c("black", "red"), pch="", lty=1, lwd=3, cex=2)
matpoints(Results[,1][n], Results[,2][n], pch=16, col="black", cex=2)
matpoints(Results[,1][n], Results[,3][n], pch=16, col="red", cex=2)
}}, movie.name = "01_motion.gif", interval = 0.1, nmax = nrow(Results), ani.width = 600, ani.height = 600)

animationでのgifアニメーション

ggplot2でモーションチャート作成

モダンなRプログラミングということで、ggplotでモーションチャートを作成してみます。

#DF化
Dat <- data.frame(Results)

#データ調整
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, -c(frame, time))

#表示
head(Dat0)
#  time frame Mol       val
#1  0.0     1   A 1.0000000
#2  0.1     2   A 0.9512284
#3  0.2     3   A 0.9048383
#4  0.3     4   A 0.8607090
#5  0.4     5   A 0.8187322
#6  0.5     6   A 0.7788021

#フレーム補正のパラメータ
a <- nrow(Dat0)/length(unique(Dat0$Mol))
b <- max(Dat0$time)

#実行
p <- ggplot(Dat0, aes(x = time, y = val, color = Mol)) + 
  geom_point(size = 5, show.legend = TRUE) + 
  geom_path(size = 1, alpha = 0.5, show.legend = FALSE) + 
  gganimate::transition_reveal(along = frame) +
  labs(title = "一次反応モデル", subtitle = paste0("Time: {round(frame_along*b/a, 2)}")) +
  theme_gray(base_family = "HiraKakuPro-W3")

#gif画像の出力: 実行時間 15秒くらい
gganimate::animate(p, fps = 5, duration = 20, width = 700, height = 700,
        renderer = gifski_renderer("01_ggplot_motion.gif"))

ggplot2でのgifアニメーション

plot_lyでモーションチャート作成

最近マイブームのplot_lyでモーションチャートを作成します。 今回は、こっちをメインで使用します。

#累積ラインデータセットの作成関数
accumulate_by <- function(dat, var) {
  var <- lazyeval::f_eval(var, dat)
  lvls <- plotly:::getLevels(var)
  dats <- lapply(seq_along(lvls), function(x) {
    cbind(dat[var %in% lvls[seq(1, x)], ], X = lvls[[x]])
  })
  dplyr::bind_rows(dats)
}

#累積実行
Dat1 <- Dat0 %>% accumulate_by(~frame)

#表示
head(Dat1)
#  time frame Mol        val X
#1  0.0     1   A 1.00000000 1
#2  0.0     1   B 0.00000000 1
#3  0.0     1   A 1.00000000 2
#4  0.1     2   A 0.95122839 2
#5  0.0     1   B 0.00000000 2
#6  0.1     2   B 0.04877161 2

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '一次反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="01_plotly_motion.html")

https://kumes.github.io/Blog/R_ODE/01_plotly_motion.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

逐次反応モデルの数値解析

逐次反応モデル

次に、3つ以上の分子種が連続的に反応することを想定した、逐次反応モデルについて数値計算を行なってみます。

モデルとしては、3つの分子種(A, B, C)あるいは4つの分子種(A, B, C, D)を想定します。

それでは、Rで逐次反応モデルの連立方程式を定義します。

逐次反応モデル: 3つの分子種(A, B, C)

これは、AからB、BからCが逐次的に生成されるモデルです。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  r <- rep(0, length(c))
  r[1] = -k1*c["A"]
  r[2] = k1*c["A"] - k2*c["B"]
  r[3] = k2*c["B"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0、[C]=0、k1=0.5、k2=0.4に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 0, C = 0)
parms <- list(k1 = 0.5, k2 = 0.4)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#簡易プロット
par(mgp=c(2.5, 1, 0))
matplot(Results[,1], Results[,2:ncol(Results)], type="l", lwd=1.5, xlab="Time", ylab="Abundance ratio", cex.lab=1.25)
legend("right", legend=colnames(Results)[2:ncol(Results)], 
       col=1:(ncol(Results)-1), pch="", lty=1:(ncol(Results)-1), lwd=2, cex=1)

簡易プロット

続いて、plot_lyでモーションチャートを作成します。

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, C, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '逐次反応モデル: 3つの分子種', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, 
                 transition = 0,
                 redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="02_plotly_motion_3.html")

https://kumes.github.io/Blog/R_ODE/02_plotly_motion_3.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

逐次反応モデル: 4つの分子種(A, B, C, D)

これは、AからB、BからC、CからDが逐次的に生成されるモデルです。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  r <- rep(0, length(c))
  r[1] = -k1*c["A"]
  r[2] = k1*c["A"] - k2*c["B"]
  r[3] = k2*c["B"] - k3*c["C"]
  r[4] = k3*c["C"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0、[C]=0、[D]=0、k1=0.5、k2=0.4、k3=0.3に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 0, C = 0, D = 0)
parms <- list(k1 = 0.5, k2 = 0.4, k3 = 0.3)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#簡易プロット
par(mgp=c(2.5, 1, 0))
matplot(Results[,1], Results[,2:ncol(Results)], type="l", lwd=1.5, xlab="Time", ylab="Abundance ratio", cex.lab=1.25)
legend("right", legend=colnames(Results)[2:ncol(Results)], 
       col=1:(ncol(Results)-1), pch="", lty=1:(ncol(Results)-1), lwd=2, cex=0.75)

簡易プロット

続いて、plot_lyでモーションチャートを作成します。

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, C, D, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '逐次反応モデル: 4つの分子種', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, 
                 transition = 0,
                 redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="02_plotly_motion_4.html")

https://kumes.github.io/Blog/R_ODE/02_plotly_motion_4.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

平衡反応モデルの数値解析

平衡反応モデル

続いて、平衡反応モデルについて数値計算を行なってみます。

モデルとしては、後半の反応(k2)が可逆反応の場合と不可逆反応の場合とを想定します。

それでは、まずは、不可逆反応の平衡反応モデルの連立方程式を定義します。

平衡反応モデル① 不可逆反応

A、BとCの間の反応が可逆反応で、CからDへの反応が不可逆反応であるモデルを定義します。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  r <- rep(0, length(c))
  r[1] = -k1*c["A"]*c["B"] + k2*c["C"]
  r[2] = -k1*c["A"]*c["B"] + k2*c["C"]
  r[3] = k1*c["A"]*c["B"] - k2*c["C"] - k3*c["C"]
  r[4] = k3*c["C"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0.8、[C]=0、[D]=0、k1=1、k2=0.8、k3=1に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 0.8, C = 0, D = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, C, D, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '平衡反応モデル: 不可逆反応', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="03_plotly_motion_1.html")

https://kumes.github.io/Blog/R_ODE/03_plotly_motion_1.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

平衡反応モデル② 可逆反応

次に、可逆反応の平衡反応モデルの連立方程式を定義します。

A、BとCの間の反応が可逆反応で、CからDへの反応も可逆な反応モデルを定義します。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  r <- rep(0, length(c))
  r[1] = -k1*c["A"]*c["B"] + k2*c["C"]
  r[2] = -k1*c["A"]*c["B"] + k2*c["C"]
  r[3] = k1*c["A"]*c["B"] - k2*c["C"] - k3*c["C"] + k4*c["D"]
  r[4] = k3*c["C"] - k4*c["D"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0.8、[C]=0、[D]=0、k1=1、k2=0.8、k3=1、k4=0.8に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 0.8, C = 0, D = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1, k4 = 0.8)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, C, D, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '平衡反応モデル: 可逆反応', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="03_plotly_motion_2.html")

https://kumes.github.io/Blog/R_ODE/03_plotly_motion_2.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

酵素化学への常微分方程式の応用

ミカエリス・メンテン式のプロット

次は、酵素化学分野でとても有名な、ミカエリス・メンテン速度論を取り扱います。 この式は、1913年にドイツの生化学者Leonor Michaelisとカナダの生化学者Maud L. Mentenによって提案されました。

通常、迅速平衡法あるいは定常状態法を仮定して、このミカエリス・メンテン式は導かれるが、ここでは、下記の「酵素反応 不可逆反応モデル」と「酵素反応 可逆反応モデル」という数値解析の課題として扱います。

酵素反応モデル

酵素反応 不可逆反応モデルの数値解析

それでは、酵素反応の不可逆反応モデルの連立方程式を定義します。

このモデルは、P(プロダクト)の生成が一方方向のモデルです。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  r <- rep(0, length(c))
  r[1] = -k1*c["E"]*c["S"] + k2*c["ES"]
  r[2] = -k1*c["E"]*c["S"] + (k2+k3)*c["ES"]
  r[3] = k1*c["E"]*c["S"] - (k2+k3)*c["ES"]
  r[4] = k3*c["ES"]
  return(list(r))}

次に、初期値を、[S]=1、[E]=1、[ES]=0、[P]=0、k1=1、k2=0.8、k3=1に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(S = 1, E = 1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, S, E, ES, P, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '酵素反応: 不可逆反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="04_plotly_motion_1.html")

https://kumes.github.io/Blog/R_ODE/04_plotly_motion_1.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

基質過剰・酵素低量の条件下で 不可逆反応モデルの数値解析を行うと・・・

連立方程式は上記と同じで、基質濃度([S])を変えて、反応速度をプロットしてみます。

初期値を[E]=0.1、[ES]=0、[P]=0、k1=1、k2=0.8、k3=1に設定します。時間軸は0.1刻みにします。

[S]は、2、4、6、10、15、20...という感じで複数条件を設定します。

#時間軸
t <- seq(0, 10, by=0.1)

#初期値(1)
cinit <- c(S = 2, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results1 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(2)
cinit <- c(S = 4, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results2 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(3)
cinit <- c(S = 6, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results3 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(4)
cinit <- c(S = 10, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results4 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(5)
cinit <- c(S = 15, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results5 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(6)
cinit <- c(S = 20, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results6 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(7)
cinit <- c(S = 30, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results7 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(8)
cinit <- c(S = 50, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results8 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#初期値(9)
cinit <- c(S = 100, E = 0.1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1)

#解析実行
Results9 <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#結合
Results.c <- data.frame(time=Results1[,c("time")],
                        P002=Results1[,c("P")],
                        P004=Results2[,c("P")],
                        P006=Results3[,c("P")],
                        P010=Results4[,c("P")],
                        P015=Results5[,c("P")],
                        P020=Results6[,c("P")],
                        P030=Results7[,c("P")],
                        P050=Results8[,c("P")],
                        P100=Results9[,c("P")])

それでは、deSolve::ode関数で数値計算します。

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results.c)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, 
                      value= val, P002, P004, P006, P010, P015, P020, P030, P050, P100, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '酵素反応: 基質可変での反応速度', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="04_plotly_motion_kahen.html")

https://kumes.github.io/Blog/R_ODE/04_plotly_motion_kahen.html

次に、反応の初速を計算して、基質濃度[S]に対してプロットしてみます。

#表示
head(Results.c)

#DF作成
res <- data.frame(S=c(2, 4, 6, 10, 15, 20, 30, 50, 100),
                  V=NA)

#傾きの計算
res$V[1] <- lm(P002 ~ time, data = Results.c)$coefficients[2]
res$V[2] <- lm(P004 ~ time, data = Results.c)$coefficients[2]
res$V[3] <- lm(P006 ~ time, data = Results.c)$coefficients[2]
res$V[4] <- lm(P010 ~ time, data = Results.c)$coefficients[2]
res$V[5] <- lm(P015 ~ time, data = Results.c)$coefficients[2]
res$V[6] <- lm(P020 ~ time, data = Results.c)$coefficients[2]
res$V[7] <- lm(P030 ~ time, data = Results.c)$coefficients[2]
res$V[8] <- lm(P050 ~ time, data = Results.c)$coefficients[2]
res$V[9] <- lm(P100 ~ time, data = Results.c)$coefficients[2]

#プロット
par(mgp=c(2.5, 1, 0))
matplot(res$S, res$V, type="b", pch=21, lwd=1.5, xlab="[S]", ylab="Reaction rate (v)", cex.lab=1.25)

基質濃度と反応速度のプロット

基質濃度[S]に対して、反応速度(v、ここでは反応の初速となる)をプロットしますと、上記のような飽和曲線が得られます。

Vmaxは基質濃度が無限大のときの反応速度となります。 だいたい、0.1くらいに収束すると思われます。

また、Kmはミカエリス・メンテン定数と言い、v = Vmax /2(最大速度の半分の速度)を与える基質濃度として表されます。

ja.wikipedia.org

酵素反応 可逆反応モデルの数値解析

続いて、酵素反応の可逆反応モデルをやってみます

このモデルでは、P(プロダクト)の生成が可逆方向のモデルです。

それでは、その連立方程式を定義します。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  r <- rep(0, length(c))
  r[1] = -k1*c["E"]*c["S"] + k2*c["ES"]
  r[2] = -k1*c["E"]*c["S"] + (k2+k3)*c["ES"] - k4*c["E"]*c["P"]
  r[3] = k1*c["E"]*c["S"] - (k2+k3)*c["ES"] + k4*c["E"]*c["P"]
  r[4] = k3*c["ES"] - k4*c["E"]*c["P"]
  return(list(r))}

次に、初期値を、[S]=1、[E]=1、[ES]=0、[P]=0、k1=1、k2=0.8、k3=1、k3=4に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(S = 1, E = 1, ES = 0, P = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1, k4 = 0.5)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, S, E, ES, P, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '酵素反応: 可逆反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="04_plotly_motion_2.html")

https://kumes.github.io/Blog/R_ODE/04_plotly_motion_2.html

htmlリンクをクリックすると、実際のモーションチャートが見えます。

変則的な反応システムでの数値計算

ここからは、少し変則な反応系について連立方程式を作成してみます。

四角型、逆コ型、菱形モデルと名付けています。

「□型」の反応モデル

「□型」の反応モデル

それでは、四角型の反応モデルの連立方程式を定義します。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  k5 <- parms$k5
  r <- rep(0, length(c))
  r[1] = -k1*c["A"] - k3*c["A"] + k2*c["B"] + k4*c["DA"]
  r[2] = k1*c["A"] - k2*c["B"] - k3*c["B"]
  r[3] = k3*c["A"] - k4*c["DA"] - k5*c["DA"]
  r[4] = k3*c["B"] + k5*c["DA"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=1、[DA]=0、[DB]=0、k1=1、k2=0.8、k3=1、k4 = 0.5、k5 = 1に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 1, DA = 0, DB = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1, k4 = 0.5, k5 = 1)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, DA, DB, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '四角型の反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="05_plotly_motion.html")

https://kumes.github.io/Blog/R_ODE/05_plotly_motion.html

「逆コの字」の反応モデル

「逆コの字」の反応モデル

逆コの字型という感じで、ここまでくると名前の付け方が適当になりますね。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  k5 <- parms$k5
  r <- rep(0, length(c))
  r[1] = -k1*c["A"] - k3*c["A"] + k2*c["B"]
  r[2] = k1*c["A"] - k2*c["B"]
  r[3] = k3*c["A"] - k4*c["DA"]
  r[4] = k4*c["DA"] - k5*c["DB"]
  r[5] = k5*c["DB"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=1、[DA]=0、[DB]=0、[DC]=0、k1=1、k2=0.8、k3=1、k4 = 0.5、k5 = 1に設定します。時間軸は0.1刻みにします。

#初期値
cinit <- c(A = 1, B = 1, DA = 0, DB = 0, DC = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 1, k4 = 0.5, k5 = 1)

#時間軸
t <- seq(0, 10, by=0.1)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, DA, DB, DC, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '逆コの字型の反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="06_plotly_motion.html")

https://kumes.github.io/Blog/R_ODE/06_plotly_motion.html

「◇型」の反応モデル

「◇型」の反応モデル

それでは、菱形モデルをやってみます。 このモデルは、A → Bの反応途中に、中間状態の平衡(IA ⇄ IB)を仮定しているモデルです。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  k5 <- parms$k5
  k6 <- parms$k6
  r <- rep(0, length(c))
  r[1] = -k1*c["A"] - k2*c["A"]
  r[2] = k1*c["A"] - k3*c["IA"] + k4*c["IB"] - k5*c["IA"]
  r[3] = k2*c["A"] + k3*c["IA"] - k4*c["IB"] - k6*c["IB"]
  r[4] = k5*c["IA"] + k6*c["IB"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0、[IA]=0、[IB]=0、k1=1、k2=0.8、k3=0.2、k4(=k-3) = 0.1、k5(=k4) = 1、k6(=k5) = 0.5に設定します。時間軸は0.1刻みにします。

今更ながら、cinitのインデックスの順番とlist(r)の順番は同じが良いらしいです。

#初期値
cinit <- c(A = 1, IA = 0, IB = 0, B = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 0.2, k4 = 0.1, k5 = 1, k6 = 0.5)

#時間軸
t <- seq(0, 5, by=0.05)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, IA, IB, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '菱形の反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="07_plotly_motion.html")

https://kumes.github.io/Blog/R_ODE/07_plotly_motion.html

「改変◇型」の反応モデル

「改変◇型」の反応モデル

最後に、改変の菱形モデルをやります。 これは、上記の菱形モデルに加えて、A⇄Bの平衡反応を考慮したものです。

#連立方程式の定義
Kinetics <- function(t, c, parms){
  k1 <- parms$k1
  k2 <- parms$k2
  k3 <- parms$k3
  k4 <- parms$k4
  k5 <- parms$k5
  k6 <- parms$k6
  k7 <- parms$k7
  k8 <- parms$k8
  r <- rep(0, length(c))
  r[1] = -k1*c["A"] - k2*c["A"] + k7*c["B"] - k8*c["A"]
  r[2] = k1*c["A"] - k3*c["IA"] + k4*c["IB"] - k5*c["IA"]
  r[3] = k2*c["A"] + k3*c["IA"] - k4*c["IB"] - k6*c["IB"]
  r[4] = k5*c["IA"] + k6*c["IB"] - k7*c["B"] + k8*c["A"]
  return(list(r))}

次に、初期値を、[A]=1、[B]=0、[IA]=0、[IB]=0、k1=1、k2=0.8、k3=0.2、k4(=k-3) = 0.1、k5(=k4) = 1、k6(=k5) = 0.5、k7(=k6) = 0.5、k8(=k7) = 0.75に設定します。時間軸は0.1刻みにします。

今更ながら、cinitのインデックスの順番とlist(r)の順番は同じが良いらしいです。

#初期値
cinit <- c(A = 1, IA = 0, IB = 0, B = 0)
parms <- list(k1 = 1, k2 = 0.8, k3 = 0.2, k4 = 0.1, k5 = 1, k6 = 0.5, k7 = 0.5, k8 = 0.75)

#時間軸
t <- seq(0, 5, by=0.05)

それでは、deSolve::ode関数で数値計算します。

#解析実行
Results <- deSolve::ode(y=cinit, times=t, 
                        func=Kinetics, parms=parms, method="lsoda")

#累積ラインデータセットの作成関数
source("https://gist.githubusercontent.com/kumeS/c516415c9ab4d25a2a6ae078e4d87837/raw/5be7e171ae9ce03c6110fa6a1ccb20d69aa45412/accumulate_by.R")

#DF化・データ調整・累積化
Dat <- data.frame(Results)
Dat$frame <- as.numeric(rownames(Dat))
Dat0 <- tidyr::gather(Dat, key=Mol, value= val, A, B, IA, IB, -c(frame, time))
Dat1 <- Dat0 %>% accumulate_by(~frame)
a <- nrow(Dat0)/length(unique(Dat0$Mol))

#plot_ly実行
fig <- plotly::plot_ly(Dat1,
    x = ~time, 
    y = ~val,  
    split = ~Mol,
    frame = ~X,
    type = 'scatter',
    mode = 'lines') %>%
  layout(title = '改変菱形の反応モデル', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Time'), 
         yaxis = list(title = 'Abundance ratio'), 
         legend = list(title=list(text='<b>Mol</b>')),
         margin = list(l = 80, r = 80, b = 80, t = 60, pad = 0)) %>% 
  animation_opts(frame = a, transition = 0, redraw = FALSE)

#作図
fig

#保存
fig %>% htmltools::save_html(file="08_plotly_motion.html")

https://kumes.github.io/Blog/R_ODE/08_plotly_motion.html

まとめ

「RでODE」というテーマで執筆しました。

ODEを通して、生化学反応の仕組みが少しでも理解できたら、数式を見ても楽しくなります。また、身近にODE計算できるツールとして、Rが利用できると、何かと便利です。

計算科学領域では、生化学的な反応を単にODEで解くだけではなくて、細胞空間レベルで反応シミュレーションすることも行われています。

最近では、Zane R. Thornburgらの研究によって、最小細胞である、JCVI-syn3Aの全細胞完全動力学モデル(WCM)についても報告されている。

ミクロな反応シミュレーションによって、生命科学の理解はますます進んでいくものと思われますね。

補足: 速度論の数学的基礎 (解析式)

以下、解析式を導く際の数学的な解説をしています。ご参考までに。

1. 変数分離形積分法 (同時方程式)

2. 定数係数1階線形微分方程式の公式

3. 零次反応

4. 一次反応

5.二次反応

6. 二成分反応

7. 可逆一次反応I

8. 可逆一次反応II

9. 半減期

参考資料

www.anarchive-beta.com

qiita.com

plotly.com

【R言語とWebスクレイピングとアニメーショングラフ】仮想通貨や株価変動をモーションチャートで観察してみた件【S&P100のスキャッチャープロット編】

はじめに

いま、このブログでは「アニメーショングラフ」推しなのですが、、、 「バー・チャート・レース」が少し見難いようにも思えてきて、 散布図(スキャッチャープロット)のモーションチャートをやってみることにしました。

この記事では、S&Pダウ・ジョーンズ・インデックスが算出しているアメリカの株価指数の1つである、SP100の各銘柄の時系列データ(日足)について、「モーションチャート(Motion chart)」を作成します。

SP100はちょうど100銘柄から構成されているので、100点のスキャッチャープロットとなります。

さぁ、モーションチャート作図をやっていきましょう。

関連記事

skume.net

skume.net

実行環境

実行環境
macOS Big Sur (バージョン11.5.2)
MacBook Air (M1, 2020)
チップ Apple M1
メモリ 16GB

パッケージ準備

今回使用する、Rパッケージを準備します。

ここをスキップして、以下のスクリプトを読み込むのでもOKです。

#パッケージ・インストール
pack <- c("rvest", "quantmod", "magrittr", "tidyr", "tidyverse", "plotly", "gapminder", "dygraphs", "htmltools")
install.packages(pack[!(pack %in% unique(rownames(installed.packages())))])

#ロード
for(n in 1:length(pack)){ eval(parse(text = paste0("library(", pack[n], ")"))) }; rm("n", "pack")

getSP100.Rスクリプトを読み込んでも、Rパッケージがインストールできます。

同時に、今回使用する、getSP100_list、SP100_ChartData、SP100_ChartData_modといった関数群を読み込まれます。

#スクリプトの読み込み
source("https://gist.githubusercontent.com/kumeS/e8dca57f2ba101b2ef9714ce59400460/raw/dfdcf08fdbc7fbd41eb909520c4bb0bc52adf460/getSP100.R")

SP100銘柄のデータ取得

https://en.wikipedia.org/wiki/S%26P_100

まず、getSP100_list関数では、ウェブスクレイピングを介して、ウィキペディアの該当ページからSP100の銘柄リストを取得します。

さて、下記を実行していきます。

#SP100銘柄リストの取得
SP100List <- getSP100_list()

#表示
head(SP100List)
#                       Company Ticker                 Sector
#1                        Apple   AAPL Information Technology
#2                       AbbVie   ABBV            Health Care
#3                       Abbott    ABT            Health Care
#4                    Accenture    ACN Information Technology
#5                        Adobe   ADBE Information Technology
#6 American International Group    AIG             Financials

次に、2022年年初からのSP100のデータを取得します。

#SP100のデータ取得: 実行時間 3分くらい
ChartData <- SP100_ChartData(Dat=SP100List, term=c("2022-01-01", "2022-12-31"))

#いったん、RDS保存
saveRDS(ChartData, "SP100_ChartData.Rds")

#ダウンロード
#browseURL("https://github.com/kumeS/Blog/raw/master/R_BarChart/Chart_03/SP100_ChartData.Rds")
#ChartData <- readRDS("SP100_ChartData.Rds")

#表示
head(ChartData)
#                       Company Ticker                 Sector       date close dclose dclose2 ranking
#1                        Apple   AAPL Information Technology 2022-01-03   100      0 #F0F5F0       1
#2                       AbbVie   ABBV            Health Care 2022-01-03   100      0 #F0F5F0       2
#3                       Abbott    ABT            Health Care 2022-01-03   100      0 #F0F5F0       3
#4                    Accenture    ACN Information Technology 2022-01-03   100      0 #F0F5F0       4
#5                        Adobe   ADBE Information Technology 2022-01-03   100      0 #F0F5F0       5
#6 American International Group    AIG             Financials 2022-01-03   100      0 #F0F5F0       6

このステップで、SP100の銘柄リストと値動きのデータが取得できました。

続いて、SP100_ChartData_mod関数で、データの補正を行います。

#データ補正: 全銘柄を使用
ChartData1 <- SP100_ChartData_mod(ChartData)

#表示
head(ChartData1)
#  Company Ticker      Sector CompanyTicker    CompanySector       date close dclose dclose2 ranking
#1      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-03 100.0    0.0 #F0F5F0      64
#2      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-04 101.4    1.4 #F0F5F0      38
#3      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-05 101.0    1.0 #F0F5F0      40
#4      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-06 100.1    0.1 #F0F5F0      46
#5      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-07 101.2    1.2 #F0F5F0      42
#6      3M    MMM Industrials      3M (MMM) 3M (Industrials) 2022-01-10  99.8   -0.2 #FCF3F3      52

plotlyによるモーションチャート(motion chart)の作図

それでは、取得したSP100の値動きデータを使って、モーションチャートを作成します。 値動きの大きさによって、マーカーのサイズが変わるように設定します。

#のべ日の作成
ChartData1$Day <- as.numeric(ChartData1$date) - min(as.numeric(ChartData1$date)) + 1
#マーカーのサイズ
ChartData1$Size <- (4*abs(ChartData1$dclose)/100 +1)*5
#サイズの範囲
range(ChartData1$Size)
#[1]  5.00 21.58

#plot_ly実行
fig <- plot_ly(ChartData1,
    x = ~ranking, 
    y = ~close, 
    size = ~Size, 
    color = ~Sector, 
    frame = ~Day,
    text = ~CompanySector,
    hoverinfo = "text",
    hovertemplate = paste('ranking: %{x}', '<br>%{text}',
                          '<br>Relative: %{y}<extra></extra>'),
    type = 'scatter',
    mode = 'markers'
  ) %>%
  layout(title = 'SP100 Y2022', 
         plot_bgcolor = "#e5ecf650", 
         xaxis = list(title = 'Ranking'), 
         yaxis = list(title = 'Relative price'), 
         legend = list(title=list(text='<b>Sector</b>')))

#作図: 30秒くらいかかる
fig

#保存
fig %>% htmltools::save_html(file="SP100_motion_chart.html")

https://kumes.github.io/Blog/R_BarChart/Chart_03/02_SP100_motion_chart.html

散布図だと、プロットがガチャガチャしても、何だか許容できますね。

dygraphsによるインタラクティブな作図

dygraphsパッケージは、dygraphs JavaScriptチャート・ライブラリへのRインターフェースです。 Rで時系列データを図表化するために、豊富な機能を提供しています。

このdygraphsパッケージは、xts時系列オブジェクト(または、xtsに変換可能なあらゆるオブジェクト)を自動的にプロットします。

#ワイド型への変換
ChartData2 <- ChartData1[,c("CompanySector", "date", "close")]
ChartData2.s <- spread(ChartData2, key = CompanySector, value = close)

#行名を変更する
rownames(ChartData2.s) <- as.character(ChartData2.s$date)
ChartData2.s <- ChartData2.s[,-1]

#表示(一部)
head(ChartData2.s)
#           3M (Industrials) Abbott (Health Care) AbbVie (Health Care)
#2022-01-03            100.0                100.0                100.0
#2022-01-04            101.4                 97.6                 99.8
#2022-01-05            101.0                 97.2                100.3
#2022-01-06            100.1                 97.2                 99.9
#2022-01-07            101.2                 97.5                 99.6
#2022-01-10             99.8                 97.3                100.7

#5つのサンプリング
x <- sample(1:ncol(ChartData2.s), 5)

#5つの可視化
p2 <- dygraph(ChartData2.s[,x],
        main = "SP100 Y2022",
        ylab = "Relative price") %>%
  dyRangeSelector(height = 20)  %>%
  dyLegend(show = "follow", width = 250, hideOnMouseOut = T, labelsSeparateLines = T)

#可視化
p2

#保存
p2 %>% htmltools::save_html(file="SP100_dygraph_p2.html")

https://kumes.github.io/Blog/R_BarChart/Chart_03/06_SP100_dygraph_p2.html

dygraphはプロットはサンプル数が多くなるとあまり使い物にならないかも。。 せいぜい、3-5サンプルくらいまでかな。

まとめ

SP100銘柄の2022年年初からのモーションチャートを作成しました。

バーがガンガン動く「バーチャートレース」よりも、 散布図のモーションチャートの方が目に優しい気がします。 私だけかもですが。

補足

plotlyによるインタラクティブチャート + ハイライト

ハイライトした、plotlyチャートの作成をやってみました。

#表示
head(ChartData1)

#ハイライト表示
g <- highlight_key(ChartData1, ~Ticker)

#作図
p <- plot_ly(g) %>%
  group_by(Ticker) %>%
  add_lines(x = ~date, y = ~close, color = ~CompanySector) %>%
  layout(xaxis = list(title = ""),
         yaxis = list(title = "Changes (%)"), showlegend = F) %>%
  highlight(selected = attrs_selected(showlegend = FALSE)) %>% 
  highlight(on = "plotly_click", 
                off = "plotly_doubleclick",
                persistent = FALSE,
                color = "red",
                selected = attrs_selected(opacity = 0.5))

#可視化
p

#保存
p %>% htmltools::save_html(file="SP100_plot_ly_p.html")

https://kumes.github.io/Blog/R_BarChart/Chart_03/07_SP100_plot_ly_p.html

ggplotlyによるインタラクティブチャート

plotlyパッケージ内のggplotlyという関数で、ggplot2::ggplot()のオブジェクトを plotlyオブジェクトに変換できる。マジで!!

#表示
head(ChartData1)

#ggplotで作図
p <- ggplot(ChartData1,
       aes(x = date, y = dclose, 
           group = CompanySector, 
           color = Sector)) + 
  geom_line()

#ggplotで可視化
p

##Plotlyで可視化
p1 <- ggplotly(p)

#保存
p1 %>% htmltools::save_html(file="SP100_ggplotly_p1.html")

これが、ggplotで可視化した結果です。

ggplotで可視化した結果

これが、ggplotlyで可視化した結果です。

https://kumes.github.io/Blog/R_BarChart/Chart_03/04_SP100_ggplotly_p1.html

この変換はとても簡単で、感動的です。

plotlyによるモーションチャートの実行テスト

gapminderのデータセットには、 国や地域ごと平均余命、人口、一人当たりのGDPを経時データが含まれています。

#テストデータ
df <- gapminder

#表示
head(df)
#  country     continent  year lifeExp      pop gdpPercap
#  <fct>       <fct>     <int>   <dbl>    <int>     <dbl>
#1 Afghanistan Asia       1952    28.8  8425333      779.
#2 Afghanistan Asia       1957    30.3  9240934      821.
#3 Afghanistan Asia       1962    32.0 10267083      853.
#4 Afghanistan Asia       1967    34.0 11537966      836.
#5 Afghanistan Asia       1972    36.1 13079460      740.
#6 Afghanistan Asia       1977    38.4 14880372      786.

#plot_ly実行
fig <- plot_ly(df,
    x = ~gdpPercap, 
    y = ~lifeExp, 
    size = ~pop, 
    color = ~continent, 
    frame = ~year, 
    text = ~country, 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  )

#レイアウト
fig <- fig %>% layout(
    xaxis = list( type = "log" )
  )

#作図
fig

#保存
fig %>% htmltools::save_html(file="test_motion_chart.html")

https://kumes.github.io/Blog/R_BarChart/Chart_03/05_test_motion_chart.html

ffmpegによる、mov形式をgifに変換する

ターミナルを起動して、ffmpegで変換します。

#インストール
brew install ffmpeg

#MOV形式からのgif変換: 横幅を750にする
ffmpeg -i input.mov -vf scale=750:-1 -r 10 output.gif

参考資料

ladal.edu.au

plotly.com

plotly.com

plotly.com

stackoverflow.com

rstudio.github.io

plotly-r.com