├── README.md └── book-data ├── 2-1-1-birds.csv ├── 2-1-Rの基本.R ├── 2-2-1-fish.csv ├── 2-2-データの要約.R ├── 2-3-ggplot2によるデータの可視化.R ├── 2-4-1-beer-sales-1.csv ├── 2-4-1-calc-mean-variance.stan ├── 2-4-2-calc-mean-variance-vec.stan ├── 2-4-Stanの基本.R ├── 2-5-1-animal-num.csv ├── 2-5-1-normal-dist.stan ├── 2-5-2-poisson-dist.stan ├── 2-5-MCMCの結果の評価.R ├── 2-6-1-beer-sales-ab.csv ├── 2-6-1-normal-prior.stan ├── 2-6-2-lp.stan ├── 2-6-3-lp-normal-prior.stan ├── 2-6-4-lp-normal-prior-vec.stan ├── 2-6-5-difference-mean.stan ├── 2-6-Stanコーディングの詳細.R ├── 3-10-1-interaction-1.csv ├── 3-10-2-interaction-2.csv ├── 3-10-3-interaction-3.csv ├── 3-10-交互作用.R ├── 3-2-1-beer-sales-2.csv ├── 3-2-1-simple-lm.stan ├── 3-2-2-simple-lm-vec.stan ├── 3-2-単回帰モデル.R ├── 3-3-1-simple-lm-pred.stan ├── 3-3-モデルを用いた予測.R ├── 3-4-1-lm-design-matrix.stan ├── 3-4-デザイン行列を用いた一般化線形モデルの推定.R ├── 3-5-1-brms-stan-code.stan ├── 3-5-brmsの使い方.R ├── 3-6-1-beer-sales-3.csv ├── 3-6-ダミー変数と分散分析モデル.R ├── 3-7-1-beer-sales-4.csv ├── 3-7-正規線形モデル.R ├── 3-8-1-fish-num-1.csv ├── 3-8-1-glm-pois-1.stan ├── 3-8-2-glm-pois-2.stan ├── 3-8-3-glm-pois-design-matrix.stan ├── 3-8-ポアソン回帰モデル.R ├── 3-9-1-germination.csv ├── 3-9-1-glm-binom-1.stan ├── 3-9-ロジスティック回帰モデル.R ├── 4-1-1-fish-num-2.csv ├── 4-1-1-glmm-pois.stan ├── 4-1-階層ベイズモデルと一般化線形混合モデルの基本.R ├── 4-2-1-fish-num-3.csv ├── 4-2-ランダム切片モデル.R ├── 4-3-1-fish-num-4.csv ├── 4-3-ランダム係数モデル.R ├── 5-2-1-local-level.stan ├── 5-2-1-sales-ts-1.csv ├── 5-2-ローカルレベルモデル.R ├── 5-3-1-local-level-pred.stan ├── 5-3-1-sales-ts-1-NA.csv ├── 5-3-2-local-level-interpolation.stan ├── 5-3-3-local-level-interpolation-prediction-interval.stan ├── 5-3-状態空間モデルによる予測と補間.R ├── 5-4-1-sales-ts-2.csv ├── 5-4-time-varying-coef.stan ├── 5-4-時変係数モデル.R ├── 5-5-1-sales-ts-3.csv ├── 5-5-1-smooth-trend.stan ├── 5-5-2-local-linear-trend.stan ├── 5-5-トレンドの構造.R ├── 5-6-1-basic-structual-time-series.stan ├── 5-6-1-sales-ts-4.csv ├── 5-6-周期性のモデル化.R ├── 5-7-1-autoregressive.stan ├── 5-7-1-sales-ts-5.csv ├── 5-7-自己回帰モデルとその周辺.R ├── 5-8-1-dglm-binom.stan ├── 5-8-動的一般化線形モデル：二項分布を仮定した例.R ├── 5-9-1-dglm-poisson.stan ├── 5-9-1-fish-num-ts.csv ├── 5-9-動的一般化線形モデル：ポアソン分布を仮定した例.R └── plotSSM.R /README.md: -------------------------------------------------------------------------------- 1 | # RとStanではじめる ベイズ統計モデリングによるデータ分析入門 2 | 書籍「実践Data Scienceシリーズ RとStanではじめる ベイズ統計モデリングによるデータ分析入門 (KS情報科学専門書) 」のサンプルコードとデータをここに配置しています。 3 | 4 | 詳細な情報は、下記のサポートページも参照してください。 5 | 6 | https://logics-of-blue.com/r-stan-bayesian-model-intro-book-support/ 7 | 8 | -------------------------------------------------------------------------------- /book-data/2-1-1-birds.csv: -------------------------------------------------------------------------------- 1 | species,body_length,feather_length 2 | crow,55.4,98.2 3 | crow,45.9,88.7 4 | crow,56.3,102.4 5 | crow,60.2,120.1 6 | sparrow,11.5,20.9 7 | sparrow,12.4,21.3 8 | sparrow,13.9,21.8 9 | sparrow,12.3,19.9 10 | -------------------------------------------------------------------------------- /book-data/2-1-Rの基本.R: -------------------------------------------------------------------------------- 1 | 2 | # Rの基本｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # RStudioの使い方 ------------------------------------------------------------- 7 | 8 | 1 + 1 9 | 3 - 1 10 | 3 * 4 11 | 8 / 6 12 | 2 ^ 10 13 | 14 | # これは実行されない 15 | # 1 + 1 16 | 17 | 18 | # 変数 ---------------------------------------------------------------------- 19 | 20 | # 変数の定義 21 | x <- 2 22 | 23 | # 変数を使った計算 24 | x + 1 25 | 26 | 27 | # 関数 ---------------------------------------------------------------------- 28 | 29 | # 平方根をとる 30 | sqrt(4) 31 | 32 | 33 | # ベクトル -------------------------------------------------------------------- 34 | 35 | # ベクトルの作成 36 | vector_1 <- c(1,2,3,4,5) 37 | 38 | vector_1 39 | 40 | # 等差数列 41 | 1:10 42 | 43 | 44 | 45 | # 行列 ---------------------------------------------------------------------- 46 | 47 | # 行列の作成 48 | matrix_1 <- matrix( 49 | data = 1:10, # データ 50 | nrow = 2, # 2行にする 51 | byrow = TRUE # 行(横)の順番でデータを格納する 52 | ) 53 | 54 | matrix_1 55 | 56 | # 行名と列名を変える 57 | rownames(matrix_1) <- c("Row1", "Row2") 58 | colnames(matrix_1) <- c("Col1", "Col2", "Col3", "Col4", "Col5") 59 | 60 | matrix_1 61 | 62 | 63 | # 配列 ---------------------------------------------------------------------- 64 | 65 | # 配列の作成 66 | array_1 <- array( 67 | data = 1:30, # データ 68 | dim = c(3,5,2) # (行数、列数、行列の数) 69 | ) 70 | 71 | array_1 72 | 73 | # データフレーム ----------------------------------------------------------------- 74 | 75 | # データフレームの作成 76 | data_frame_1 <- data.frame( 77 | col1 = c("A", "B", "C", "D", "E"), 78 | col2 = c(1, 2, 3, 4, 5) 79 | ) 80 | 81 | data_frame_1 82 | 83 | # 行数 84 | nrow(data_frame_1) 85 | 86 | 87 | # リスト(list) --------------------------------------------------------------- 88 | 89 | # リストの作成 90 | list_1 <- list( 91 | chara = c("A", "B", "C"), 92 | matrix = matrix_1, 93 | df = data_frame_1 94 | ) 95 | 96 | list_1 97 | 98 | 99 | # データの抽出 ------------------------------------------------------------------ 100 | 101 | # vectorの特定の値を取得 102 | vector_1[1] 103 | 104 | # matrixの場合は2次元で指定する 105 | matrix_1[1,2] 106 | 107 | # arrayの場合は3次元で指定する 108 | array_1[1,2,1] 109 | 110 | # 特定行を取得 111 | matrix_1[1,] 112 | 113 | # 特定列を取得 114 | matrix_1[,1] 115 | 116 | # 特定の範囲を取得 117 | matrix_1[1,2:4] 118 | 119 | # 要素数などを調べる 120 | dim(matrix_1) 121 | dim(array_1) 122 | 123 | # 行名と列名 124 | dimnames(matrix_1) 125 | 126 | # 行名と列名を指定してデータを抽出する 127 | matrix_1["Row1", "Col1"] 128 | 129 | # 特定の列を抽出 130 | data_frame_1$col2 131 | 132 | # 特定の列の特定の要素を抽出 133 | data_frame_1$col2[2] 134 | 135 | # 先頭行を取得 136 | head(data_frame_1, n = 2) 137 | 138 | # listの場合の抽出方法 139 | list_1$chara 140 | list_1[[1]] 141 | 142 | 143 | # 時系列データ：ts --------------------------------------------------------------- 144 | 145 | # もととなるデータフレーム 146 | data_frame_2 <- data.frame( 147 | data = 1:24 148 | ) 149 | 150 | # 時系列データに変換 151 | ts_1 <- ts( 152 | data_frame_2, # 対象データ 153 | start = c(2010,1), # 開始年月 154 | frequency = 12 # 1年におけるデータの数(頻度) 155 | ) 156 | 157 | 158 | ts_1 159 | 160 | # ファイルからのデータの読み込み ---------------------------------------------------------------- 161 | 162 | # CSVファイルを読み込む 163 | birds <- read.csv("2-1-1-birds.csv") 164 | head(birds, n = 3) 165 | 166 | # 乱数の生成 ------------------------------------------------------------------- 167 | 168 | # 平均0、標準偏差1の正規分布に従う乱数を1つ取得 169 | # 1回目 170 | rnorm(n = 1, mean = 0, sd = 1) 171 | # 2回目 172 | rnorm(n = 1, mean = 0, sd = 1) 173 | 174 | # 乱数の固定 175 | set.seed(1) 176 | rnorm(n = 1, mean = 0, sd = 1) 177 | set.seed(1) 178 | rnorm(n = 1, mean = 0, sd = 1) 179 | 180 | # 乱数の固定 181 | set.seed(1) 182 | rnorm(n = 1, mean = 0, sd = 1) 183 | rnorm(n = 1, mean = 0, sd = 1) 184 | set.seed(1) 185 | rnorm(n = 1, mean = 0, sd = 1) 186 | rnorm(n = 1, mean = 0, sd = 1) 187 | 188 | 189 | 190 | # 繰り返し構文とforループ ------------------------------------------------------------------ 191 | 192 | # forループの基本 193 | for (i in 1:3){ 194 | print(i) 195 | } 196 | 197 | # 要素番号を変えながら実行 198 | result_vec_1 <- c(0, 0, 0) # 結果を保存する入れ物 199 | set.seed(1) # 乱数の種 200 | for (i in 1:3){ 201 | result_vec_1[i] <- rnorm(n = 1, mean = 0, sd = 1) 202 | } 203 | 204 | result_vec_1 205 | 206 | 207 | # 要素番号を変えながら実行 208 | result_vec_2 <- c(0, 0, 0) # 結果を保存する入れ物 209 | mean_vec <- c(0, 10, -5) # 平均値を指定したベクトル 210 | set.seed(1) # 乱数の種 211 | for (i in 1:3){ 212 | result_vec_2[i] <- rnorm(n = 1, mean = mean_vec[i], sd = 1) 213 | } 214 | 215 | result_vec_2 216 | 217 | 218 | # 外部パッケージの活用 -------------------------------------------------------------- 219 | 220 | install.packages("tidyverse") 221 | library(tidyverse) 222 | 223 | 224 | 225 | 226 | 227 | -------------------------------------------------------------------------------- /book-data/2-2-1-fish.csv: -------------------------------------------------------------------------------- 1 | length 2 | 8.74709237851533 3 | 10.3672866484442 4 | 8.32874277517991 5 | 13.1905616042756 6 | 10.6590155436307 7 | 8.35906323176397 8 | 10.974858104857 9 | 11.4766494102584 10 | 11.151562703307 11 | 9.38922322568729 12 | 13.0235623369017 13 | 10.7796864728229 14 | 8.75751883891639 15 | 5.570600225645 16 | 12.2498618362862 17 | 9.91013278196954 18 | 9.96761947380211 19 | 11.8876724213706 20 | 11.6424423901962 21 | 11.187802642435 22 | 11.8379547432164 23 | 11.5642726014621 24 | 10.1491299667304 25 | 6.02129660827325 26 | 11.2396514957894 27 | 9.887742520942 28 | 9.68840898658934 29 | 7.05849523220145 30 | 9.04369988978276 31 | 10.8358831203994 32 | 12.7173591030581 33 | 9.79442454531401 34 | 10.7753432231187 35 | 9.89238991883419 36 | 7.24588088634279 37 | 9.17001087340064 38 | 9.2114200925793 39 | 9.88137320657763 40 | 12.2000507439678 41 | 11.5263514969151 42 | 9.67095280749283 43 | 9.49327663972698 44 | 11.3939267508095 45 | 11.1133263973473 46 | 8.62248861090096 47 | 8.58500968607576 48 | 10.7291639242737 49 | 11.5370658490308 50 | 9.77530757569954 51 | 11.7622154529084 52 | 10.7962117607341 53 | 8.77594721349846 54 | 10.6822393828488 55 | 7.74127380783841 56 | 12.8660474034021 57 | 13.9607997970117 58 | 9.26555704706698 59 | 7.91173074736694 60 | 11.1394392548848 61 | 9.72989079223835 62 | 14.8032355210096 63 | 9.92151999453366 64 | 11.3794787249016 65 | 10.0560043175613 66 | 8.51345358223519 67 | 10.3775845990287 68 | 6.39008274221792 69 | 12.9311097231258 70 | 10.3065066764238 71 | 14.3452233407243 72 | 10.9510190577993 73 | 8.58010713815637 74 | 11.2214527069781 75 | 8.1318047367115 76 | 7.4927331995218 77 | 10.5828924710349 78 | 9.11341625356313 79 | 10.0022107032632 80 | 10.1486826483033 81 | 8.82095810762386 82 | 8.862662534363 83 | 9.72964276975234 84 | 12.3561739931464 85 | 6.95286639914048 86 | 11.1878923752568 87 | 10.665900742427 88 | 12.1261996745527 89 | 9.3916321527314 90 | 10.7400376198326 91 | 10.5341975815445 92 | 8.9149599380167 93 | 12.4157356119663 94 | 12.3208052313899 95 | 11.40042729903 96 | 13.1736669090817 97 | 11.1169728511306 98 | 7.44681558308393 99 | 8.85346917152623 100 | 7.55077477020329 101 | 9.05319872712138 102 | 8.75926664555175 103 | 10.0842317462885 104 | 8.17815670289511 105 | 10.3160575448081 106 | 8.69083071216236 107 | 13.5345745387453 108 | 11.4334149520344 109 | 11.8203484589905 110 | 10.7683707156527 111 | 13.3643521610388 112 | 8.72852709210205 113 | 9.07671053927887 114 | 12.8645644770833 115 | 8.69860729337927 116 | 9.58523851279607 117 | 9.21438414111603 118 | 9.36001426290299 119 | 9.44177339404688 120 | 10.9883766625357 121 | 9.64533903546079 122 | 8.98808507577148 123 | 12.6860776503408 124 | 9.57084118290626 125 | 9.64088693991323 126 | 9.79961851757288 127 | 11.4253326141028 128 | 9.85287119174735 129 | 9.9247316570659 130 | 8.63667904248869 131 | 9.35145945550736 132 | 10.120320880869 133 | 8.82221102748067 134 | 11.0629923852651 135 | 6.96321183642643 136 | 10.6131157215795 137 | 6.92710035292483 138 | 9.39804774632678 139 | 8.94344019110999 140 | 8.695810438638 141 | 9.88620644430521 142 | 6.17128114863998 143 | 12.3531666240371 144 | 6.67005512757599 145 | 9.07293919705523 146 | 7.76815978991431 147 | 8.4983619976131 148 | 14.1743330912567 149 | 10.0347912393865 150 | 7.42739893913135 151 | 6.71878893116284 152 | 10.9003742025453 153 | 9.96288033457072 154 | 9.36386325091231 155 | 8.1412757050926 156 | 7.02507937971703 157 | 7.84961540676864 158 | 12.0000576074278 159 | 8.75746661040635 160 | 7.23114630523102 161 | 13.7385812448472 162 | 10.8502007547449 163 | 9.52270579817393 164 | 12.116966097418 165 | 11.7728453027499 166 | 8.76151390353771 167 | 14.4122049290809 168 | 9.48994593971797 169 | 7.15101069957438 170 | 9.71120079609156 171 | 10.4150766784647 172 | 14.6159567981187 173 | 10.2116047357874 174 | 10.9139976108468 175 | 9.84569412928694 176 | 9.33199831526691 177 | 9.93054794337745 178 | 11.5752792112603 179 | 14.1504900173046 180 | 12.0547848775275 181 | 12.4158167967734 182 | 7.53735315688391 183 | 11.9677911401068 184 | 10.4398496073213 185 | 7.06549994181552 186 | 11.0420454852963 187 | 9.68249079056797 188 | 12.9291746239396 189 | 8.46783600079067 190 | 9.13957649214291 191 | 8.14778100524513 192 | 9.64579207712692 193 | 10.8040235589727 194 | 8.53650365376079 195 | 11.6607463359633 196 | 7.58383442739107 197 | 7.90403117438452 198 | 12.8823154136886 199 | 7.9683050693907 200 | 10.823949424635 201 | 9.23784789778216 202 | 10.8188036793019 203 | 13.3777465724081 204 | 13.1731768668839 205 | 9.33818439863447 206 | 5.42952892941507 207 | 14.9953231796683 208 | 11.334132333531 209 | 11.0826546719274 210 | 9.97320095370818 211 | 11.0202168459059 212 | 9.67124833646067 213 | 10.841389286509 214 | 9.19950651204471 215 | 7.25958424490508 216 | 11.9756765349098 217 | 13.0394900509991 218 | 9.38251886154877 219 | 7.49342048878462 220 | 11.2844826113556 221 | 9.91058172621204 222 | 6.53356318635032 223 | 10.0042637193605 224 | 8.73939933214371 225 | 9.31806284027919 226 | 7.68685527472829 227 | 13.6062838158349 228 | 9.33773592721756 229 | 6.78897317549385 230 | 10.394386877479 231 | 10.5263512928109 232 | 8.02834659918142 233 | 4.22215865664091 234 | 8.71903659486977 235 | 11.141015271841 236 | 9.88055344791478 237 | 9.80364251198953 238 | 11.1216414572402 239 | 7.62708272284105 240 | 12.1935540885485 241 | 9.98931194344367 242 | 11.4146213347962 243 | 12.0682154694749 244 | 10.4469608298306 245 | 8.24258477426796 246 | 12.3259291119347 247 | 5.99967011042905 248 | 8.91041851999655 249 | 9.48865858168602 250 | 9.66775792646999 251 | 12.0409278175682 252 | 10.2724437862056 253 | 10.8143352068477 254 | 9.86069037397419 255 | 9.50467131676134 256 | 11.3911016132393 257 | 12.2924567144316 258 | 5.19380757021626 259 | 11.1454791104917 260 | 10.7494488135573 261 | 9.14946455688785 262 | 11.9020256151536 263 | 9.22152563656324 264 | 9.43133867640085 265 | 11.7148195561596 266 | 13.4392545982412 267 | 10.5401098018745 268 | 9.15563198042472 269 | 7.62177341028083 270 | 9.33793404224198 271 | 8.12034134697996 272 | 9.48213483376243 273 | 10.7887583364431 274 | 8.29628581595227 275 | 15.2983337621898 276 | 10.3120233513302 277 | 12.2604145349099 278 | 5.42175204031979 279 | 11.4820023143909 280 | 7.36750967909688 281 | 11.8396073552183 282 | 10.7962603109039 283 | 9.18494284146046 284 | 12.6485172603545 285 | 8.59753666150616 286 | 8.83877139151893 287 | 7.99785563794916 288 | 8.66364278649321 289 | 11.8903699067462 290 | 10.8674042990903 291 | 12.0103184353541 292 | 9.21976267189264 293 | 10.7527405835493 294 | 10.488329848973 295 | 7.14748531523492 296 | 13.5568585749509 297 | 10.2688953218674 298 | 11.5311979983157 299 | 11.910273353818 300 | 9.89886859711546 301 | 9.38836916046606 302 | 11.787347404851 303 | 7.90540370187741 304 | 13.9426747724483 305 | 9.23273578742327 306 | 13.30829060455 307 | 13.0244253879013 308 | 10.1659314671718 309 | 11.134441829703 310 | 7.95090304093108 311 | 10.6460130060449 312 | 12.0872249167124 313 | 10.1981569737944 314 | 9.09172618169128 315 | 8.68843629509912 316 | 9.92815515475498 317 | 12.1383229213536 318 | 9.03205013939745 319 | 9.75797977734511 320 | 7.41171999235832 321 | 10.9886256720297 322 | 12.6158030402283 323 | 12.9940820188056 324 | 11.6294054617947 325 | 6.26042241959478 326 | 10.9640590082475 327 | 10.9122712066024 328 | 9.29319942834018 329 | 10.340978941896 330 | 8.27192809174619 331 | 11.3584615480313 332 | 9.34579797069379 333 | 6.8618356297121 334 | 9.26509848765904 335 | 12.7288698581397 336 | 9.33143727053767 337 | 11.4655000844182 338 | 11.8931712803956 339 | 10.0087974086527 340 | 9.2953553889003 341 | 8.94060898173299 342 | 11.4791784511496 343 | 7.87308516903438 344 | 10.4924216870728 345 | 9.42100126687138 346 | 5.47022128702411 347 | 7.18229908785361 348 | 11.8320386575851 349 | 9.6174420989296 350 | 11.6065664322673 351 | 13.7749489266172 352 | 12.9477623622183 353 | 11.354536984626 354 | 10.7599253731335 355 | 9.61440314708533 356 | 13.1557835898088 357 | 11.1924682186369 358 | 7.65284611825728 359 | 9.68871493021936 360 | 6.16218035946032 361 | 9.60948230777873 362 | 4.81534466010803 363 | 12.6280043343961 364 | 8.72891399793573 365 | 9.14004232261162 366 | 9.66136333539607 367 | 11.2244363479783 368 | 11.3566803544454 369 | 11.1359039449433 370 | 8.85491479214775 371 | 7.27341748744332 372 | 9.2225555113242 373 | 10.5558282649011 374 | 8.35383775685595 375 | 9.86231813104307 376 | 7.6646753477404 377 | 9.98338197156879 378 | 10.2577108031948 379 | 9.70824874307799 380 | 9.67217808652786 381 | 13.5271040055698 382 | 11.5251730248366 383 | 12.2228621614613 384 | 8.15358609434034 385 | 10.3286836768559 386 | 12.3096503741945 387 | 9.88695715094702 388 | 5.7412787035307 389 | 10.6896915241989 390 | 6.19008910882894 391 | 8.37765969371956 392 | 12.6480086425992 393 | 11.2312736986053 394 | 12.1833379110707 395 | 10.6132097230273 396 | 9.77968247503429 397 | 8.15137445374543 398 | 13.1858275074384 399 | 10.0900211962438 400 | 8.56974319866423 401 | 11.7304461994343 402 | -------------------------------------------------------------------------------- /book-data/2-2-データの要約.R: -------------------------------------------------------------------------------- 1 | 2 | # データの要約｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | 7 | # 度数・度数分布・相対度数分布 ---------------------------------------------------------- 8 | 9 | # データの読み込み 10 | fish <- read.csv("2-2-1-fish.csv") 11 | head(fish, n = 3) 12 | 13 | # ヒストグラム 14 | hist(fish$length) 15 | 16 | 17 | # カーネル密度推定 ---------------------------------------------------------------- 18 | 19 | # カーネル密度推定 20 | kernel_density <- density(fish$length) 21 | plot(kernel_density) 22 | 23 | # バンド幅をadjust倍に変更します 24 | kernel_density_quarter <- density(fish$length, adjust = 0.25) 25 | kernel_density_quadruple <- density(fish$length, adjust = 4) 26 | 27 | # 結果の図示 28 | plot(kernel_density, 29 | lwd = 2, # 線の太さ 30 | xlab = "", # x軸ラベル名称をなくす 31 | ylim = c(0, 0.26), # y軸の範囲 32 | main = "バンド幅を変える") # グラフのタイトル 33 | lines(kernel_density_quarter, col = 2) 34 | lines(kernel_density_quadruple, col = 4) 35 | 36 | # 凡例を追加 37 | legend("topleft", # 凡例の位置 38 | col = c(1,2,4), # 線の色 39 | lwd = 1, # 線の太さ 40 | bty = "n", # 凡例の囲み線を消す 41 | legend = c("標準", "バンド幅1/4", "バンド幅4倍")) 42 | 43 | 44 | # 算術平均 -------------------------------------------------------------------- 45 | 46 | # 算術平均 47 | mean(fish$length) 48 | 49 | 50 | # 中央値・四分位点・パーセント点 ---------------------------------------------------------------- 51 | 52 | # 0から1000の等差数列 53 | suuretu <- 0:1000 54 | 55 | # 中身の確認 56 | suuretu 57 | 58 | # 長さの確認 59 | length(suuretu) 60 | 61 | # 中央値 62 | median(suuretu) 63 | quantile(suuretu, probs = c(0.5)) 64 | 65 | # 四分位点 66 | quantile(suuretu, probs = c(0.25, 0.75)) 67 | 68 | # 95%区間 69 | quantile(suuretu, probs = c(0.025, 0.975)) 70 | 71 | 72 | 73 | # 共分散とピアソンの積率相関係数 --------------------------------------------------------- 74 | 75 | # CSVファイルを読み込む 76 | birds <- read.csv("2-1-1-birds.csv") 77 | 78 | # 体の大きさと羽の大きさの相関係数 79 | cor(birds$body_length, birds$feather_length) 80 | 81 | 82 | 83 | # 自己相関係数とコレログラム ----------------------------------------------------------- 84 | 85 | # ナイル川の流量データ 86 | Nile 87 | 88 | # 標本自己共分散 89 | acf( 90 | Nile, # 対象データ 91 | type = "covariance", # 自己共分散を計算(デフォルトは自己相関) 92 | plot = F, # グラフは非表示(デフォルトはTRUE) 93 | lag.max = 5 # 5時点前までの自己共分散を計算する 94 | ) 95 | 96 | # 標本自己相関 97 | acf( 98 | Nile, # 対象データ 99 | plot = F, # グラフは非表示(デフォルトはTRUE) 100 | lag.max = 5 # 5時点前までの自己相関を計算する 101 | ) 102 | 103 | # コレログラム 104 | acf(Nile) 105 | 106 | 107 | 108 | 109 | -------------------------------------------------------------------------------- /book-data/2-3-ggplot2によるデータの可視化.R: -------------------------------------------------------------------------------- 1 | 2 | # ggplot2によるデータの可視化｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # ライブラリの読み込み 7 | library(ggplot2) 8 | 9 | # データの読み込み ---------------------------------------------------------------- 10 | 11 | # データの読み込み 12 | fish <- read.csv("2-2-1-fish.csv") 13 | head(fish, n = 3) 14 | 15 | 16 | # ヒストグラムとカーネル密度推定 --------------------------------------------------------- 17 | 18 | # ヒストグラム 19 | ggplot(data = fish, mapping = aes(x = length)) + 20 | geom_histogram(alpha = 0.5, bins = 20) + 21 | labs(title = "ヒストグラム") 22 | 23 | # カーネル密度推定 24 | ggplot(data = fish, mapping = aes(x = length)) + 25 | geom_density(size = 1.5) + 26 | labs(title = "カーネル密度推定") 27 | 28 | 29 | # グラフの重ね合わせと一覧表示 ---------------------------------------------------------- 30 | 31 | # グラフの重ね合わせ 32 | ggplot(data = fish, mapping = aes(x = length, y = ..density..)) + 33 | geom_histogram(alpha = 0.5, bins = 20) + 34 | geom_density(size = 1.5) + 35 | labs(title = "グラフの重ね合わせ") 36 | 37 | 38 | 39 | # グラフの一覧表示 40 | library(gridExtra) 41 | 42 | p_hist <- ggplot(data = fish, mapping = aes(x = length)) + 43 | geom_histogram(alpha = 0.5, bins = 20) + 44 | labs(title = "ヒストグラム") 45 | 46 | p_density <- ggplot(data = fish, mapping = aes(x = length)) + 47 | geom_density(size = 1.5) + 48 | labs(title = "カーネル密度推定") 49 | 50 | grid.arrange(p_hist, p_density, ncol = 2) 51 | 52 | 53 | # 箱ひげ図とバイオリンプロット ---------------------------------------------------------- 54 | 55 | # アヤメデータ 56 | head(iris, n = 3) 57 | 58 | # 箱ひげ図 59 | p_box <- ggplot(data = iris, 60 | mapping = aes(x = Species, y = Petal.Length)) + 61 | geom_boxplot() + 62 | labs(title = "箱ひげ図") 63 | 64 | # バイオリンプロット 65 | p_violin <- ggplot(data = iris, 66 | mapping = aes(x = Species, y = Petal.Length)) + 67 | geom_violin() + 68 | labs(title = "バイオリンプロット") 69 | 70 | 71 | # グラフの表示 72 | grid.arrange(p_box, p_violin, ncol = 2) 73 | 74 | 75 | # 散布図 --------------------------------------------------------------------- 76 | 77 | # 散布図 78 | ggplot(iris, aes(x = Petal.Width, y = Petal.Length)) + 79 | geom_point() 80 | 81 | # 色分けした散布図 82 | ggplot(iris, aes(x=Petal.Width, y=Petal.Length, color=Species)) + 83 | geom_point() 84 | 85 | 86 | 87 | # 折れ線グラフ ------------------------------------------------------------------ 88 | 89 | # ナイル川流量データ 90 | Nile 91 | 92 | # data.frameに変換 93 | nile_data_frame <- data.frame( 94 | year = 1871:1970, 95 | Nile = as.numeric(Nile) 96 | ) 97 | 98 | head(nile_data_frame, n = 3) 99 | 100 | # 折れ線グラフ 101 | ggplot(nile_data_frame, aes(x = year, y = Nile)) + 102 | geom_line() 103 | 104 | 105 | 106 | # tsオブジェクトを楽に描画する方法 107 | library(ggfortify) 108 | autoplot(Nile) 109 | 110 | 111 | 112 | # ggplot2まとめ -------------------------------------------------------------- 113 | 114 | # 疑似コード（動きません） 115 | 116 | # ggplot(データ, aes(x = X変数名, y = Y変数名, color = 色分け対象)) + 117 | # geom_xxxx(必要なら引数) + 118 | # labs(title = "グラフタイトル") 119 | 120 | 121 | 122 | 123 | -------------------------------------------------------------------------------- /book-data/2-4-1-beer-sales-1.csv: -------------------------------------------------------------------------------- 1 | sales 2 | 87.47 3 | 103.67 4 | 83.29 5 | 131.91 6 | 106.59 7 | 83.59 8 | 109.75 9 | 114.77 10 | 111.52 11 | 93.89 12 | 130.24 13 | 107.8 14 | 87.58 15 | 55.71 16 | 122.5 17 | 99.1 18 | 99.68 19 | 118.88 20 | 116.42 21 | 111.88 22 | 118.38 23 | 115.64 24 | 101.49 25 | 60.21 26 | 112.4 27 | 98.88 28 | 96.88 29 | 70.58 30 | 90.44 31 | 108.36 32 | 127.17 33 | 97.94 34 | 107.75 35 | 98.92 36 | 72.46 37 | 91.7 38 | 92.11 39 | 98.81 40 | 122 41 | 115.26 42 | 96.71 43 | 94.93 44 | 113.94 45 | 111.13 46 | 86.22 47 | 85.85 48 | 107.29 49 | 115.37 50 | 97.75 51 | 117.62 52 | 107.96 53 | 87.76 54 | 106.82 55 | 77.41 56 | 128.66 57 | 139.61 58 | 92.66 59 | 79.12 60 | 111.39 61 | 97.3 62 | 148.03 63 | 99.22 64 | 113.79 65 | 100.56 66 | 85.13 67 | 103.78 68 | 63.9 69 | 129.31 70 | 103.07 71 | 143.45 72 | 109.51 73 | 85.8 74 | 112.21 75 | 81.32 76 | 74.93 77 | 105.83 78 | 91.13 79 | 100.02 80 | 101.49 81 | 88.21 82 | 88.63 83 | 97.3 84 | 123.56 85 | 69.53 86 | 111.88 87 | 106.66 88 | 121.26 89 | 93.92 90 | 107.4 91 | 105.34 92 | 89.15 93 | 124.16 94 | 123.21 95 | 114 96 | 131.74 97 | 111.17 98 | 74.47 99 | 88.53 100 | 75.51 101 | 90.53 102 | -------------------------------------------------------------------------------- /book-data/2-4-1-calc-mean-variance.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 13 | for (i in 1:N) { 14 | sales[i] ~ normal(mu, sigma); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /book-data/2-4-2-calc-mean-variance-vec.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 13 | sales ~ normal(mu, sigma); 14 | } 15 | -------------------------------------------------------------------------------- /book-data/2-4-Stanの基本.R: -------------------------------------------------------------------------------- 1 | 2 | # Stanの基本｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | 7 | # 分析の準備 ------------------------------------------------------------------- 8 | 9 | # パッケージの読み込み 10 | library(rstan) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込み ---------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | file_beer_sales_1 <- read.csv("2-4-1-beer-sales-1.csv") 21 | 22 | # データの確認 23 | head(file_beer_sales_1, n = 3) 24 | 25 | 26 | # Stanに渡すためにデータを整形する ------------------------------------------------------ 27 | 28 | # サンプルサイズ 29 | sample_size <- nrow(file_beer_sales_1) 30 | sample_size 31 | 32 | # listにまとめる 33 | data_list <- list(sales = file_beer_sales_1$sales, N = sample_size) 34 | data_list 35 | 36 | 37 | # MCMCによるサンプリングの実施 ----------------------------------------------------------------- 38 | 39 | # 乱数の生成 40 | mcmc_result <- stan( 41 | file = "2-4-1-calc-mean-variance.stan", # stanファイル 42 | data = data_list, # 対象データ 43 | seed = 1, # 乱数の種 44 | chains = 4, # チェーン数 45 | iter = 2000, # 乱数生成の繰り返し数 46 | warmup = 1000, # バーンイン期間 47 | thin = 1 # 間引き数(1なら間引き無し) 48 | ) 49 | 50 | # 結果の表示 51 | print( 52 | mcmc_result, # MCMCサンプリングの結果 53 | probs = c(0.025, 0.5, 0.975) # 中央値と95%信用区間を出力 54 | ) 55 | 56 | 57 | # 収束の確認 ------------------------------------------------------------------- 58 | 59 | # トレースプロット(バーンイン期間無し) 60 | traceplot(mcmc_result) 61 | 62 | # トレースプロット(バーンイン期間あり) 63 | traceplot(mcmc_result, inc_warmup = T) 64 | 65 | 66 | # ベクトル化 ------------------------------------------------------------------- 67 | # 乱数の生成 68 | mcmc_result_vec <- stan( 69 | file = "2-4-2-calc-mean-variance-vec.stan", # stanファイル(ここだけ変更した) 70 | data = data_list, # 対象データ 71 | seed = 1, # 乱数の種 72 | chains = 4, # チェーン数 73 | iter = 2000, # 乱数生成の繰り返し数 74 | warmup = 1000, # バーンイン期間 75 | thin = 1 # 間引き数(1なら間引き無し) 76 | ) 77 | 78 | # 結果の表示 79 | print( 80 | mcmc_result_vec, # MCMCサンプリングの結果 81 | probs = c(0.025, 0.5, 0.975) # 事後分布の四分位点を出力 82 | ) 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | -------------------------------------------------------------------------------- /book-data/2-5-1-animal-num.csv: -------------------------------------------------------------------------------- 1 | animal_num 2 | 0 3 | 1 4 | 1 5 | 2 6 | 0 7 | 2 8 | 3 9 | 1 10 | 1 11 | 0 12 | 0 13 | 0 14 | 1 15 | 1 16 | 2 17 | 1 18 | 1 19 | 4 20 | 1 21 | 2 22 | 3 23 | 0 24 | 1 25 | 0 26 | 0 27 | 1 28 | 0 29 | 1 30 | 2 31 | 0 32 | 1 33 | 1 34 | 1 35 | 0 36 | 2 37 | 1 38 | 2 39 | 0 40 | 1 41 | 1 42 | 2 43 | 1 44 | 2 45 | 1 46 | 1 47 | 2 48 | 0 49 | 1 50 | 1 51 | 1 52 | 1 53 | 2 54 | 1 55 | 0 56 | 0 57 | 0 58 | 0 59 | 1 60 | 1 61 | 1 62 | 2 63 | 0 64 | 1 65 | 0 66 | 1 67 | 0 68 | 1 69 | 2 70 | 0 71 | 2 72 | 0 73 | 2 74 | 0 75 | 0 76 | 1 77 | 2 78 | 2 79 | 1 80 | 2 81 | 3 82 | 1 83 | 1 84 | 1 85 | 0 86 | 2 87 | 0 88 | 1 89 | 0 90 | 0 91 | 0 92 | 0 93 | 0 94 | 1 95 | 2 96 | 2 97 | 2 98 | 1 99 | 1 100 | 2 101 | 1 102 | 1 103 | 0 104 | 0 105 | 4 106 | 1 107 | 0 108 | 0 109 | 1 110 | 3 111 | 1 112 | 3 113 | 1 114 | 0 115 | 1 116 | 0 117 | 0 118 | 1 119 | 0 120 | 1 121 | 1 122 | 4 123 | 1 124 | 1 125 | 0 126 | 2 127 | 1 128 | 1 129 | 0 130 | 0 131 | 1 132 | 1 133 | 0 134 | 0 135 | 1 136 | 3 137 | 1 138 | 1 139 | 1 140 | 4 141 | 1 142 | 1 143 | 1 144 | 0 145 | 0 146 | 1 147 | 1 148 | 0 149 | 2 150 | 0 151 | 2 152 | 1 153 | 1 154 | 0 155 | 1 156 | 1 157 | 0 158 | 1 159 | 0 160 | 0 161 | 0 162 | 0 163 | 2 164 | 1 165 | 2 166 | 2 167 | 1 168 | 0 169 | 0 170 | 1 171 | 0 172 | 1 173 | 2 174 | 2 175 | 1 176 | 1 177 | 2 178 | 1 179 | 2 180 | 1 181 | 2 182 | 0 183 | 0 184 | 2 185 | 1 186 | 2 187 | 0 188 | 2 189 | 1 190 | 3 191 | 1 192 | 1 193 | 1 194 | 0 195 | 3 196 | 0 197 | 1 198 | 0 199 | 2 200 | 0 201 | 2 202 | -------------------------------------------------------------------------------- /book-data/2-5-1-normal-dist.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] animal_num; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 平均mu、標準偏差sigmaの正規分布 13 | animal_num ~ normal(mu, sigma); 14 | } 15 | 16 | generated quantities{ 17 | // 事後予測分布を得る 18 | vector[N] pred; 19 | for (i in 1:N) { 20 | pred[i] = normal_rng(mu, sigma); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /book-data/2-5-2-poisson-dist.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int animal_num[N]; // データ 4 | } 5 | 6 | parameters { 7 | real lambda; // 強度 8 | } 9 | 10 | model { 11 | // 強度lambdaのポアソン分布 12 | animal_num ~ poisson(lambda); 13 | } 14 | 15 | generated quantities{ 16 | // 事後予測分布を得る 17 | int pred[N]; 18 | for (i in 1:N) { 19 | pred[i] = poisson_rng(lambda); 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /book-data/2-5-MCMCの結果の評価.R: -------------------------------------------------------------------------------- 1 | 2 | # MCMCの結果の評価｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | # パッケージの読み込み 6 | library(rstan) 7 | library(bayesplot) 8 | 9 | library(ggfortify) 10 | 11 | 12 | # MCMCの実行(ここまでは2部3章と同じコード) ------------------------------------------------------------------- 13 | 14 | # パッケージの読み込み 15 | library(rstan) 16 | 17 | # 計算の高速化 18 | rstan_options(auto_write = TRUE) 19 | options(mc.cores = parallel::detectCores()) 20 | 21 | # 分析対象のデータ 22 | file_beer_sales_1 <- read.csv("2-4-1-beer-sales-1.csv") 23 | 24 | # サンプルサイズ 25 | sample_size <- nrow(file_beer_sales_1) 26 | 27 | # listにまとめる 28 | data_list <- list(sales = file_beer_sales_1$sales, N = sample_size) 29 | 30 | # 乱数の生成 31 | mcmc_result <- stan( 32 | file = "2-4-1-calc-mean-variance.stan", # stanファイル 33 | data = data_list, # 対象データ 34 | seed = 1, # 乱数の種 35 | chains = 4, # チェーン数 36 | iter = 2000, # 乱数生成の繰り返し数 37 | warmup = 1000, # バーンイン期間 38 | thin = 1 # 間引き数(1なら間引き無し) 39 | ) 40 | 41 | 42 | # MCMCサンプルの抽出 ------------------------------------------------------------- 43 | 44 | # MCMCサンプルの抽出 45 | mcmc_sample <- rstan::extract(mcmc_result, permuted = FALSE) 46 | 47 | ## どんな中身か 48 | 49 | # クラス 50 | class(mcmc_sample) 51 | 52 | # 次元数 53 | dim(mcmc_sample) 54 | # 各々の名称 55 | dimnames(mcmc_sample) 56 | 57 | # パラメタmuの1回目のチェーンのMCMCサンプルのburn-in後の最初のMCMCサンプル 58 | mcmc_sample[1,"chain:1","mu"] 59 | 60 | # パラメタmuの1回目のチェーンのMCMCサンプル 61 | mcmc_sample[,"chain:1","mu"] 62 | 63 | # パラメタmuの1回目のチェーンのMCMCサンプルの個数 64 | length(mcmc_sample[,"chain:1","mu"]) 65 | 66 | # 4つのチェーンすべてのMCMCサンプルの個数 67 | length(mcmc_sample[,,"mu"]) 68 | 69 | # 4つのチェーンがあるので、1000iter×4ChainのMatrix 70 | dim(mcmc_sample[,,"mu"]) 71 | class(mcmc_sample[,,"mu"]) 72 | 73 | 74 | # MCMCサンプルの代表値の計算 --------------------------------------------------------- 75 | 76 | # ベクトルにする 77 | mu_mcmc_vec <- as.vector(mcmc_sample[,,"mu"]) 78 | 79 | # 事後中央値 80 | median(mu_mcmc_vec) 81 | 82 | # 事後期待値 83 | mean(mu_mcmc_vec) 84 | 85 | # 95%ベイズ信用区間 86 | quantile(mu_mcmc_vec, probs = c(0.025, 0.975)) 87 | 88 | # 参考 89 | print( 90 | mcmc_result, # MCMCサンプリングの結果 91 | probs = c(0.025, 0.5, 0.975) # 事後分布の四分位点を出力 92 | ) 93 | 94 | 95 | # トレースプロットの描画 ------------------------------------------------------------- 96 | 97 | # 参考：標準のトレースプロット 98 | traceplot(mcmc_result, par = "mu") 99 | 100 | # MCMCサンプルを使って、トレースプロットを描く 101 | library(ggfortify) 102 | autoplot(ts(mcmc_sample[,,"mu"]), 103 | facets = F, # 4つのChainをまとめて1つのグラフにする 104 | ylab = "mu", # y軸ラベル 105 | main = "トレースプロット") 106 | 107 | # 事後分布の図示 ------------------------------------------------------ 108 | 109 | # データの整形 110 | mu_df <- data.frame( 111 | mu_mcmc_sample = mu_mcmc_vec 112 | ) 113 | 114 | # 図示 115 | ggplot(data = mu_df, mapping = aes(x = mu_mcmc_sample)) + 116 | geom_density(size = 1.5) 117 | 118 | 119 | # bayesplotを用いた事後分布の図示 ---------------------------------------------------- 120 | 121 | # ライブラリの読み込み 122 | library(bayesplot) 123 | 124 | # ヒストグラム 125 | mcmc_hist(mcmc_sample, pars = c("mu", "sigma")) 126 | 127 | # カーネル密度推定 128 | mcmc_dens(mcmc_sample, pars = c("mu", "sigma")) 129 | 130 | 131 | # bayesplotによるグラフの一覧表示 ---------------------------------------------------- 132 | 133 | # 参考：トレースプロット 134 | mcmc_trace(mcmc_sample, pars = c("mu", "sigma")) 135 | 136 | # 事後分布とトレースプロットをまとめて図示 137 | mcmc_combo(mcmc_sample, pars = c("mu", "sigma")) 138 | 139 | 140 | # bayesplotで事後分布の範囲を比較する ------------------------------------------------------- 141 | 142 | # 事後分布の範囲を比較 143 | mcmc_intervals( 144 | mcmc_sample, pars = c("mu", "sigma"), 145 | prob = 0.8, # 太い線の範囲 146 | prob_outer = 0.95 # 細い線の範囲 147 | ) 148 | 149 | # 密度の情報も加える 150 | mcmc_areas(mcmc_sample, pars = c("mu", "sigma"), 151 | prob = 0.6, # 薄い青色で塗られた範囲 152 | prob_outer = 0.99 # 細い線が描画される範囲 153 | ) 154 | 155 | # bayesplotによるMCMCサンプルの評価 ----------------------------------------------------------------- 156 | 157 | # MCMCサンプルのコレログラム 158 | mcmc_acf_bar(mcmc_sample, pars = c("mu", "sigma")) 159 | 160 | # (参考)チェーン別の事後分布 161 | mcmc_dens_overlay(mcmc_sample, pars = c("mu", "sigma")) 162 | 163 | # (参考)チェーン別のヒストグラム 164 | mcmc_hist_by_chain(mcmc_sample, pars = c("mu", "sigma")) 165 | 166 | 167 | 168 | # 事後予測チェック：MCMCの実行 ---------------------------------------------------------------- 169 | 170 | # 分析対象のデータ 171 | animal_num <- read.csv("2-5-1-animal-num.csv") 172 | head(animal_num, n = 3) 173 | 174 | # サンプルサイズ 175 | sample_size <- nrow(animal_num) 176 | 177 | # listにまとめる 178 | data_list <- list(animal_num = animal_num$animal_num, N = sample_size) 179 | 180 | # MCMCの実行：正規分布仮定のモデル 181 | mcmc_normal <- stan( 182 | file = "2-5-1-normal-dist.stan", 183 | data = data_list, 184 | seed = 1 185 | ) 186 | 187 | # MCMCの実行：ポアソン分布仮定のモデル 188 | mcmc_poisson <- stan( 189 | file = "2-5-2-poisson-dist.stan", 190 | data = data_list, 191 | seed = 1 192 | ) 193 | 194 | # 参考：推定されたパラメタ 195 | print(mcmc_normal, par = c("mu", "sigma", "lp__")) 196 | print(mcmc_poisson, par = c("lambda", "lp__")) 197 | 198 | 199 | # 事後予測チェックの実施 ------------------------------------------------------------- 200 | 201 | 202 | # 事後予測値のMCMCサンプルの取得 203 | y_rep_normal <- rstan::extract(mcmc_normal)$pred 204 | y_rep_poisson <- rstan::extract(mcmc_poisson)$pred 205 | 206 | # サンプルサイズ(nrow(animal_num))は200 207 | # 4000回分のMCMCサンプル 208 | dim(y_rep_normal) 209 | 210 | 211 | # 事後予測値の1回目のMCMCサンプルを抽出 212 | # 正規分布を仮定したモデル 213 | y_rep_normal[1,] 214 | # ポアソン分布を仮定したモデル 215 | y_rep_poisson[1,] 216 | 217 | # 参考；観測データの分布と、事後予測分布の比較 218 | hist(animal_num$animal_num) # 観測データの分布 219 | hist(y_rep_normal[1,]) # 正規分布を仮定した事後予測分布 220 | hist(y_rep_poisson[1,]) # ポアソン分布を仮定した事後予測分布 221 | 222 | # 元データのヒストグラムと、 223 | # 1~5回分のMCMCサンプルの事後予測値のヒストグラム 224 | 225 | # 正規分布を仮定したモデル 226 | ppc_hist(y = animal_num$animal_num, 227 | yrep = y_rep_normal[1:5, ]) 228 | 229 | # ポアソン分布を仮定したモデル 230 | ppc_hist(y = animal_num$animal_num, 231 | yrep = y_rep_poisson[1:5, ]) 232 | 233 | 234 | # ヒストグラムの代わりにカーネル密度推定を利用した結果 235 | 236 | # 正規分布を仮定したモデル 237 | ppc_dens(y = animal_num$animal_num, 238 | yrep = y_rep_normal[1:10, ]) 239 | 240 | # ポアソン分布を仮定したモデル 241 | ppc_dens(y = animal_num$animal_num, 242 | yrep = y_rep_poisson[1:10, ]) 243 | 244 | 245 | # 正規分布を仮定したモデル 246 | ppc_dens_overlay(y = animal_num$animal_num, 247 | yrep = y_rep_normal[1:10, ]) 248 | 249 | # ポアソン分布を仮定したモデル 250 | ppc_dens_overlay(y = animal_num$animal_num, 251 | yrep = y_rep_poisson[1:10, ]) 252 | 253 | 254 | 255 | 256 | -------------------------------------------------------------------------------- /book-data/2-6-1-beer-sales-ab.csv: -------------------------------------------------------------------------------- 1 | sales,beer_name 2 | 87.47,A 3 | 103.67,A 4 | 83.29,A 5 | 131.91,A 6 | 106.59,A 7 | 83.59,A 8 | 109.75,A 9 | 114.77,A 10 | 111.52,A 11 | 93.89,A 12 | 130.24,A 13 | 107.8,A 14 | 87.58,A 15 | 55.71,A 16 | 122.5,A 17 | 99.1,A 18 | 99.68,A 19 | 118.88,A 20 | 116.42,A 21 | 111.88,A 22 | 118.38,A 23 | 115.64,A 24 | 101.49,A 25 | 60.21,A 26 | 112.4,A 27 | 98.88,A 28 | 96.88,A 29 | 70.58,A 30 | 90.44,A 31 | 108.36,A 32 | 127.17,A 33 | 97.94,A 34 | 107.75,A 35 | 98.92,A 36 | 72.46,A 37 | 91.7,A 38 | 92.11,A 39 | 98.81,A 40 | 122,A 41 | 115.26,A 42 | 96.71,A 43 | 94.93,A 44 | 113.94,A 45 | 111.13,A 46 | 86.22,A 47 | 85.85,A 48 | 107.29,A 49 | 115.37,A 50 | 97.75,A 51 | 117.62,A 52 | 107.96,A 53 | 87.76,A 54 | 106.82,A 55 | 77.41,A 56 | 128.66,A 57 | 139.61,A 58 | 92.66,A 59 | 79.12,A 60 | 111.39,A 61 | 97.3,A 62 | 148.03,A 63 | 99.22,A 64 | 113.79,A 65 | 100.56,A 66 | 85.13,A 67 | 103.78,A 68 | 63.9,A 69 | 129.31,A 70 | 103.07,A 71 | 143.45,A 72 | 109.51,A 73 | 85.8,A 74 | 112.21,A 75 | 81.32,A 76 | 74.93,A 77 | 105.83,A 78 | 91.13,A 79 | 100.02,A 80 | 101.49,A 81 | 88.21,A 82 | 88.63,A 83 | 97.3,A 84 | 123.56,A 85 | 69.53,A 86 | 111.88,A 87 | 106.66,A 88 | 121.26,A 89 | 93.92,A 90 | 107.4,A 91 | 105.34,A 92 | 89.15,A 93 | 124.16,A 94 | 123.21,A 95 | 114,A 96 | 131.74,A 97 | 111.17,A 98 | 74.47,A 99 | 88.53,A 100 | 75.51,A 101 | 90.53,A 102 | 151.39,B 103 | 171.26,B 104 | 142.67,B 105 | 174.74,B 106 | 150.36,B 107 | 223.02,B 108 | 191.5,B 109 | 197.31,B 110 | 181.53,B 111 | 220.47,B 112 | 150.93,B 113 | 156.15,B 114 | 212.97,B 115 | 150.48,B 116 | 163.78,B 117 | 158.22,B 118 | 160.4,B 119 | 161.63,B 120 | 184.83,B 121 | 164.68,B 122 | 154.82,B 123 | 210.29,B 124 | 163.56,B 125 | 164.61,B 126 | 166.99,B 127 | 191.38,B 128 | 167.79,B 129 | 168.87,B 130 | 149.55,B 131 | 160.27,B 132 | 171.8,B 133 | 152.33,B 134 | 185.94,B 135 | 124.45,B 136 | 179.2,B 137 | 123.91,B 138 | 160.97,B 139 | 154.15,B 140 | 150.44,B 141 | 168.29,B 142 | 112.57,B 143 | 205.3,B 144 | 120.05,B 145 | 156.09,B 146 | 136.52,B 147 | 147.48,B 148 | 232.61,B 149 | 170.52,B 150 | 131.41,B 151 | 120.78,B 152 | 183.51,B 153 | 169.44,B 154 | 160.46,B 155 | 142.12,B 156 | 125.38,B 157 | 137.74,B 158 | 200,B 159 | 151.36,B 160 | 128.47,B 161 | 226.08,B 162 | 182.75,B 163 | 162.84,B 164 | 201.75,B 165 | 196.59,B 166 | 151.42,B 167 | 236.18,B 168 | 162.35,B 169 | 127.27,B 170 | 165.67,B 171 | 176.23,B 172 | 239.24,B 173 | 173.17,B 174 | 183.71,B 175 | 167.69,B 176 | 159.98,B 177 | 168.96,B 178 | 193.63,B 179 | 232.26,B 180 | 200.82,B 181 | 206.24,B 182 | 133.06,B 183 | 199.52,B 184 | 176.6,B 185 | 125.98,B 186 | 185.63,B 187 | 165.24,B 188 | 213.94,B 189 | 147.02,B 190 | 157.09,B 191 | 142.22,B 192 | 164.69,B 193 | 182.06,B 194 | 148.05,B 195 | 194.91,B 196 | 133.76,B 197 | 138.56,B 198 | 213.23,B 199 | 139.52,B 200 | 182.36,B 201 | 158.57,B 202 | -------------------------------------------------------------------------------- /book-data/2-6-1-normal-prior.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 事前分布の設定 13 | mu ~ normal(0, 1000000); 14 | sigma ~ normal(0, 1000000); 15 | 16 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 17 | for (i in 1:N) { 18 | sales[i] ~ normal(mu, sigma); 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /book-data/2-6-2-lp.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 13 | for (i in 1:N) { 14 | target += normal_lpdf(sales[i]|mu, sigma); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /book-data/2-6-3-lp-normal-prior.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 事前分布の設定 13 | target += normal_lpdf(mu|0, 1000000); 14 | target += normal_lpdf(sigma|0, 1000000); 15 | 16 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 17 | for (i in 1:N) { 18 | target += normal_lpdf(sales[i]|mu, sigma); 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /book-data/2-6-4-lp-normal-prior-vec.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // データ 4 | } 5 | 6 | parameters { 7 | real mu; // 平均 8 | real sigma; // 標準偏差 9 | } 10 | 11 | model { 12 | // 事前分布の設定 13 | target += normal_lpdf(mu|0, 1000000); 14 | target += normal_lpdf(sigma|0, 1000000); 15 | 16 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 17 | target += normal_lpdf(sales|mu, sigma); 18 | } 19 | -------------------------------------------------------------------------------- /book-data/2-6-5-difference-mean.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales_a; // ビールAの売り上げデータ 4 | vector[N] sales_b; // ビールBの売り上げデータ 5 | } 6 | 7 | parameters { 8 | real mu_a; // ビールAの平均 9 | real sigma_a; // ビールAの標準偏差 10 | real mu_b; // ビールBの平均 11 | real sigma_b; // ビールBの標準偏差 12 | } 13 | 14 | model { 15 | // 平均mu、標準偏差sigmaの正規分布に従ってデータが得られたと仮定 16 | sales_a ~ normal(mu_a, sigma_a); 17 | sales_b ~ normal(mu_b, sigma_b); 18 | } 19 | 20 | generated quantities { 21 | real diff; // ビールAとBの売り上げ平均の差 22 | diff = mu_b - mu_a; 23 | } 24 | -------------------------------------------------------------------------------- /book-data/2-6-Stanコーディングの詳細.R: -------------------------------------------------------------------------------- 1 | 2 | # Stanコーディングの詳細｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 書籍のコードを実行するまでの前準備 ------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # 分析対象のデータ読み込み 17 | file_beer_sales_1 <- read.csv("2-4-1-beer-sales-1.csv") 18 | 19 | # サンプルサイズ 20 | sample_size <- nrow(file_beer_sales_1) 21 | 22 | # listにまとめる 23 | data_list <- list(sales = file_beer_sales_1$sales, N = sample_size) 24 | 25 | # 乱数の生成(3章と同じモデル) 26 | mcmc_result_1 <- stan( 27 | file = "2-4-1-calc-mean-variance.stan", 28 | data = data_list, 29 | seed = 1 30 | ) 31 | 32 | print( 33 | mcmc_result_1, 34 | probs = c(0.025, 0.5, 0.975) 35 | ) 36 | 37 | # サンプリング文 ----------------------------------------------------------------- 38 | 39 | # 乱数の生成(正規分布に従う事前分布を指定) 40 | mcmc_result_2 <- stan( 41 | file = "2-6-1-normal-prior.stan", 42 | data = data_list, 43 | seed = 1 44 | ) 45 | 46 | print( 47 | mcmc_result_2, 48 | probs = c(0.025, 0.5, 0.975) 49 | ) 50 | 51 | 52 | # 対数密度加算文 ----------------------------------------------------------------- 53 | 54 | # 乱数の生成(対数密度加算文の使用) 55 | mcmc_result_3 <- stan( 56 | file = "2-6-2-lp.stan", 57 | data = data_list, 58 | seed = 1 59 | ) 60 | 61 | print( 62 | mcmc_result_3, 63 | probs = c(0.025, 0.5, 0.975) 64 | ) 65 | 66 | 67 | # 乱数の生成(対数密度加算文の使用、事前分布を正規分布にした) 68 | mcmc_result_4 <- stan( 69 | file = "2-6-3-lp-normal-prior.stan", 70 | data = data_list, 71 | seed = 1 72 | ) 73 | 74 | print( 75 | mcmc_result_4, 76 | probs = c(0.025, 0.5, 0.975) 77 | ) 78 | 79 | 80 | # 乱数の生成(対数密度加算文の使用、ベクトル化) 81 | mcmc_result_5 <- stan( 82 | file = "2-6-4-lp-normal-prior-vec.stan", 83 | data = data_list, 84 | seed = 1 85 | ) 86 | 87 | print( 88 | mcmc_result_5, 89 | probs = c(0.025, 0.5, 0.975) 90 | ) 91 | 92 | 93 | # 平均値の差の評価とgenerated quantitiesブロック --------------------------------------- 94 | 95 | # 分析対象のデータ読み込み 96 | file_beer_sales_ab <- read.csv("2-6-1-beer-sales-ab.csv") 97 | head(file_beer_sales_ab, n = 3) 98 | 99 | # ビールの種類別のヒストグラム 100 | ggplot(data = file_beer_sales_ab, 101 | mapping = aes(x = sales, y = ..density.., 102 | color = beer_name, fill = beer_name)) + 103 | geom_histogram(alpha = 0.5, position = "identity")+ 104 | geom_density(alpha = 0.5, size = 0) 105 | 106 | 107 | # ビールの種類別にデータを分ける 108 | sales_a <- file_beer_sales_ab$sales[1:100] 109 | sales_b <- file_beer_sales_ab$sales[101:200] 110 | 111 | # listにまとめる 112 | data_list_ab <- list( 113 | sales_a = sales_a, 114 | sales_b = sales_b, 115 | N = 100 116 | ) 117 | 118 | # 乱数の生成 119 | mcmc_result_6 <- stan( 120 | file = "2-6-5-difference-mean.stan", 121 | data = data_list_ab, 122 | seed = 1 123 | ) 124 | 125 | print( 126 | mcmc_result_6, 127 | probs = c(0.025, 0.5, 0.975) 128 | ) 129 | 130 | 131 | # 参考 132 | mcmc_sample <- rstan::extract(mcmc_result_6, permuted = FALSE) 133 | mcmc_dens(mcmc_sample, pars = "diff") 134 | 135 | -------------------------------------------------------------------------------- /book-data/3-10-1-interaction-1.csv: -------------------------------------------------------------------------------- 1 | sales,publicity,bargen 2 | 87.5,not,not 3 | 103.7,not,not 4 | 83.3,not,not 5 | 131.9,not,not 6 | 106.6,not,not 7 | 83.6,not,not 8 | 109.7,not,not 9 | 114.8,not,not 10 | 111.5,not,not 11 | 93.9,not,not 12 | 130.2,not,not 13 | 107.8,not,not 14 | 87.6,not,not 15 | 55.7,not,not 16 | 122.5,not,not 17 | 99.1,not,not 18 | 99.7,not,not 19 | 118.9,not,not 20 | 116.4,not,not 21 | 111.9,not,not 22 | 118.4,not,not 23 | 115.6,not,not 24 | 101.5,not,not 25 | 60.2,not,not 26 | 112.4,not,not 27 | 128.9,not,to_implement 28 | 126.9,not,to_implement 29 | 100.6,not,to_implement 30 | 120.4,not,to_implement 31 | 138.4,not,to_implement 32 | 157.2,not,to_implement 33 | 127.9,not,to_implement 34 | 137.8,not,to_implement 35 | 128.9,not,to_implement 36 | 102.5,not,to_implement 37 | 121.7,not,to_implement 38 | 122.1,not,to_implement 39 | 128.8,not,to_implement 40 | 152,not,to_implement 41 | 145.3,not,to_implement 42 | 126.7,not,to_implement 43 | 124.9,not,to_implement 44 | 143.9,not,to_implement 45 | 141.1,not,to_implement 46 | 116.2,not,to_implement 47 | 115.9,not,to_implement 48 | 137.3,not,to_implement 49 | 145.4,not,to_implement 50 | 127.8,not,to_implement 51 | 147.6,not,to_implement 52 | 118,to_implement,not 53 | 97.8,to_implement,not 54 | 116.8,to_implement,not 55 | 87.4,to_implement,not 56 | 138.7,to_implement,not 57 | 149.6,to_implement,not 58 | 102.7,to_implement,not 59 | 89.1,to_implement,not 60 | 121.4,to_implement,not 61 | 107.3,to_implement,not 62 | 158,to_implement,not 63 | 109.2,to_implement,not 64 | 123.8,to_implement,not 65 | 110.6,to_implement,not 66 | 95.1,to_implement,not 67 | 113.8,to_implement,not 68 | 73.9,to_implement,not 69 | 139.3,to_implement,not 70 | 113.1,to_implement,not 71 | 153.5,to_implement,not 72 | 119.5,to_implement,not 73 | 95.8,to_implement,not 74 | 122.2,to_implement,not 75 | 91.3,to_implement,not 76 | 84.9,to_implement,not 77 | 165.8,to_implement,to_implement 78 | 151.1,to_implement,to_implement 79 | 160,to_implement,to_implement 80 | 161.5,to_implement,to_implement 81 | 148.2,to_implement,to_implement 82 | 148.6,to_implement,to_implement 83 | 157.3,to_implement,to_implement 84 | 183.6,to_implement,to_implement 85 | 129.5,to_implement,to_implement 86 | 171.9,to_implement,to_implement 87 | 166.7,to_implement,to_implement 88 | 181.3,to_implement,to_implement 89 | 153.9,to_implement,to_implement 90 | 167.4,to_implement,to_implement 91 | 165.3,to_implement,to_implement 92 | 149.1,to_implement,to_implement 93 | 184.2,to_implement,to_implement 94 | 183.2,to_implement,to_implement 95 | 174,to_implement,to_implement 96 | 191.7,to_implement,to_implement 97 | 171.2,to_implement,to_implement 98 | 134.5,to_implement,to_implement 99 | 148.5,to_implement,to_implement 100 | 135.5,to_implement,to_implement 101 | 150.5,to_implement,to_implement 102 | -------------------------------------------------------------------------------- /book-data/3-10-2-interaction-2.csv: -------------------------------------------------------------------------------- 1 | sales,publicity,temperature 2 | 74,not,8 3 | 60.2,not,11.2 4 | 91.2,not,17.2 5 | 81.8,not,27.2 6 | 90.9,not,6.1 7 | 143.6,not,27 8 | 99.3,not,28.3 9 | 68.7,not,19.8 10 | 99.2,not,18.9 11 | 51.1,not,1.9 12 | 110.4,not,6.2 13 | 59.8,not,5.3 14 | 105,not,20.6 15 | 73.6,not,11.5 16 | 81.3,not,23.1 17 | 83.6,not,14.9 18 | 56.9,not,21.5 19 | 138.9,not,29.8 20 | 75.9,not,11.4 21 | 140.1,not,23.3 22 | 115.5,not,28 23 | 48.6,not,6.4 24 | 101.4,not,19.6 25 | 38.9,not,3.8 26 | 40.9,not,8 27 | 79,not,11.6 28 | 41.9,not,0.4 29 | 73,not,11.5 30 | 103.7,not,26.1 31 | 58.6,not,10.2 32 | 67.6,not,14.5 33 | 83.3,not,18 34 | 103.2,not,14.8 35 | 30.7,not,5.6 36 | 111.5,not,24.8 37 | 96.9,not,20.1 38 | 118.9,not,23.8 39 | 50.3,not,3.2 40 | 100.8,not,21.7 41 | 79.9,not,12.3 42 | 88.3,not,24.6 43 | 113,not,19.4 44 | 120.2,not,23.5 45 | 97.2,not,16.6 46 | 113.5,not,15.9 47 | 108.6,not,23.7 48 | 25.9,not,0.7 49 | 67.1,not,14.3 50 | 69.5,not,22 51 | 82.1,not,20.8 52 | 147.7,to_implement,14.3 53 | 241.4,to_implement,25.8 54 | 133.5,to_implement,13.1 55 | 114.3,to_implement,7.3 56 | 61.6,to_implement,2.1 57 | 116.3,to_implement,3 58 | 140.8,to_implement,9.5 59 | 187.4,to_implement,15.6 60 | 207,to_implement,19.9 61 | 179,to_implement,12.2 62 | 239.1,to_implement,27.4 63 | 112.4,to_implement,8.8 64 | 185.2,to_implement,13.8 65 | 117,to_implement,10 66 | 192.4,to_implement,19.5 67 | 106,to_implement,7.7 68 | 154.4,to_implement,14.4 69 | 215.4,to_implement,23 70 | 87.4,to_implement,2.5 71 | 240.6,to_implement,26.3 72 | 121.3,to_implement,10.2 73 | 263.3,to_implement,25.2 74 | 128.5,to_implement,10.4 75 | 126.4,to_implement,10 76 | 158.1,to_implement,14.3 77 | 261.9,to_implement,26.8 78 | 239.8,to_implement,25.9 79 | 141.1,to_implement,11.7 80 | 209.5,to_implement,23.3 81 | 255.1,to_implement,28.8 82 | 152.2,to_implement,13 83 | 198,to_implement,21.4 84 | 154.6,to_implement,12 85 | 98.2,to_implement,9.8 86 | 225,to_implement,22.7 87 | 72,to_implement,6.1 88 | 203.1,to_implement,21.3 89 | 75.3,to_implement,3.7 90 | 98.8,to_implement,7.4 91 | 89,to_implement,4.3 92 | 72.1,to_implement,7.2 93 | 96.1,to_implement,1.8 94 | 161.8,to_implement,19.3 95 | 234.8,to_implement,26.3 96 | 201.5,to_implement,23.4 97 | 212.3,to_implement,23.9 98 | 197.6,to_implement,13.7 99 | 146.4,to_implement,12.3 100 | 204.4,to_implement,24.3 101 | 153.9,to_implement,18.1 102 | -------------------------------------------------------------------------------- /book-data/3-10-3-interaction-3.csv: -------------------------------------------------------------------------------- 1 | sales,product,clerk 2 | 142.5,17,3 3 | 193.2,38,4 4 | 376.7,33,9 5 | 231,17,8 6 | 134.8,48,3 7 | 361,48,6 8 | 252.8,15,8 9 | 289.2,43,5 10 | 87.6,29,2 11 | 89,32,2 12 | 35.5,32,1 13 | 231,20,7 14 | 201.4,40,4 15 | 223.2,17,6 16 | 311.3,26,8 17 | 417.1,44,8 18 | 462.6,49,8 19 | 118.9,19,2 20 | 350.1,28,9 21 | 164.3,13,6 22 | 76.8,36,1 23 | 132.8,26,3 24 | 487.2,43,9 25 | 231.4,16,8 26 | 107.1,24,3 27 | 296.8,30,7 28 | 178.6,16,6 29 | 140.8,24,3 30 | 346.5,49,7 31 | 107.2,15,4 32 | 127.8,10,3 33 | 252.6,17,8 34 | 63.4,42,1 35 | 426.7,45,9 36 | 198.3,31,4 37 | 292,35,6 38 | 272.6,44,5 39 | 285.7,21,8 40 | 138.2,37,2 41 | 114.9,16,4 42 | 84.3,49,2 43 | 134.2,22,3 44 | 171.9,15,6 45 | 122.7,17,3 46 | 278.9,48,5 47 | 332.9,42,7 48 | 337.1,49,6 49 | 139,24,3 50 | 193.9,30,5 51 | 126.1,42,3 52 | 115.5,10,2 53 | 130.6,11,4 54 | 380.4,37,8 55 | 189.1,47,4 56 | 266.5,21,7 57 | 119.1,42,3 58 | 405.3,41,8 59 | 105.3,50,2 60 | 101.4,35,2 61 | 155.4,38,3 62 | 398,41,8 63 | 454.2,45,9 64 | 47.6,35,1 65 | 243.2,20,7 66 | 121.7,44,3 67 | 218.3,27,6 68 | 137.5,26,2 69 | 306,28,9 70 | 44.2,19,1 71 | 178.8,13,5 72 | 320.8,21,9 73 | 112.8,22,2 74 | 117.1,12,3 75 | 252.5,17,8 76 | 127.9,17,4 77 | 323,40,7 78 | 150.8,22,4 79 | 77.3,45,2 80 | 248.4,26,6 81 | 186.5,33,5 82 | 299.4,24,9 83 | 250.8,37,6 84 | 236.8,11,9 85 | 243.4,26,7 86 | 106.9,18,2 87 | 431.5,44,8 88 | 96.5,49,2 89 | 261.3,23,7 90 | 82.9,39,2 91 | 106.1,24,2 92 | 70.6,49,2 93 | 162.5,26,4 94 | 300.1,25,9 95 | 90.7,32,2 96 | 228.8,29,5 97 | 136,18,3 98 | 122.1,27,3 99 | 80.2,14,2 100 | 101.9,15,3 101 | 81.1,28,2 102 | -------------------------------------------------------------------------------- /book-data/3-10-交互作用.R: -------------------------------------------------------------------------------- 1 | 2 | # 交互作用｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備：全体 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # カテゴリ×カテゴリ：モデル化 --------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | interaction_1 <- read.csv("3-10-1-interaction-1.csv") 21 | head(interaction_1, n = 3) 22 | 23 | # データの要約 24 | summary(interaction_1) 25 | 26 | # デザイン行列の作成 27 | model.matrix(sales ~ publicity * bargen, interaction_1) 28 | 29 | # モデル化 30 | interaction_brms_1 <- brm( 31 | formula = sales ~ publicity * bargen, 32 | family = gaussian(link = "identity"), 33 | data = interaction_1, 34 | seed = 1, 35 | prior = c(set_prior("", class = "Intercept"), 36 | set_prior("", class = "sigma")) 37 | ) 38 | 39 | # 参考 40 | interaction_brms_1_2 <- brm( 41 | formula = sales ~ publicity + bargen + publicity:bargen, 42 | family = gaussian(link = "identity"), 43 | data = interaction_1, 44 | seed = 1, 45 | prior = c(set_prior("", class = "Intercept"), 46 | set_prior("", class = "sigma")) 47 | ) 48 | 49 | # MCMCの結果の確認 50 | interaction_brms_1 51 | 52 | # 参考：事後分布の図示 53 | plot(interaction_brms_1) 54 | 55 | # カテゴリ×カテゴリ：係数の解釈 --------------------------------------------------------- 56 | 57 | # 交互作用の効果の確認 58 | # 説明変数を作る 59 | newdata_1 <- data.frame( 60 | publicity = rep(c("not", "to_implement"),2), 61 | bargen = rep(c("not", "to_implement"),each = 2) 62 | ) 63 | newdata_1 64 | # 予測 65 | round(fitted(interaction_brms_1, newdata_1), 2) 66 | 67 | 68 | # カテゴリ×カテゴリ：モデルの図示 --------------------------------------------------------- 69 | 70 | # モデルの図示 71 | eff_1 <- marginal_effects(interaction_brms_1, 72 | effects = "publicity:bargen") 73 | plot(eff_1, points = T) 74 | 75 | 76 | # カテゴリ×数量：モデル化 --------------------------------------------------------- 77 | 78 | # 分析対象のデータ 79 | interaction_2 <- read.csv("3-10-2-interaction-2.csv") 80 | head(interaction_2, n = 3) 81 | 82 | # データの要約 83 | summary(interaction_2) 84 | 85 | # 参考：デザイン行列の作成 86 | model.matrix(sales ~ publicity * temperature, interaction_2) 87 | 88 | # モデル化 89 | interaction_brms_2 <- brm( 90 | formula = sales ~ publicity * temperature, 91 | family = gaussian(link = "identity"), 92 | data = interaction_2, 93 | seed = 1, 94 | prior = c(set_prior("", class = "Intercept"), 95 | set_prior("", class = "sigma")) 96 | ) 97 | 98 | 99 | # MCMCの結果の確認 100 | interaction_brms_2 101 | 102 | # 参考：事後分布の図示 103 | plot(interaction_brms_2) 104 | 105 | # カテゴリ×数量：係数の解釈 --------------------------------------------------------- 106 | 107 | # 交互作用の効果の確認 108 | # 説明変数を作る 109 | newdata_2 <- data.frame( 110 | publicity = rep(c("not", "to_implement"), each = 2), 111 | temperature = c(0,10,0,10) 112 | ) 113 | newdata_2 114 | # 予測 115 | round(fitted(interaction_brms_2, newdata_2), 2) 116 | 117 | 118 | # カテゴリ×数量：モデルの図示 --------------------------------------------------------- 119 | 120 | # 回帰直線の図示 121 | eff_2 <- marginal_effects(interaction_brms_2, 122 | effects = "temperature:publicity") 123 | plot(eff_2, points = T) 124 | 125 | 126 | # 数量×数量：モデル化 --------------------------------------------------------- 127 | 128 | # 分析対象のデータ 129 | interaction_3 <- read.csv("3-10-3-interaction-3.csv") 130 | head(interaction_3, n = 3) 131 | 132 | # データの要約 133 | summary(interaction_3) 134 | 135 | # データの図示 136 | ggplot(data = interaction_3, 137 | aes(x = product, y = sales, color = factor(clerk)))+ 138 | geom_point() 139 | 140 | 141 | # 参考：デザイン行列の作成 142 | model.matrix(sales ~ product * clerk, interaction_3) 143 | 144 | # モデル化 145 | interaction_brms_3 <- brm( 146 | formula = sales ~ product * clerk, 147 | family = gaussian(link = "identity"), 148 | data = interaction_3, 149 | seed = 1, 150 | prior = c(set_prior("", class = "Intercept"), 151 | set_prior("", class = "sigma")) 152 | ) 153 | 154 | # MCMCの結果の確認 155 | interaction_brms_3 156 | 157 | # 参考：事後分布の図示 158 | plot(interaction_brms_3) 159 | 160 | 161 | # 数量×数量：係数の解釈 --------------------------------------------------------- 162 | 163 | # 交互作用の効果の確認 164 | # 説明変数を作る 165 | newdata_3 <- data.frame( 166 | product = c(0,10,0,10), 167 | clerk = c(0,0,10,10) 168 | ) 169 | newdata_3 170 | # 予測 171 | round(fitted(interaction_brms_3, newdata_3), 2) 172 | 173 | 174 | # 数量×数量：モデルの図示 --------------------------------------------------------- 175 | 176 | # 回帰直線の図示 177 | # 1つのグラフに回帰直線をまとめて描画する 178 | int_conditions <- list( 179 | clerk = setNames(1:9, paste("clerk=", 1:9, sep="")) 180 | ) 181 | int_conditions 182 | 183 | eff_3 <- marginal_effects(interaction_brms_3, 184 | effects = "product:clerk", 185 | int_conditions = int_conditions) 186 | plot(eff_3, points = TRUE) 187 | 188 | 189 | # 回帰直線の図示 190 | # 働く人数ごとにグラフを分ける 191 | conditions <- data.frame(clerk = 1:9) 192 | conditions 193 | 194 | eff_4 <- marginal_effects(interaction_brms_3, 195 | effects = "product", 196 | conditions = conditions) 197 | plot(eff_4, points = FALSE) 198 | 199 | 200 | -------------------------------------------------------------------------------- /book-data/3-2-1-beer-sales-2.csv: -------------------------------------------------------------------------------- 1 | sales,temperature 2 | 41.68,13.7 3 | 110.99,24 4 | 65.32,21.5 5 | 72.64,13.4 6 | 76.54,28.9 7 | 62.76,28.9 8 | 46.66,12.6 9 | 100.79,26.7 10 | 85.59,19.4 11 | 97.57,21 12 | 45.93,21.1 13 | 87.47,14.8 14 | 72.45,25.2 15 | 56.37,13.6 16 | 72.84,18.1 17 | 75.45,27.1 18 | 63.77,29.5 19 | 49.06,14.5 20 | 68.51,18.9 21 | 35.32,11.5 22 | 64.18,23.2 23 | 69.46,17.8 24 | 84.63,26.7 25 | 59.02,13 26 | 61.44,16.9 27 | 55.89,19.8 28 | 72.05,13 29 | 74.33,17.1 30 | 109.04,29.3 31 | 30.35,12.6 32 | 60.44,10.2 33 | 27.81,13.3 34 | 77.5,26.2 35 | 67.92,27.4 36 | 37.63,20.3 37 | 103.58,22.5 38 | 77.45,26.9 39 | 54.98,15.7 40 | 72.45,23.3 41 | 58.3,13 42 | 118.01,29.6 43 | 84.97,15.9 44 | 33,12.3 45 | 32.87,13.3 46 | 69.56,28.9 47 | 65.95,25.9 48 | 123.14,29.5 49 | 62.61,17 50 | 57.36,20 51 | 76.48,26.2 52 | 61.37,10.1 53 | 49.66,10.3 54 | 74.54,23.7 55 | 80.26,28.6 56 | 45.82,15.5 57 | 116.22,26.2 58 | 98.35,25.7 59 | 124.63,29.8 60 | 69.43,22.3 61 | 75.24,24.2 62 | 68.09,25.4 63 | 85.49,27.7 64 | 83.33,22.5 65 | 78.38,15.2 66 | 96.46,27.2 67 | 73.59,18.7 68 | 82.96,17.8 69 | 85.21,19.2 70 | 57.6,14.4 71 | 36.5,11.3 72 | 77.37,15.5 73 | 62.58,16.2 74 | 72.66,10.8 75 | 47.79,13.7 76 | 38.59,13.7 77 | 90.81,25.1 78 | 49.46,15.8 79 | 98.08,27.4 80 | 39.39,18.1 81 | 47.61,21.5 82 | 72.85,17 83 | 83.46,23.4 84 | 59.32,10.5 85 | 34.76,18 86 | 73.19,14 87 | 105.76,27.1 88 | 108.98,29.4 89 | 73.05,16.5 90 | 113.4,24.7 91 | 40.19,16.8 92 | 85,29.5 93 | 70.9,17.9 94 | 51.9,17.6 95 | 74.28,21.2 96 | 79.44,19.3 97 | 44.94,13.9 98 | 76.11,18.5 99 | 58,11.9 100 | 38.65,12.3 101 | 52.04,18.8 102 | -------------------------------------------------------------------------------- /book-data/3-2-1-simple-lm.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // 売り上げデータ 4 | vector[N] temperature; // 気温データ 5 | } 6 | 7 | parameters { 8 | real Intercept; // 切片 9 | real beta; // 係数 10 | real sigma; // 標準偏差 11 | } 12 | 13 | model { 14 | // 平均Intercept + beta*temperature 15 | // 標準偏差sigmaの正規分布に従ってデータが得られたと仮定 16 | for (i in 1:N) { 17 | sales[i] ~ normal(Intercept + beta*temperature[i], sigma); 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /book-data/3-2-2-simple-lm-vec.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // 売り上げデータ 4 | vector[N] temperature; // 気温データ 5 | } 6 | 7 | parameters { 8 | real Intercept; // 切片 9 | real beta; // 係数 10 | real sigma; // 標準偏差 11 | } 12 | 13 | model { 14 | // 平均Intercept + beta*temperature 15 | // 標準偏差sigmaの正規分布に従ってデータが得られたと仮定 16 | sales ~ normal(Intercept + beta*temperature, sigma); 17 | } 18 | -------------------------------------------------------------------------------- /book-data/3-2-単回帰モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # 単回帰モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込みと図示 ------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | file_beer_sales_2 <- read.csv("3-2-1-beer-sales-2.csv") 21 | head(file_beer_sales_2, n = 3) 22 | 23 | # サンプルサイズ 24 | sample_size <- nrow(file_beer_sales_2) 25 | sample_size 26 | 27 | # 図示 28 | ggplot(file_beer_sales_2, aes(x = temperature, y = sales)) + 29 | geom_point() + 30 | labs(title = "ビールの売り上げと気温の関係") 31 | 32 | 33 | # MCMCの実行 ------------------------------------------------------------------- 34 | 35 | # listにまとめる 36 | data_list <- list( 37 | N = sample_size, 38 | sales = file_beer_sales_2$sales, 39 | temperature = file_beer_sales_2$temperature 40 | ) 41 | 42 | # 乱数の生成(参考) 43 | mcmc_result_not_vec <- stan( 44 | file = "3-2-1-simple-lm.stan", 45 | data = data_list, 46 | seed = 1 47 | ) 48 | 49 | # 結果の表示(参考) 50 | print(mcmc_result_not_vec, probs = c(0.025, 0.5, 0.975)) 51 | 52 | 53 | # 乱数の生成 54 | mcmc_result <- stan( 55 | file = "3-2-2-simple-lm-vec.stan", 56 | data = data_list, 57 | seed = 1 58 | ) 59 | 60 | # 結果の表示 61 | print(mcmc_result, probs = c(0.025, 0.5, 0.975)) 62 | 63 | # MCMCサンプルの抽出 64 | mcmc_sample <- rstan::extract(mcmc_result, permuted = FALSE) 65 | 66 | 67 | # 事後分布の図示 ---------------------------------------------------- 68 | 69 | # トレースプロットと事後分布 70 | mcmc_combo( 71 | mcmc_sample, 72 | pars = c("Intercept", "beta", "sigma") 73 | ) 74 | 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /book-data/3-3-1-simple-lm-pred.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | vector[N] sales; // 売り上げデータ 4 | vector[N] temperature; // 気温データ 5 | 6 | int N_pred; // 予測対象データの大きさ 7 | vector[N_pred] temperature_pred; // 予測対象となる気温 8 | } 9 | 10 | parameters { 11 | real Intercept; // 切片 12 | real beta; // 係数 13 | real sigma; // 標準偏差 14 | } 15 | 16 | model { 17 | // 平均Intercept + beta*temperature 18 | // 標準偏差sigmaの正規分布に従ってデータが得られたと仮定 19 | for (i in 1:N) { 20 | sales[i] ~ normal(Intercept + beta*temperature[i], sigma); 21 | } 22 | } 23 | 24 | generated quantities { 25 | vector[N_pred] mu_pred; // ビールの売り上げの期待値 26 | vector[N_pred] sales_pred; // ビールの売り上げの予測値 27 | 28 | for (i in 1:N_pred) { 29 | mu_pred[i] = Intercept + beta*temperature_pred[i]; 30 | sales_pred[i] = normal_rng(mu_pred[i], sigma); 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /book-data/3-3-モデルを用いた予測.R: -------------------------------------------------------------------------------- 1 | 2 | # モデルを用いた予測｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # 分析対象のデータ 17 | file_beer_sales_2 <- read.csv("3-2-1-beer-sales-2.csv") 18 | 19 | # サンプルサイズ 20 | sample_size <- nrow(file_beer_sales_2) 21 | 22 | 23 | # 予測のためのデータの整理 ------------------------------------------------------------ 24 | 25 | # 気温を11度から30度まで変化させて、その時の売り上げを予測する 26 | temperature_pred <-11:30 27 | temperature_pred 28 | 29 | 30 | # listにまとめる 31 | data_list_pred <- list( 32 | N = sample_size, 33 | sales = file_beer_sales_2$sales, 34 | temperature = file_beer_sales_2$temperature, 35 | N_pred = length(temperature_pred), 36 | temperature_pred = temperature_pred 37 | ) 38 | 39 | 40 | # MCMCの実行 ----------------------------------------------------------------- 41 | 42 | # MCMCの実行 43 | mcmc_result_pred <- stan( 44 | file = "3-3-1-simple-lm-pred.stan", 45 | data = data_list_pred, 46 | seed = 1 47 | ) 48 | 49 | # 結果の表示 50 | print(mcmc_result_pred, probs = c(0.025, 0.5, 0.975)) 51 | 52 | 53 | # 予測分布の図示 ------------------------------------------------------------- 54 | 55 | # MCMCサンプルの抽出 56 | mcmc_sample_pred <- rstan::extract(mcmc_result_pred, 57 | permuted = FALSE) 58 | 59 | 60 | # 気温が11度～30度まで1度ずつ変えたの時の 61 | # 予測売り上げの95%予測区間の図示 62 | mcmc_intervals( 63 | mcmc_sample_pred, 64 | regex_pars = c("sales_pred."), # 正規表現を用いてパラメタ名を指定 65 | prob = 0.8, # 太い線の範囲 66 | prob_outer = 0.95 # 細い線の範囲 67 | ) 68 | 69 | # 95%区間の比較 70 | mcmc_intervals( 71 | mcmc_sample_pred, 72 | pars = c("mu_pred[1]", "sales_pred[1]"), 73 | prob = 0.8, # 太い線の範囲 74 | prob_outer = 0.95 # 細い線の範囲 75 | ) 76 | 77 | 78 | # 気温が11度と30度の時の、売り上げの予測分布 79 | mcmc_areas( 80 | mcmc_sample_pred, 81 | pars = c("sales_pred[1]", "sales_pred[20]"), 82 | prob = 0.6, # 薄い青色で塗られた範囲 83 | prob_outer = 0.99 # 細い線が描画される範囲 84 | ) 85 | 86 | 87 | 88 | 89 | 90 | -------------------------------------------------------------------------------- /book-data/3-4-1-lm-design-matrix.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int K; // デザイン行列の列数(説明変数の数＋１) 4 | vector[N] Y; // 応答変数 5 | matrix[N, K] X; // デザイン行列 6 | } 7 | 8 | parameters { 9 | vector[K] b; // 切片を含む係数ベクトル 10 | real sigma; // データのばらつきを表す標準偏差 11 | } 12 | 13 | model { 14 | vector[N] mu = X * b; 15 | Y ~ normal(mu, sigma); 16 | } 17 | -------------------------------------------------------------------------------- /book-data/3-4-デザイン行列を用いた一般化線形モデルの推定.R: -------------------------------------------------------------------------------- 1 | 2 | # デザイン行列を用いた一般化線形モデルの推定｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # 分析対象のデータ 17 | file_beer_sales_2 <- read.csv("3-2-1-beer-sales-2.csv") 18 | 19 | # サンプルサイズ 20 | sample_size <- nrow(file_beer_sales_2) 21 | 22 | 23 | # formula構文を用いたデザイン行列の作成 -------------------------------------------------------- 24 | 25 | # formulaの作成 26 | formula_lm <- formula(sales ~ temperature) 27 | 28 | # デザイン行列の作成 29 | X <- model.matrix(formula_lm, file_beer_sales_2) 30 | 31 | # formulaとmodel.matrixを使ったデザイン行列 32 | head(X, n = 5) 33 | 34 | 35 | 36 | # MCMCの実行 ----------------------------------------------------------------- 37 | 38 | # サンプルサイズ 39 | N <- nrow(file_beer_sales_2) 40 | 41 | # デザイン行列の列数（説明変数の数＋１） 42 | K <- 2 43 | 44 | # 応答変数 45 | Y <- file_beer_sales_2$sales 46 | 47 | # listにまとめる 48 | data_list_design <- list(N = N, K = K, Y = Y, X = X) 49 | 50 | # MCMCの実行 51 | mcmc_result_design <- stan( 52 | file = "3-4-1-lm-design-matrix.stan", 53 | data = data_list_design, 54 | seed = 1 55 | ) 56 | 57 | # 結果の表示 58 | print(mcmc_result_design, probs = c(0.025, 0.5, 0.975)) 59 | 60 | 61 | 62 | 63 | -------------------------------------------------------------------------------- /book-data/3-5-1-brms-stan-code.stan: -------------------------------------------------------------------------------- 1 | // generated with brms 2.9.0 2 | functions { 3 | } 4 | data { 5 | int N; // number of observations 6 | vector[N] Y; // response variable 7 | int K; // number of population-level effects 8 | matrix[N, K] X; // population-level design matrix 9 | int prior_only; // should the likelihood be ignored? 10 | } 11 | transformed data { 12 | int Kc = K - 1; 13 | matrix[N, Kc] Xc; // centered version of X 14 | vector[Kc] means_X; // column means of X before centering 15 | for (i in 2:K) { 16 | means_X[i - 1] = mean(X[, i]); 17 | Xc[, i - 1] = X[, i] - means_X[i - 1]; 18 | } 19 | } 20 | parameters { 21 | vector[Kc] b; // population-level effects 22 | real temp_Intercept; // temporary intercept 23 | real sigma; // residual SD 24 | } 25 | transformed parameters { 26 | } 27 | model { 28 | vector[N] mu = temp_Intercept + Xc * b; 29 | // priors including all constants 30 | // likelihood including all constants 31 | if (!prior_only) { 32 | target += normal_lpdf(Y | mu, sigma); 33 | } 34 | } 35 | generated quantities { 36 | // actual population-level intercept 37 | real b_Intercept = temp_Intercept - dot_product(means_X, b); 38 | } 39 | -------------------------------------------------------------------------------- /book-data/3-5-brmsの使い方.R: -------------------------------------------------------------------------------- 1 | 2 | # brmsの使い方｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # 分析対象のデータ 17 | file_beer_sales_2 <- read.csv("3-2-1-beer-sales-2.csv") 18 | 19 | 20 | # brmsによる単回帰モデルの推定 ------------------------------------------------------------------- 21 | 22 | # 単回帰モデルを作る 23 | simple_lm_brms <- brm( 24 | formula = sales ~ temperature, # modelの構造を指定 25 | family = gaussian(link = "identity"), # 正規分布を使う 26 | data = file_beer_sales_2, # データ 27 | seed = 1 # 乱数の種 28 | ) 29 | 30 | # MCMCの結果の確認 31 | simple_lm_brms 32 | 33 | # 参考：MCMCサンプルの取得 34 | as.mcmc(simple_lm_brms, combine_chains = TRUE) 35 | 36 | # 事後分布の図示 37 | plot(simple_lm_brms) 38 | 39 | 40 | # brmsの基本的な使い方 ------------------------------------------------------------- 41 | 42 | # formulaとfamilyでモデルの構造を指定する 43 | # 複雑なformulaはbf関数で作成 44 | simple_lm_formula <- bf(sales ~ temperature) 45 | 46 | # familyは様々選べる。 47 | # デフォルトのリンク関数は省略可能 48 | # 正規分布 49 | gaussian() 50 | # 二項分布 51 | binomial() 52 | # ポアソン分布 53 | poisson() 54 | 55 | 56 | # simple_lm_brmsと結果は同じ 57 | simple_lm_brms_2 <- brm( 58 | formula = simple_lm_formula, # bf関数で作成済みのformulaを指定 59 | family = gaussian(), # 正規分布を使う(リンク関数省略) 60 | data = file_beer_sales_2, # データ 61 | seed = 1, # 乱数の種 62 | chains = 4, # チェーン数 63 | iter = 2000, # 乱数生成の繰り返し数 64 | warmup = 1000, # バーンイン期間 65 | thin = 1 # 間引き数(1なら間引き無し) 66 | ) 67 | 68 | # 参考 69 | simple_lm_brms_2 70 | 71 | 72 | # 事前分布の変更 ----------------------------------------------------------------- 73 | 74 | # 事前分布の取得 75 | prior_summary(simple_lm_brms) 76 | 77 | # 事前分布を無情報事前分布にする 78 | simple_lm_brms_3 <- brm( 79 | formula = sales ~ temperature, 80 | family = gaussian(), 81 | data = file_beer_sales_2, 82 | seed = 1, 83 | prior = c(set_prior("", class = "Intercept"), 84 | set_prior("", class = "sigma")) 85 | ) 86 | 87 | # 参考：推定結果 88 | simple_lm_brms_3 89 | 90 | # 参考：弱情報事前分布が設定されなくなった 91 | prior_summary(simple_lm_brms_3) 92 | 93 | # 参考:その他の係数の事前分布の変更 94 | # 気温の係数 95 | set_prior("normal(0,100000)", class = "b", coef = "temperature") 96 | 97 | # 事前分布の標準設定の確認 98 | get_prior( 99 | formula = sales ~ temperature, 100 | family = gaussian(), 101 | data = file_beer_sales_2 102 | ) 103 | 104 | # 参考：stanコードの抽出 105 | stancode(simple_lm_brms_3) 106 | 107 | # 参考：Stanに渡すデータの抽出 108 | standata(simple_lm_brms_3) 109 | 110 | # 補足：make_stancode関数による、Stanコードの作成 ------------------------------------ 111 | 112 | # Stanコードを作る 113 | make_stancode( 114 | formula = sales ~ temperature, 115 | family = gaussian(), 116 | data = file_beer_sales_2, 117 | prior = c(prior("", class = "Intercept"), 118 | prior("", class = "sigma")) 119 | ) 120 | 121 | 122 | # 補足：make_standata関数による、Stanに渡すデータの作成 ------------------------------------ 123 | 124 | # rstanに渡すデータを作る 125 | standata_brms <- make_standata( 126 | formula = sales ~ temperature, 127 | family = gaussian(), 128 | data = file_beer_sales_2 129 | ) 130 | 131 | standata_brms 132 | 133 | # 補足：rstanでbrmsの結果を再現する --------------------------------------------------- 134 | 135 | # rstanでbrmsのモデルを実行 136 | simple_lm_brms_stan <- stan( 137 | file = "3-5-1-brms-stan-code.stan", 138 | data = standata_brms, 139 | seed = 1 140 | ) 141 | 142 | # rstanを使ったときの実行結果 143 | print(simple_lm_brms_stan, 144 | pars = c("b_Intercept", "b[1]", "sigma"), 145 | probs = c(0.025, 0.5, 0.975)) 146 | 147 | # brmsを使ったときの実行結果 148 | simple_lm_brms_3 149 | 150 | 151 | # 事後分布の可視化 ---------------------------------------------------------------- 152 | 153 | # 係数の95%ベイズ信用区間 154 | stanplot(simple_lm_brms, 155 | type = "intervals", 156 | pars = "^b_", 157 | prob = 0.8, # 太い線の範囲 158 | prob_outer = 0.95) # 細い線の範囲 159 | 160 | 161 | # brmsによる予測 --------------------------------------------------------------- 162 | 163 | # 予測のための説明変数 164 | new_data <- data.frame(temperature = 20) 165 | 166 | # 回帰直線の信用区間付きの予測値 167 | fitted(simple_lm_brms, new_data) 168 | 169 | # 予測区間付きの予測値 170 | set.seed(1) 171 | predict(simple_lm_brms, new_data) 172 | 173 | 174 | # 補足：predict関数を使わない予測の実装 ---------------------------------------------------------------- 175 | 176 | # MCMCサンプルを取り出す 177 | mcmc_sample <- as.mcmc(simple_lm_brms, combine_chains = TRUE) 178 | head(mcmc_sample, n = 2) 179 | 180 | # 推定されたパラメタ別に保存しておく 181 | mcmc_b_Intercept <- mcmc_sample[,"b_Intercept"] 182 | mcmc_b_temperature <- mcmc_sample[,"b_temperature"] 183 | mcmc_sigma <- mcmc_sample[,"sigma"] 184 | 185 | # 予測された期待値のMCMCサンプルを得る 186 | saigen_fitted <- mcmc_b_Intercept + 20 * mcmc_b_temperature 187 | 188 | # fittedの再現 189 | mean(saigen_fitted) 190 | quantile(saigen_fitted, probs = c(0.025, 0.975)) 191 | fitted(simple_lm_brms, new_data) 192 | 193 | # 予測分布のMCMCサンプルを得る 194 | set.seed(1) 195 | saigen_predict <- do.call( 196 | rnorm, 197 | c(4000, list(mean = saigen_fitted, sd = mcmc_sigma)) 198 | ) 199 | 200 | # predictの再現 201 | mean(saigen_predict) 202 | quantile(saigen_predict, probs = c(0.025, 0.975)) 203 | set.seed(1) 204 | predict(simple_lm_brms, data.frame(temperature = 20)) 205 | 206 | 207 | # 回帰直線の図示 -------------------------------------------------------- 208 | 209 | # 回帰直線の95%ベイズ信用区間付きのグラフ 210 | eff <- marginal_effects(simple_lm_brms) 211 | plot(eff, points = TRUE) 212 | 213 | # 95%予測区間付きのグラフ 214 | set.seed(1) 215 | eff_pre <- marginal_effects(simple_lm_brms, method = "predict") 216 | plot(eff_pre, points = TRUE) 217 | 218 | 219 | # 参考：複数の説明変数があるときは、特定の要因だけを切り出せる 220 | marginal_effects(simple_lm_brms, 221 | effects = "temperature") 222 | 223 | # 参考：複数の説明変数を同時に図示(このコードは動きません) 224 | # marginal_effects(brms_model, 225 | # effects = "x1:x2") 226 | 227 | 228 | 229 | 230 | 231 | -------------------------------------------------------------------------------- /book-data/3-6-1-beer-sales-3.csv: -------------------------------------------------------------------------------- 1 | sales,weather 2 | 48.5,cloudy 3 | 64.8,cloudy 4 | 85.8,cloudy 5 | 45,cloudy 6 | 60.8,cloudy 7 | 64,cloudy 8 | 72.6,cloudy 9 | 58.4,cloudy 10 | 91.8,cloudy 11 | 59.9,cloudy 12 | 68.3,cloudy 13 | 76.7,cloudy 14 | 56.1,cloudy 15 | 46.4,cloudy 16 | 88.7,cloudy 17 | 27.3,cloudy 18 | 75.2,cloudy 19 | 62.5,cloudy 20 | 77.2,cloudy 21 | 68.5,cloudy 22 | 93.4,cloudy 23 | 44,cloudy 24 | 85.8,cloudy 25 | 91.3,cloudy 26 | 62.1,cloudy 27 | 25.2,cloudy 28 | 69.2,cloudy 29 | 53.1,cloudy 30 | 73.9,cloudy 31 | 66.3,cloudy 32 | 73.1,cloudy 33 | 66.8,cloudy 34 | 78.1,cloudy 35 | 57.7,cloudy 36 | 50.3,cloudy 37 | 53.1,cloudy 38 | 36.1,cloudy 39 | 48.5,cloudy 40 | 53.6,cloudy 41 | 58.3,cloudy 42 | 56.2,cloudy 43 | 32.6,cloudy 44 | 49.4,cloudy 45 | 90.6,cloudy 46 | 71.3,cloudy 47 | 91.9,cloudy 48 | 57.4,cloudy 49 | 60.6,cloudy 50 | 59.2,cloudy 51 | 44,cloudy 52 | 72.4,sunny 53 | 116,sunny 54 | 76.6,sunny 55 | 104.1,sunny 56 | 69.3,sunny 57 | 55.5,sunny 58 | 80.2,sunny 59 | 99,sunny 60 | 102.1,sunny 61 | 110.1,sunny 62 | 58.2,sunny 63 | 115.5,sunny 64 | 74.5,sunny 65 | 87.4,sunny 66 | 92.6,sunny 67 | 72.7,sunny 68 | 55,sunny 69 | 77.8,sunny 70 | 86.3,sunny 71 | 71.6,sunny 72 | 71.2,sunny 73 | 90,sunny 74 | 82.9,sunny 75 | 91.5,sunny 76 | 84.2,sunny 77 | 71.4,sunny 78 | 104.6,sunny 79 | 96.6,sunny 80 | 100.8,sunny 81 | 63.8,sunny 82 | 99.9,sunny 83 | 59.6,sunny 84 | 77,sunny 85 | 64.4,sunny 86 | 51.9,sunny 87 | 112.3,sunny 88 | 75.2,sunny 89 | 80.7,sunny 90 | 79.2,sunny 91 | 90.8,sunny 92 | 109,sunny 93 | 110.2,sunny 94 | 67.2,sunny 95 | 64.6,sunny 96 | 62.3,sunny 97 | 66.2,sunny 98 | 114.4,sunny 99 | 85.1,sunny 100 | 72.4,sunny 101 | 76,sunny 102 | 76.1,rainy 103 | 63.9,rainy 104 | 55.3,rainy 105 | 48.8,rainy 106 | 47.1,rainy 107 | 90.7,rainy 108 | 74.1,rainy 109 | 90.1,rainy 110 | 53.7,rainy 111 | 54.7,rainy 112 | 44.6,rainy 113 | 56.2,rainy 114 | 67.1,rainy 115 | 80.4,rainy 116 | 68.5,rainy 117 | 66.8,rainy 118 | 78.5,rainy 119 | 77.2,rainy 120 | 61.6,rainy 121 | 48.3,rainy 122 | 78.6,rainy 123 | 62.1,rainy 124 | 85.7,rainy 125 | 53.5,rainy 126 | 44.3,rainy 127 | 68.1,rainy 128 | 50,rainy 129 | 69.6,rainy 130 | 34.1,rainy 131 | 33.9,rainy 132 | 70.3,rainy 133 | 65,rainy 134 | 73.1,rainy 135 | 29.8,rainy 136 | 78.2,rainy 137 | 78,rainy 138 | 75.5,rainy 139 | 71.8,rainy 140 | 91.7,rainy 141 | 38.2,rainy 142 | 51.3,rainy 143 | 66.1,rainy 144 | 47.9,rainy 145 | 61.3,rainy 146 | 71.2,rainy 147 | 50.2,rainy 148 | 69.9,rainy 149 | 68.2,rainy 150 | 47.9,rainy 151 | 45,rainy 152 | -------------------------------------------------------------------------------- /book-data/3-6-ダミー変数と分散分析モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ダミー変数と分散分析モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込みと図示 ------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | sales_weather <- read.csv("3-6-1-beer-sales-3.csv") 21 | head(sales_weather, 3) 22 | 23 | # データの要約 24 | summary(sales_weather) 25 | 26 | # 図示 27 | ggplot(data = sales_weather, mapping = aes(x = weather, y = sales)) + 28 | geom_violin() + 29 | geom_point(aes(color = weather)) + 30 | labs(title = "ビールの売り上げと天気の関係") 31 | 32 | 33 | 34 | # brmsによる分散分析モデルの推定 ------------------------------------------------------------------- 35 | 36 | # 分散分析モデルを作る 37 | anova_brms <- brm( 38 | formula = sales ~ weather, # modelの構造を指定 39 | family = gaussian(), # 正規分布を使う 40 | data = sales_weather, # データ 41 | seed = 1, # 乱数の種 42 | prior = c(set_prior("", class = "Intercept"), 43 | set_prior("", class = "sigma")) 44 | ) 45 | 46 | # MCMCの結果の確認 47 | anova_brms 48 | 49 | # 推定された天気別の平均売り上げのグラフ 50 | eff <- marginal_effects(anova_brms) 51 | plot(eff, points = FALSE) 52 | 53 | 54 | 55 | # 補足：分散分析モデルのデザイン行列 ---------------------------------------------------------- 56 | 57 | # デザイン行列の作成 58 | formula_anova <- formula(sales ~ weather) 59 | design_mat <- model.matrix(formula_anova, sales_weather) 60 | 61 | # stanに渡すlistの作成 62 | data_list <- list( 63 | N = nrow(sales_weather), # サンプルサイズ 64 | K = 3, # デザイン行列の列数 65 | Y = sales_weather$sales, # 応答変数 66 | X = design_mat # デザイン行列 67 | ) 68 | # Stanに渡すデータの表示 69 | data_list 70 | 71 | 72 | 73 | # 補足：brmsを使わない分散分析モデルの推定 ----------------------------------------------------- 74 | 75 | # rstanで分散分析モデルを実行 76 | anova_stan <- stan( 77 | file = "3-4-1-lm-design-matrix.stan", 78 | data = data_list, 79 | seed = 1 80 | ) 81 | 82 | # 結果の確認 83 | print(anova_stan, probs = c(0.025, 0.5, 0.975)) 84 | 85 | anova_brms 86 | 87 | 88 | 89 | 90 | 91 | -------------------------------------------------------------------------------- /book-data/3-7-1-beer-sales-4.csv: -------------------------------------------------------------------------------- 1 | sales,weather,temperature 2 | 40.6433443660977,cloudy,13.7 3 | 99.552683486334,cloudy,24 4 | 85.3268466330979,cloudy,21.5 5 | 69.2878839296147,cloudy,13.4 6 | 71.0994248900444,cloudy,28.9 7 | 107.189768846666,cloudy,28.9 8 | 26.0635264493146,cloudy,12.6 9 | 78.7494178617921,cloudy,26.7 10 | 47.9159582328538,cloudy,19.4 11 | 39.3812033179304,cloudy,21 12 | 100.081837781303,cloudy,21.1 13 | 47.1990988377183,cloudy,14.8 14 | 78.729781709674,cloudy,25.2 15 | 48.195755945326,cloudy,13.6 16 | 71.0504246196911,cloudy,18.1 17 | 111.755862773093,cloudy,27.1 18 | 118.967324336502,cloudy,29.5 19 | 38.4959041765911,cloudy,14.5 20 | 46.873141196552,cloudy,18.9 21 | 26.0599380791849,cloudy,11.5 22 | 59.203426509462,cloudy,23.2 23 | 93.8903561571841,cloudy,17.8 24 | 86.8646880819915,cloudy,26.7 25 | 39.8607720361555,cloudy,13 26 | 53.2325984227148,cloudy,16.9 27 | 85.6168910961927,cloudy,19.8 28 | 56.4089675263824,cloudy,13 29 | 58.0359202974212,cloudy,17.1 30 | 82.0055485677538,cloudy,29.3 31 | 38.5670250547129,cloudy,12.6 32 | 76.2206045457272,cloudy,10.2 33 | 67.3488011642006,cloudy,13.3 34 | 115.63030673873,cloudy,26.2 35 | 82.1793964139197,cloudy,27.4 36 | 65.4874836527821,cloudy,20.3 37 | 60.8392910286986,cloudy,22.5 38 | 83.4922130991956,cloudy,26.9 39 | 66.3278919917541,cloudy,15.7 40 | 98.6340973149717,cloudy,23.3 41 | 60.9625290402546,cloudy,13 42 | 100.839701357218,cloudy,29.6 43 | 78.2143049453137,cloudy,15.9 44 | 67.9570527159068,cloudy,12.3 45 | 54.8489706139113,cloudy,13.3 46 | 80.5002501448707,cloudy,28.9 47 | 103.367997406161,cloudy,25.9 48 | 95.8328762865527,cloudy,29.5 49 | 88.1594738235486,cloudy,17 50 | 63.5403853791551,cloudy,20 51 | 69.8365562860941,cloudy,26.2 52 | 83.3136928687079,sunny,10.1 53 | 65.7062101927466,sunny,10.3 54 | 118.832084171575,sunny,23.7 55 | 95.6401524826115,sunny,28.6 56 | 62.6135487948864,sunny,15.5 57 | 125.847062599245,sunny,26.2 58 | 119.214447657602,sunny,25.7 59 | 137.566015634221,sunny,29.8 60 | 75.5063162667985,sunny,22.3 61 | 128.688686552655,sunny,24.2 62 | 131.507420482329,sunny,25.4 63 | 134.731024889032,sunny,27.7 64 | 118.046153842658,sunny,22.5 65 | 119.651102706689,sunny,15.2 66 | 96.1928522978007,sunny,27.2 67 | 88.0034422780403,sunny,18.7 68 | 100.645859738255,sunny,17.8 69 | 85.8952754687864,sunny,19.2 70 | 87.2832566128176,sunny,14.4 71 | 89.4436475295961,sunny,11.3 72 | 78.9449040800337,sunny,15.5 73 | 100.356589749529,sunny,16.2 74 | 85.2486385251456,sunny,10.8 75 | 72.1490596235099,sunny,13.7 76 | 69.2893042408565,sunny,13.7 77 | 127.388359576394,sunny,25.1 78 | 86.9586522894893,sunny,15.8 79 | 129.332876691562,sunny,27.4 80 | 82.5837208963125,sunny,18.1 81 | 122.909405275017,sunny,21.5 82 | 72.3533417622967,sunny,17 83 | 119.98011003291,sunny,23.4 84 | 83.2130385497056,sunny,10.5 85 | 99.0198991706079,sunny,18 86 | 95.0128403070286,sunny,14 87 | 123.727009257957,sunny,27.1 88 | 113.928934536049,sunny,29.4 89 | 87.2343064396473,sunny,16.5 90 | 117.148193473286,sunny,24.7 91 | 72.3070085908894,sunny,16.8 92 | 110.490455854969,sunny,29.5 93 | 125.90642191877,sunny,17.9 94 | 62.5116155169853,sunny,17.6 95 | 84.4224105200758,sunny,21.2 96 | 113.106496344961,sunny,19.3 97 | 101.079927947971,sunny,13.9 98 | 108.847783812824,sunny,18.5 99 | 80.6028795802508,sunny,11.9 100 | 85.6081707677041,sunny,12.3 101 | 83.4299699861357,sunny,18.8 102 | 43.2172422744482,rainy,14 103 | 60.5631804305858,rainy,18.6 104 | 77.9800573864145,rainy,29.6 105 | 96.8174181895126,rainy,26.6 106 | 32.8861123981009,rainy,15.7 107 | 57.2939449577956,rainy,21.9 108 | 69.071060320405,rainy,28 109 | 71.6327693884472,rainy,19.1 110 | 33.2784260751942,rainy,12.9 111 | 57.6621672601224,rainy,12.6 112 | 61.8991340210186,rainy,10.5 113 | 80.1284285385856,rainy,24.7 114 | 69.4769975453805,rainy,17.5 115 | 61.9383535997387,rainy,21.5 116 | 91.8046298624135,rainy,26.5 117 | 64.6682116650741,rainy,26.3 118 | 85.5984326945201,rainy,27.5 119 | 28.3202093648088,rainy,12.2 120 | 86.7552365963072,rainy,29.1 121 | 87.8134449252921,rainy,21.4 122 | 55.2585169312281,rainy,10.7 123 | 48.608607280394,rainy,14.9 124 | 80.1722005116821,rainy,29.6 125 | 74.3983643533834,rainy,27.7 126 | 43.8037147806491,rainy,14.8 127 | 85.2197543060212,rainy,25.1 128 | 55.9567170417242,rainy,21.3 129 | 101.313461353584,rainy,16.1 130 | 81.0306501710683,rainy,23.9 131 | 45.2516850544831,rainy,16.7 132 | 59.0075727243355,rainy,14.1 133 | 87.1715589302252,rainy,28.4 134 | 38.9917864169965,rainy,10.5 135 | 100.24195431696,rainy,29.3 136 | 62.2191111634852,rainy,16.3 137 | 91.6436929522176,rainy,23.3 138 | 61.8832672494044,rainy,20.7 139 | 110.943093632198,rainy,26.4 140 | 30.7370539137238,rainy,13.7 141 | 65.0802925569381,rainy,18 142 | 58.7719559056831,rainy,13.6 143 | 75.4716118690051,rainy,15.7 144 | 54.6327831290618,rainy,22.6 145 | 40.9055833600144,rainy,16 146 | 90.3847285557611,rainy,18.9 147 | 85.4721931259882,rainy,24.6 148 | 87.2327870256297,rainy,23.4 149 | 46.6020729671158,rainy,16.2 150 | 95.8577747074577,rainy,19.6 151 | 58.5565997947108,rainy,15.8 152 | -------------------------------------------------------------------------------- /book-data/3-7-正規線形モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # 正規線形モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込みと図示 ------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | sales_climate <- read.csv("3-7-1-beer-sales-4.csv") 21 | head(sales_climate, 3) 22 | 23 | # データの要約 24 | summary(sales_climate) 25 | 26 | # 図示 27 | ggplot(data = sales_climate, 28 | mapping = aes(x = temperature, y = sales)) + 29 | geom_point(aes(color = weather)) + 30 | labs(title = "ビールの売り上げと気温・天気の関係") 31 | 32 | 33 | # brmsによる正規線形モデルの推定 ------------------------------------------------------------------- 34 | 35 | # 正規線形モデルを作る 36 | lm_brms <- brm( 37 | formula = sales ~ weather + temperature, # modelの構造を指定 38 | family = gaussian(), # 正規分布を使う 39 | data = sales_climate, # データ 40 | seed = 1, # 乱数の種 41 | prior = c(set_prior("", class = "Intercept"), 42 | set_prior("", class = "sigma")) 43 | ) 44 | 45 | # MCMCの結果の確認 46 | lm_brms 47 | 48 | # 回帰直線 49 | eff <- marginal_effects(lm_brms, effects = "temperature:weather") 50 | plot(eff, points = TRUE) 51 | 52 | 53 | # 補足：正規線形モデルのデザイン行列 ------------------------------------------------------------- 54 | 55 | # デザイン行列の作成 56 | formula_lm <- formula(sales ~ weather + temperature) 57 | design_mat <- model.matrix(formula_lm, sales_climate) 58 | 59 | design_mat 60 | 61 | 62 | 63 | -------------------------------------------------------------------------------- /book-data/3-8-1-fish-num-1.csv: -------------------------------------------------------------------------------- 1 | fish_num,weather,temperature 2 | 0,cloudy,5.5 3 | 2,cloudy,21.1 4 | 5,cloudy,17.2 5 | 1,cloudy,5 6 | 3,cloudy,28.3 7 | 5,cloudy,28.3 8 | 2,cloudy,3.9 9 | 3,cloudy,25 10 | 0,cloudy,14 11 | 0,cloudy,16.5 12 | 0,cloudy,16.6 13 | 1,cloudy,7.2 14 | 2,cloudy,22.8 15 | 1,cloudy,5.4 16 | 2,cloudy,12.2 17 | 6,cloudy,25.6 18 | 8,cloudy,29.3 19 | 0,cloudy,6.8 20 | 4,cloudy,13.3 21 | 1,cloudy,2.2 22 | 0,cloudy,19.9 23 | 0,cloudy,11.6 24 | 8,cloudy,25.1 25 | 2,cloudy,4.5 26 | 0,cloudy,10.4 27 | 2,cloudy,14.7 28 | 1,cloudy,4.5 29 | 0,cloudy,10.7 30 | 6,cloudy,28.9 31 | 0,cloudy,4 32 | 0,cloudy,0.3 33 | 2,cloudy,4.9 34 | 0,cloudy,24.3 35 | 8,cloudy,26.1 36 | 1,cloudy,15.4 37 | 3,cloudy,18.8 38 | 4,cloudy,25.3 39 | 2,cloudy,8.5 40 | 1,cloudy,20 41 | 0,cloudy,4.5 42 | 3,cloudy,29.5 43 | 0,cloudy,8.9 44 | 1,cloudy,3.5 45 | 0,cloudy,4.9 46 | 4,cloudy,28.3 47 | 4,cloudy,23.8 48 | 6,cloudy,29.2 49 | 0,cloudy,10.5 50 | 1,cloudy,15.1 51 | 2,cloudy,24.3 52 | 0,sunny,0.2 53 | 0,sunny,0.4 54 | 3,sunny,20.5 55 | 2,sunny,27.9 56 | 1,sunny,8.3 57 | 1,sunny,24.4 58 | 3,sunny,23.6 59 | 2,sunny,29.7 60 | 0,sunny,18.4 61 | 1,sunny,21.3 62 | 3,sunny,23.1 63 | 5,sunny,26.6 64 | 0,sunny,18.8 65 | 1,sunny,7.8 66 | 1,sunny,25.8 67 | 1,sunny,13.1 68 | 0,sunny,11.6 69 | 3,sunny,13.8 70 | 0,sunny,6.6 71 | 0,sunny,2 72 | 2,sunny,8.3 73 | 0,sunny,9.3 74 | 0,sunny,1.3 75 | 1,sunny,5.5 76 | 0,sunny,5.5 77 | 3,sunny,22.7 78 | 0,sunny,8.6 79 | 1,sunny,26 80 | 1,sunny,12.1 81 | 1,sunny,17.2 82 | 2,sunny,10.5 83 | 2,sunny,20.2 84 | 1,sunny,0.8 85 | 1,sunny,12 86 | 0,sunny,6 87 | 4,sunny,25.7 88 | 1,sunny,29.1 89 | 1,sunny,9.7 90 | 0,sunny,22 91 | 0,sunny,10.2 92 | 1,sunny,29.3 93 | 0,sunny,11.9 94 | 3,sunny,11.4 95 | 0,sunny,16.8 96 | 1,sunny,13.9 97 | 0,sunny,5.9 98 | 0,sunny,12.8 99 | 0,sunny,2.8 100 | 0,sunny,3.5 101 | 0,sunny,13.2 102 | -------------------------------------------------------------------------------- /book-data/3-8-1-glm-pois-1.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int fish_num[N]; // 釣獲尾数 4 | vector[N] temp; // 気温データ 5 | vector[N] sunny; // 晴れダミー変数 6 | } 7 | 8 | parameters { 9 | real Intercept; // 切片 10 | real b_temp; // 係数(気温) 11 | real b_sunny; // 係数(晴れの影響) 12 | } 13 | 14 | model { 15 | vector[N] lambda = exp(Intercept + b_temp*temp + b_sunny*sunny); 16 | fish_num ~ poisson(lambda); 17 | } 18 | -------------------------------------------------------------------------------- /book-data/3-8-2-glm-pois-2.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int fish_num[N]; // 釣獲尾数 4 | vector[N] temp; // 気温データ 5 | vector[N] sunny; // 晴れダミー変数 6 | } 7 | 8 | parameters { 9 | real Intercept; // 切片 10 | real b_temp; // 係数(気温) 11 | real b_sunny; // 係数(晴れの影響) 12 | } 13 | 14 | model { 15 | vector[N] lambda = Intercept + b_temp*temp + b_sunny*sunny; 16 | fish_num ~ poisson_log(lambda); 17 | } 18 | -------------------------------------------------------------------------------- /book-data/3-8-3-glm-pois-design-matrix.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int K; // デザイン行列の列数(説明変数の数＋１) 4 | int Y[N]; // 応答変数(整数型) 5 | matrix[N, K] X; // デザイン行列 6 | } 7 | 8 | parameters { 9 | vector[K] b; // 切片を含む係数ベクトル 10 | } 11 | 12 | model { 13 | vector[N] lambda = X * b; 14 | Y ~ poisson_log(lambda); 15 | } 16 | -------------------------------------------------------------------------------- /book-data/3-8-ポアソン回帰モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ポアソン回帰モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込みと図示 ------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | fish_num_climate <- read.csv("3-8-1-fish-num-1.csv") 21 | head(fish_num_climate, 3) 22 | 23 | # データの要約 24 | summary(fish_num_climate) 25 | 26 | # 図示 27 | ggplot(data = fish_num_climate, 28 | mapping = aes(x = temperature, y = fish_num)) + 29 | geom_point(aes(color = weather)) + 30 | labs(title = "釣獲尾数と気温・天気の関係") 31 | 32 | 33 | 34 | # brmsによるポアソン回帰モデルの推定 ------------------------------------------------------------------- 35 | 36 | # ポアソン回帰モデルを作る 37 | glm_pois_brms <- brm( 38 | formula = fish_num ~ weather + temperature, # modelの構造を指定 39 | family = poisson(), # ポアソン分布を使う 40 | data = fish_num_climate, # データ 41 | seed = 1, # 乱数の種 42 | prior = c(set_prior("", class = "Intercept"))# 無情報事前分布にする 43 | ) 44 | 45 | # MCMCの結果の確認 46 | glm_pois_brms 47 | 48 | # 参考 49 | exp(-0.59) 50 | exp(0.08) 51 | 52 | 53 | # ポアソン回帰の回帰曲線 ------------------------------------------------------------- 54 | 55 | # 95%ベイズ信用区間付きのグラフ 56 | eff <- marginal_effects(glm_pois_brms, 57 | effects = "temperature:weather") 58 | 59 | plot(eff, points = TRUE) 60 | 61 | 62 | # 99%ベイズ予測区間付きのグラフ 63 | set.seed(1) 64 | eff_pre <- marginal_effects(glm_pois_brms, 65 | method = "predict", 66 | effects = "temperature:weather", 67 | probs = c(0.005, 0.995)) 68 | plot(eff_pre, points = TRUE) 69 | 70 | 71 | # 補足：brmsを用いない実装の方法 ------------------------------------------------------------- 72 | 73 | # 参考：デザイン行列の作成 74 | formula_pois <- formula(fish_num ~ weather + temperature) 75 | design_mat <- model.matrix(formula_pois, fish_num_climate) 76 | 77 | design_mat 78 | 79 | # 参考：データの作成 80 | data_list_1 <- list( 81 | N = nrow(fish_num_climate), 82 | fish_num = fish_num_climate$fish_num, 83 | temp = fish_num_climate$temperature, 84 | sunny = as.numeric(design_mat[, "weathersunny"]) 85 | ) 86 | data_list_1 87 | 88 | # 参考：自分で変換処理を入れる 89 | glm_pois_stan_exp <- stan( 90 | file = "3-8-1-glm-pois-1.stan", 91 | data = data_list_1, 92 | seed = 1 93 | ) 94 | 95 | # 参考：結果の表示 96 | print(glm_pois_stan_exp, 97 | probs = c(0.025, 0.5, 0.975)) 98 | 99 | 100 | # 参考：poisson_log関数を使用 101 | glm_pois_stan <- stan( 102 | file = "3-8-2-glm-pois-2.stan", 103 | data = data_list_1, 104 | seed = 1 105 | ) 106 | 107 | # 参考：結果の表示 108 | print(glm_pois_stan, 109 | probs = c(0.025, 0.5, 0.975)) 110 | 111 | 112 | # 補足：デザイン行列を使ったモデルの推定 -------------------------------------------------------- 113 | 114 | # 参考：Stanに渡すデータ 115 | data_list_2 <- list( 116 | N = nrow(fish_num_climate), 117 | K = 3, 118 | Y = fish_num_climate$fish_num, 119 | X = design_mat 120 | ) 121 | data_list_2 122 | 123 | # 参考：MCMCの実行 124 | glm_pois_stan_design_mat <- stan( 125 | file = "3-8-3-glm-pois-design-matrix.stan", 126 | data = data_list_2, 127 | seed = 1 128 | ) 129 | 130 | # 参考：結果の表示 131 | print(glm_pois_stan_design_mat, 132 | probs = c(0.025, 0.5, 0.975)) 133 | 134 | 135 | 136 | -------------------------------------------------------------------------------- /book-data/3-9-1-germination.csv: -------------------------------------------------------------------------------- 1 | germination,size,solar,nutrition 2 | 0,10,shade,1 3 | 0,10,shade,1 4 | 0,10,shade,1 5 | 0,10,shade,1 6 | 0,10,shade,1 7 | 0,10,shade,2 8 | 0,10,shade,2 9 | 0,10,shade,2 10 | 0,10,shade,2 11 | 0,10,shade,2 12 | 0,10,shade,3 13 | 0,10,shade,3 14 | 0,10,shade,3 15 | 0,10,shade,3 16 | 0,10,shade,3 17 | 0,10,shade,4 18 | 0,10,shade,4 19 | 1,10,shade,4 20 | 0,10,shade,4 21 | 0,10,shade,4 22 | 1,10,shade,5 23 | 0,10,shade,5 24 | 0,10,shade,5 25 | 0,10,shade,5 26 | 0,10,shade,5 27 | 0,10,shade,6 28 | 0,10,shade,6 29 | 0,10,shade,6 30 | 1,10,shade,6 31 | 0,10,shade,6 32 | 0,10,shade,7 33 | 0,10,shade,7 34 | 0,10,shade,7 35 | 0,10,shade,7 36 | 1,10,shade,7 37 | 1,10,shade,8 38 | 2,10,shade,8 39 | 0,10,shade,8 40 | 1,10,shade,8 41 | 1,10,shade,8 42 | 3,10,shade,9 43 | 2,10,shade,9 44 | 2,10,shade,9 45 | 2,10,shade,9 46 | 2,10,shade,9 47 | 4,10,shade,10 48 | 0,10,shade,10 49 | 3,10,shade,10 50 | 4,10,shade,10 51 | 3,10,shade,10 52 | 0,10,sunshine,1 53 | 1,10,sunshine,1 54 | 0,10,sunshine,1 55 | 0,10,sunshine,1 56 | 0,10,sunshine,1 57 | 0,10,sunshine,2 58 | 0,10,sunshine,2 59 | 1,10,sunshine,2 60 | 1,10,sunshine,2 61 | 1,10,sunshine,2 62 | 3,10,sunshine,3 63 | 1,10,sunshine,3 64 | 2,10,sunshine,3 65 | 1,10,sunshine,3 66 | 2,10,sunshine,3 67 | 2,10,sunshine,4 68 | 3,10,sunshine,4 69 | 4,10,sunshine,4 70 | 1,10,sunshine,4 71 | 5,10,sunshine,4 72 | 4,10,sunshine,5 73 | 6,10,sunshine,5 74 | 4,10,sunshine,5 75 | 4,10,sunshine,5 76 | 4,10,sunshine,5 77 | 4,10,sunshine,6 78 | 4,10,sunshine,6 79 | 6,10,sunshine,6 80 | 5,10,sunshine,6 81 | 3,10,sunshine,6 82 | 8,10,sunshine,7 83 | 7,10,sunshine,7 84 | 8,10,sunshine,7 85 | 8,10,sunshine,7 86 | 6,10,sunshine,7 87 | 9,10,sunshine,8 88 | 8,10,sunshine,8 89 | 10,10,sunshine,8 90 | 9,10,sunshine,8 91 | 10,10,sunshine,8 92 | 10,10,sunshine,9 93 | 10,10,sunshine,9 94 | 9,10,sunshine,9 95 | 8,10,sunshine,9 96 | 9,10,sunshine,9 97 | 9,10,sunshine,10 98 | 10,10,sunshine,10 99 | 10,10,sunshine,10 100 | 9,10,sunshine,10 101 | 10,10,sunshine,10 102 | -------------------------------------------------------------------------------- /book-data/3-9-1-glm-binom-1.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int germination[N]; // 発芽数 4 | int binom_size[N]; // 二項分布の試行回数 5 | vector[N] solar; // 1：日照あり 6 | vector[N] nutrition; // 栄養量 7 | } 8 | 9 | parameters { 10 | real Intercept; // 切片 11 | real b_solar; // 係数(日照の有無) 12 | real b_nutrition; // 係数(栄養量) 13 | } 14 | 15 | model { 16 | vector[N] prob = Intercept + b_solar*solar + b_nutrition*nutrition; 17 | germination ~ binomial_logit(binom_size, prob); 18 | } 19 | -------------------------------------------------------------------------------- /book-data/3-9-ロジスティック回帰モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ロジスティック回帰モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | 17 | # データの読み込みと図示 ------------------------------------------------------------- 18 | 19 | # 分析対象のデータ 20 | germination_dat <- read.csv("3-9-1-germination.csv") 21 | head(germination_dat, n = 3) 22 | 23 | # データの要約 24 | summary(germination_dat) 25 | 26 | # 図示 27 | ggplot(data = germination_dat, 28 | mapping = aes(x = nutrition, y = germination, color = solar)) + 29 | geom_point() + 30 | labs(title = "種子の発芽数と、日照の有無・栄養素の量の関係") 31 | 32 | 33 | # brmsによるロジスティック回帰モデルの推定 ------------------------------------------------------------------- 34 | 35 | # ロジスティク回帰モデルを作る 36 | glm_binom_brms <- brm( 37 | germination | trials(size) ~ solar + nutrition, # modelの構造を指定 38 | family = binomial(), # 二項分布を使う 39 | data = germination_dat, # データ 40 | seed = 1, # 乱数の種 41 | prior = c(set_prior("", class = "Intercept"))# 無情報事前分布にする 42 | ) 43 | 44 | # MCMCの結果の確認 45 | glm_binom_brms 46 | 47 | 48 | # 推定されたモデルの解釈 ------------------------------------------------------------- 49 | 50 | # 係数の解釈 51 | # 説明変数を作る 52 | newdata_1 <- data.frame( 53 | solar = c("shade", "sunshine", "sunshine"), 54 | nutrition = c(2,2,3), 55 | size = c(10,10,10) 56 | ) 57 | newdata_1 58 | 59 | # 発芽率を予測 60 | # 線形予測子の予測値 61 | linear_fit <- fitted(glm_binom_brms, newdata_1, scale = "linear")[,1] 62 | # ロジスティック関数を適用して、成功確率を計算 63 | fit <- 1 / (1 + exp(-linear_fit)) 64 | fit 65 | 66 | # オッズを計算 67 | odds_1 <- fit[1] / (1 - fit[1]) 68 | odds_2 <- fit[2] / (1 - fit[2]) 69 | odds_3 <- fit[3] / (1 - fit[3]) 70 | 71 | # モデルの係数を取得 72 | coef <- fixef(glm_binom_brms)[,1] 73 | coef 74 | 75 | # solarがshadeからsunshineに変わった時のオッズ比 76 | odds_2 / odds_1 77 | exp(coef["solarsunshine"]) 78 | 79 | # nutritionが1から2に変わった時のオッズ比 80 | odds_3 / odds_2 81 | exp(coef["nutrition"]) 82 | 83 | 84 | # 95%ベイズ信用区間付きの回帰曲線 85 | eff <- marginal_effects(glm_binom_brms, 86 | effects = "nutrition:solar") 87 | 88 | plot(eff, points = TRUE) 89 | 90 | 91 | 92 | # 参考：事後分布の図示 93 | plot(glm_binom_brms, pars = "^b_") 94 | 95 | # 参考：係数の信頼区間 96 | stanplot(glm_binom_brms, type = "intervals", pars = "^b_") 97 | 98 | # 参考：95%ベイズ予測区間付きのグラフ 99 | set.seed(1) 100 | eff_pre <- marginal_effects(glm_binom_brms, 101 | method = "predict", 102 | effects = "nutrition:solar") 103 | plot(eff_pre, points = TRUE) 104 | 105 | 106 | # brmsを用いない実装の方法 ------------------------------------------------------------- 107 | 108 | # 参考：ダミー変数の作成 109 | solar_dummy <- as.numeric(germination_dat$solar == "sunshine") 110 | 111 | # 参考：データの作成 112 | data_list_1 <- list( 113 | N = nrow(germination_dat), 114 | germination = germination_dat$germination, 115 | binom_size = germination_dat$size, 116 | solar = solar_dummy, 117 | nutrition = germination_dat$nutrition 118 | ) 119 | data_list_1 120 | 121 | # 参考：自分でStanコードを実装 122 | glm_binom_stan <- stan( 123 | file = "3-9-1-glm-binom-1.stan", 124 | data = data_list_1, 125 | seed = 1 126 | ) 127 | 128 | # 参考：結果の表示 129 | print(glm_binom_stan, 130 | probs = c(0.025, 0.5, 0.975)) 131 | 132 | 133 | 134 | # 補足：試行回数が常に1の場合 ---------------------------------------------------------- 135 | 136 | # 参考：0/1データの場合（このコードは実行できません） 137 | # glm_bernoulli_brms <- brm( 138 | # formula = 0/1データ ~ 説明変数, # modelの構造を指定 139 | # family = bernoulli(), # ベルヌーイ分布を使う 140 | # data = データ, # データ 141 | # seed = 1, # 乱数の種 142 | # prior = c(set_prior("", class = "Intercept"))# 無情報事前分布にする 143 | # ) 144 | -------------------------------------------------------------------------------- /book-data/4-1-1-fish-num-2.csv: -------------------------------------------------------------------------------- 1 | fish_num,weather,temperature,id 2 | 0,cloudy,5,1 3 | 1,cloudy,24.2,2 4 | 6,cloudy,11.5,3 5 | 0,cloudy,9.8,4 6 | 1,cloudy,18.1,5 7 | 1,cloudy,18.1,6 8 | 0,cloudy,3.7,7 9 | 5,cloudy,8.8,8 10 | 9,cloudy,17.3,9 11 | 3,cloudy,18.9,10 12 | 4,cloudy,15.4,11 13 | 2,cloudy,15.2,12 14 | 2,cloudy,16,13 15 | 3,cloudy,16.7,14 16 | 12,cloudy,26,15 17 | 3,cloudy,24.9,16 18 | 3,cloudy,3.3,17 19 | 9,cloudy,21.1,18 20 | 0,cloudy,26.9,19 21 | 0,cloudy,8.4,20 22 | 2,cloudy,6.8,21 23 | 0,cloudy,0.5,22 24 | 4,cloudy,3.9,23 25 | 1,cloudy,2.8,24 26 | 3,cloudy,7.1,25 27 | 11,cloudy,23.7,26 28 | 15,cloudy,18,27 29 | 11,cloudy,27.3,28 30 | 1,cloudy,16.8,29 31 | 2,cloudy,22.7,30 32 | 14,cloudy,11.4,31 33 | 0,cloudy,11.2,32 34 | 0,cloudy,5.1,33 35 | 10,cloudy,13.6,34 36 | 3,cloudy,7.8,35 37 | 0,cloudy,10.1,36 38 | 8,cloudy,26.7,37 39 | 0,cloudy,6.1,38 40 | 4,cloudy,17.4,39 41 | 0,cloudy,6.2,40 42 | 0,cloudy,8.4,41 43 | 1,cloudy,23.6,42 44 | 0,cloudy,5.2,43 45 | 6,cloudy,17.1,44 46 | 0,cloudy,12.6,45 47 | 0,cloudy,8,46 48 | 0,cloudy,1.4,47 49 | 3,cloudy,3.1,48 50 | 5,cloudy,9.4,49 51 | 1,cloudy,24,50 52 | 4,sunny,6.9,51 53 | 1,sunny,6.4,52 54 | 4,sunny,26.3,53 55 | 6,sunny,29.8,54 56 | 4,sunny,25.3,55 57 | 7,sunny,27.3,56 58 | 0,sunny,14.1,57 59 | 1,sunny,6.7,58 60 | 0,sunny,3.8,59 61 | 0,sunny,8.4,60 62 | 0,sunny,24.5,61 63 | 1,sunny,1.7,62 64 | 2,sunny,24.1,63 65 | 1,sunny,3.1,64 66 | 1,sunny,23,65 67 | 0,sunny,9.1,66 68 | 1,sunny,23.1,67 69 | 1,sunny,16.2,68 70 | 0,sunny,10.9,69 71 | 0,sunny,2.8,70 72 | 0,sunny,22.8,71 73 | 2,sunny,22.8,72 74 | 6,sunny,27.1,73 75 | 4,sunny,29,74 76 | 6,sunny,15.5,75 77 | 0,sunny,16.5,76 78 | 0,sunny,4.9,77 79 | 0,sunny,4.9,78 80 | 0,sunny,23.6,79 81 | 6,sunny,22.5,80 82 | 3,sunny,23.5,81 83 | 1,sunny,19.6,82 84 | 6,sunny,11.3,83 85 | 0,sunny,0.3,84 86 | 5,sunny,28.7,85 87 | 0,sunny,25.2,86 88 | 8,sunny,6.4,87 89 | 0,sunny,14.8,88 90 | 0,sunny,19.1,89 91 | 2,sunny,27.6,90 92 | 0,sunny,0.4,91 93 | 1,sunny,8,92 94 | 0,sunny,13.1,93 95 | 1,sunny,24.9,94 96 | 4,sunny,26.1,95 97 | 2,sunny,7.5,96 98 | 0,sunny,9.7,97 99 | 0,sunny,9.2,98 100 | 2,sunny,5.5,99 101 | 4,sunny,20.4,100 102 | -------------------------------------------------------------------------------- /book-data/4-1-1-glmm-pois.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int N; // サンプルサイズ 3 | int fish_num[N]; // 釣獲尾数 4 | vector[N] sunny; // 晴れダミー変数 5 | vector[N] temp; // 気温データ 6 | } 7 | 8 | parameters { 9 | real Intercept; // 切片 10 | real b_temp; // 係数(気温) 11 | real b_sunny; // 係数(晴れの影響) 12 | vector[N] r; // ランダム効果 13 | real sigma_r; // ランダム効果の標準偏差 14 | } 15 | 16 | transformed parameters{ 17 | vector[N] lambda = Intercept + b_sunny*sunny + b_temp*temp + r; 18 | } 19 | 20 | model { 21 | r ~ normal(0, sigma_r); 22 | fish_num ~ poisson_log(lambda); 23 | } 24 | -------------------------------------------------------------------------------- /book-data/4-1-階層ベイズモデルと一般化線形混合モデルの基本.R: -------------------------------------------------------------------------------- 1 | 2 | # 階層ベイズモデルと一般化線形混合モデルの基本｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(brms) 12 | 13 | # 計算の高速化 14 | rstan_options(auto_write = TRUE) 15 | options(mc.cores = parallel::detectCores()) 16 | 17 | 18 | # データの読み込み ------------------------------------------------------------- 19 | 20 | # 分析対象のデータ 21 | fish_num_climate_2 <- read.csv("4-1-1-fish-num-2.csv") 22 | 23 | # id列を数値ではなくfactorとして扱う 24 | fish_num_climate_2$id <- as.factor(fish_num_climate_2$id) 25 | head(fish_num_climate_2, n = 3) 26 | 27 | 28 | # 通常のポアソン回帰モデルの当てはめ ------------------------------------------------------- 29 | 30 | # ポアソン回帰モデルを作る 31 | glm_pois_brms <- brm( 32 | formula = fish_num ~ weather + temperature, # modelの構造を指定 33 | family = poisson(), # ポアソン分布を使う 34 | data = fish_num_climate_2, # データ 35 | seed = 1, # 乱数の種 36 | prior = c(set_prior("", class = "Intercept"))# 無情報事前分布にする 37 | ) 38 | 39 | glm_pois_brms 40 | 41 | # 当てはめ値と99%予測区間の計算 42 | set.seed(1) 43 | eff_glm_pre <- marginal_effects( 44 | glm_pois_brms, 45 | method = "predict", 46 | effects = "temperature:weather", 47 | probs = c(0.005, 0.995)) 48 | 49 | # 結果の図示 50 | plot(eff_glm_pre, points = T) 51 | 52 | 53 | 54 | # StanによるGLMMの推定 ------------------------------------------------------------- 55 | 56 | # ダミー変数を作る 57 | formula_pois <- formula(fish_num ~ weather + temperature) 58 | design_mat <- model.matrix(formula_pois, fish_num_climate_2) 59 | sunny_dummy <- as.numeric(design_mat[, "weathersunny"]) 60 | 61 | # データの作成 62 | data_list_1 <- list( 63 | N = nrow(fish_num_climate_2), 64 | fish_num = fish_num_climate_2$fish_num, 65 | temp = fish_num_climate_2$temperature, 66 | sunny = sunny_dummy 67 | ) 68 | # 結果の表示 69 | data_list_1 70 | 71 | # MCMCの実行 72 | glmm_pois_stan <- stan( 73 | file = "4-1-1-glmm-pois.stan", 74 | data = data_list_1, 75 | seed = 1 76 | ) 77 | 78 | # 収束の確認 79 | mcmc_rhat(rhat(glmm_pois_stan)) 80 | 81 | # 参考：トレースプロットなど 82 | mcmc_sample <- rstan::extract(glmm_pois_stan, permuted = FALSE) 83 | mcmc_combo( 84 | mcmc_sample, 85 | pars = c("Intercept", "b_sunny", "b_temp", "sigma_r", "lp__")) 86 | 87 | 88 | # 結果の表示 89 | print(glmm_pois_stan, 90 | pars = c("Intercept", "b_sunny", "b_temp", "sigma_r"), 91 | probs = c(0.025, 0.5, 0.975)) 92 | 93 | 94 | # brmsによるGLMMの推定 ------------------------------------------------------------- 95 | 96 | # brmsによるGLMMの推定 97 | glmm_pois_brms <- brm( 98 | formula = fish_num ~ weather + temperature + (1|id), # ランダム効果 99 | family = poisson(), # ポアソン分布を使う 100 | data = fish_num_climate_2, # データ 101 | seed = 1, # 乱数の種 102 | prior = c(set_prior("", class = "Intercept"), 103 | set_prior("", class = "sd")) # 無情報事前分布にする 104 | ) 105 | 106 | # 結果の表示 107 | glmm_pois_brms 108 | 109 | # 参考：トレースプロットなど 110 | plot(glmm_pois_brms) 111 | 112 | # 参考：stancode 113 | stancode(glmm_pois_brms) 114 | 115 | 116 | -------------------------------------------------------------------------------- /book-data/4-2-1-fish-num-3.csv: -------------------------------------------------------------------------------- 1 | fish_num,weather,temperature,human 2 | 1,cloudy,6,A 3 | 7,cloudy,20.6,B 4 | 12,cloudy,27.5,C 5 | 0,cloudy,8.5,D 6 | 0,cloudy,3.1,E 7 | 2,cloudy,21,F 8 | 4,cloudy,15.8,G 9 | 2,cloudy,24.2,H 10 | 4,cloudy,28.7,I 11 | 0,cloudy,3.3,J 12 | 1,cloudy,8.2,A 13 | 0,cloudy,14.7,B 14 | 4,cloudy,9.6,C 15 | 1,cloudy,16.8,D 16 | 0,cloudy,7.9,E 17 | 0,cloudy,6.1,F 18 | 2,cloudy,11.6,G 19 | 3,cloudy,26.6,H 20 | 2,cloudy,16.6,I 21 | 4,cloudy,25.3,J 22 | 11,cloudy,26.7,A 23 | 4,cloudy,21.6,B 24 | 3,cloudy,6.3,C 25 | 0,cloudy,6.8,D 26 | 1,cloudy,4.2,E 27 | 1,cloudy,14.4,F 28 | 3,cloudy,13.1,G 29 | 4,cloudy,29,H 30 | 1,cloudy,4.3,I 31 | 8,cloudy,28.6,J 32 | 2,cloudy,13.3,A 33 | 1,cloudy,1.8,B 34 | 3,cloudy,8.3,C 35 | 0,cloudy,0.9,D 36 | 0,cloudy,0.4,E 37 | 0,cloudy,14.6,F 38 | 5,cloudy,17.9,G 39 | 2,cloudy,17.9,H 40 | 1,cloudy,11.9,I 41 | 0,cloudy,11.9,J 42 | 15,cloudy,24.5,A 43 | 1,cloudy,7.1,B 44 | 8,cloudy,24.8,C 45 | 0,cloudy,16,D 46 | 6,cloudy,27.9,E 47 | 3,cloudy,16.5,F 48 | 4,cloudy,22.8,G 49 | 2,cloudy,2.1,H 50 | 8,cloudy,23.8,I 51 | 0,cloudy,19,J 52 | 2,sunny,11.5,A 53 | 3,sunny,17,B 54 | 6,sunny,27.7,C 55 | 5,sunny,29.3,D 56 | 2,sunny,28,E 57 | 0,sunny,11.4,F 58 | 2,sunny,7.7,G 59 | 1,sunny,7.7,H 60 | 0,sunny,5.9,I 61 | 0,sunny,4.1,J 62 | 5,sunny,18.7,A 63 | 0,sunny,5.2,B 64 | 8,sunny,26,C 65 | 1,sunny,29.7,D 66 | 5,sunny,29.6,E 67 | 0,sunny,26.8,F 68 | 5,sunny,26.6,G 69 | 1,sunny,4.7,H 70 | 2,sunny,27.9,I 71 | 5,sunny,24.8,J 72 | 6,sunny,24.9,A 73 | 1,sunny,21.5,B 74 | 1,sunny,4.7,C 75 | 2,sunny,25.1,D 76 | 0,sunny,0.7,E 77 | 2,sunny,27.6,F 78 | 0,sunny,1.2,G 79 | 0,sunny,21,H 80 | 2,sunny,13.3,I 81 | 1,sunny,9.4,J 82 | 11,sunny,28.2,A 83 | 2,sunny,24.7,B 84 | 1,sunny,6.3,C 85 | 0,sunny,2.7,D 86 | 1,sunny,14.1,E 87 | 0,sunny,1.5,F 88 | 8,sunny,29.1,G 89 | 3,sunny,23.5,H 90 | 0,sunny,9.7,I 91 | 1,sunny,18.3,J 92 | 1,sunny,21.4,A 93 | 0,sunny,10.1,B 94 | 0,sunny,5.6,C 95 | 0,sunny,11.9,D 96 | 2,sunny,9.7,E 97 | 0,sunny,24.5,F 98 | 0,sunny,7,G 99 | 1,sunny,18.8,H 100 | 3,sunny,14.2,I 101 | 0,sunny,13.7,J 102 | -------------------------------------------------------------------------------- /book-data/4-2-ランダム切片モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ランダム切片モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # データの読み込み ------------------------------------------------------------- 17 | 18 | # 分析対象のデータ 19 | fish_num_climate_3 <- read.csv("4-2-1-fish-num-3.csv") 20 | head(fish_num_climate_3, n = 3) 21 | 22 | # データの要約 23 | summary(fish_num_climate_3) 24 | 25 | # brmsによるGLMMの推定 ------------------------------------------------------------- 26 | 27 | # brmsによるGLMMの推定 28 | glmm_pois_brms_human <- brm( 29 | formula = fish_num ~ weather + temperature + (1|human), 30 | family = poisson(), 31 | data = fish_num_climate_3, 32 | seed = 1, 33 | prior = c(set_prior("", class = "Intercept"), 34 | set_prior("", class = "sd")) 35 | ) 36 | 37 | # 参考：トレースプロットなど 38 | plot(glmm_pois_brms_human) 39 | 40 | # 参考：収束の確認 41 | stanplot(glmm_pois_brms_human, type = "rhat") 42 | 43 | # 結果の表示 44 | glmm_pois_brms_human 45 | 46 | # 各々の調査者の影響の大きさ 47 | ranef(glmm_pois_brms_human) 48 | 49 | 50 | 51 | # ランダム切片モデルの回帰曲線の図示 ----------------------------------------------------------------- 52 | 53 | # 調査者ごとにグラフを分けて、回帰曲線を描く 54 | conditions <- data.frame( 55 | human = c("A","B","C","D","E","F","G","H","I","J")) 56 | 57 | eff_glmm_human <- marginal_effects( 58 | glmm_pois_brms_human, 59 | effects = "temperature:weather", 60 | re_formula = NULL, 61 | conditions = conditions) 62 | 63 | plot(eff_glmm_human, points = TRUE) 64 | 65 | 66 | -------------------------------------------------------------------------------- /book-data/4-3-1-fish-num-4.csv: -------------------------------------------------------------------------------- 1 | fish_num,temperature,human 2 | 2,12.7,A 3 | 6,13.7,B 4 | 9,15.7,C 5 | 5,19.1,D 6 | 11,12,E 7 | 19,19,F 8 | 14,19.4,G 9 | 10,16.6,H 10 | 4,16.3,I 11 | 1,10.6,A 12 | 4,12.1,B 13 | 7,11.8,C 14 | 6,16.9,D 15 | 7,13.8,E 16 | 18,17.7,F 17 | 5,15,G 18 | 10,17.2,H 19 | 5,19.9,I 20 | 3,13.8,A 21 | 13,17.8,B 22 | 21,19.3,C 23 | 4,12.1,D 24 | 23,16.5,E 25 | 1,11.3,F 26 | 2,12.7,G 27 | 8,13.9,H 28 | 0,10.1,I 29 | 4,13.8,A 30 | 29,18.7,B 31 | 7,13.4,C 32 | 4,14.8,D 33 | 21,16,E 34 | 10,14.9,F 35 | 3,11.9,G 36 | 20,18.3,H 37 | 2,16.7,I 38 | 11,17.9,A 39 | 4,11.1,B 40 | 20,17.2,C 41 | 5,14.1,D 42 | 28,18.2,E 43 | 11,16.5,F 44 | 9,17.8,G 45 | 5,15.5,H 46 | 6,15.3,I 47 | 6,17.9,A 48 | 4,10.2,B 49 | 6,14.8,C 50 | 9,17.3,D 51 | 16,16.9,E 52 | 6,14.8,F 53 | 8,18.6,G 54 | 4,14.4,H 55 | 1,12.4,I 56 | 2,10.7,A 57 | 9,11,B 58 | 4,13.2,C 59 | 6,15.2,D 60 | 25,16.6,E 61 | 5,14.1,F 62 | 14,19.1,G 63 | 9,12.9,H 64 | 2,14.6,I 65 | 2,13.3,A 66 | 11,16.5,B 67 | 10,12.6,C 68 | 4,14.8,D 69 | 20,17.7,E 70 | 6,10.8,F 71 | 11,18.8,G 72 | 5,13.4,H 73 | 6,18.4,I 74 | 2,13.5,A 75 | 9,13.3,B 76 | 11,14.8,C 77 | 9,18.9,D 78 | 27,18.6,E 79 | 7,13.9,F 80 | 14,17.8,G 81 | 15,19.6,H 82 | 2,14.3,I 83 | 4,17.1,A 84 | 8,14,B 85 | 12,13.3,C 86 | 10,17.6,D 87 | 11,12,E 88 | 12,17.1,F 89 | 2,11.2,G 90 | 2,12.5,H 91 | 0,11.4,I 92 | 15,10.3,J 93 | 10,15.1,J 94 | 11,16.2,J 95 | 5,19.2,J 96 | -------------------------------------------------------------------------------- /book-data/4-3-ランダム係数モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ランダム係数モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # データの読み込み ------------------------------------------------------------- 17 | 18 | # 分析対象のデータ 19 | fish_num_climate_4 <- read.csv("4-3-1-fish-num-4.csv") 20 | head(fish_num_climate_4, n = 3) 21 | 22 | # データの要約 23 | summary(fish_num_climate_4) 24 | 25 | 26 | # 交互作用を用いたモデル化 ------------------------------------------------------------ 27 | 28 | # 交互作用を組み込んだポアソン回帰モデル 29 | glm_pois_brms_interaction <- brm( 30 | formula = fish_num ~ temperature * human, 31 | family = poisson(), 32 | data = fish_num_climate_4, 33 | seed = 1, 34 | prior = c(set_prior("", class = "Intercept")) 35 | ) 36 | 37 | # 参考：推定結果 38 | glm_pois_brms_interaction 39 | 40 | # 参考：収束の確認 41 | stanplot(glm_pois_brms_interaction, type = "rhat") 42 | 43 | 44 | # 回帰曲線を描く 45 | # データの分割 46 | conditions <- data.frame( 47 | human = c("A","B","C","D","E","F","G","H","I","J")) 48 | 49 | # 図示 50 | eff_1 <- marginal_effects(glm_pois_brms_interaction, 51 | effects = "temperature", 52 | conditions = conditions) 53 | plot(eff_1, points = TRUE) 54 | 55 | # brmsによるランダム係数モデルの推定 -------------------------------------------------------- 56 | 57 | # ランダム係数モデル 58 | glmm_pois_brms_keisu <- brm( 59 | formula = fish_num ~ temperature + (temperature||human), 60 | family = poisson(), 61 | data = fish_num_climate_4, 62 | seed = 1, 63 | iter = 6000, 64 | warmup = 5000, 65 | control = list(adapt_delta = 0.97, max_treedepth = 15) 66 | ) 67 | 68 | 69 | # 参考：推定結果 70 | glmm_pois_brms_keisu 71 | 72 | # 参考：トレースプロットなど 73 | plot(glmm_pois_brms_keisu) 74 | 75 | # 参考：弱情報事前分布 76 | prior_summary(glmm_pois_brms_keisu) 77 | 78 | # 参考：収束の確認 79 | stanplot(glmm_pois_brms_keisu, type = "rhat") 80 | 81 | # 回帰曲線を描く 82 | # データの分割 83 | conditions <- data.frame( 84 | human = c("A","B","C","D","E","F","G","H","I","J")) 85 | 86 | # 図示 87 | eff_2 <- marginal_effects(glmm_pois_brms_keisu, 88 | re_formula = NULL, 89 | effects = "temperature", 90 | conditions = conditions) 91 | plot(eff_2, points = TRUE) 92 | 93 | 94 | 95 | -------------------------------------------------------------------------------- /book-data/5-2-1-local-level.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | } 5 | 6 | parameters { 7 | vector[T] mu; // 状態の推定値(水準成分) 8 | real s_w; // 過程誤差の標準偏差 9 | real s_v; // 観測誤差の標準偏差 10 | } 11 | 12 | model { 13 | // 状態方程式に従い、状態が遷移する 14 | for(i in 2:T) { 15 | mu[i] ~ normal(mu[i-1], s_w); 16 | } 17 | 18 | // 観測方程式に従い、観測値が得られる 19 | for(i in 1:T) { 20 | y[i] ~ normal(mu[i], s_v); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /book-data/5-2-1-sales-ts-1.csv: -------------------------------------------------------------------------------- 1 | date,sales 2 | 2010-01-01,23.9 3 | 2010-01-02,19 4 | 2010-01-03,20.3 5 | 2010-01-04,24.2 6 | 2010-01-05,19.3 7 | 2010-01-06,16.7 8 | 2010-01-07,24.2 9 | 2010-01-08,20.5 10 | 2010-01-09,18.6 11 | 2010-01-10,21.9 12 | 2010-01-11,20.8 13 | 2010-01-12,14.8 14 | 2010-01-13,18.2 15 | 2010-01-14,16.7 16 | 2010-01-15,15.9 17 | 2010-01-16,17.2 18 | 2010-01-17,12 19 | 2010-01-18,8.9 20 | 2010-01-19,11.8 21 | 2010-01-20,11.4 22 | 2010-01-21,9.8 23 | 2010-01-22,12.2 24 | 2010-01-23,11.3 25 | 2010-01-24,13.7 26 | 2010-01-25,11.6 27 | 2010-01-26,11.3 28 | 2010-01-27,11.9 29 | 2010-01-28,15.3 30 | 2010-01-29,17.7 31 | 2010-01-30,9.9 32 | 2010-01-31,14.8 33 | 2010-02-01,20.5 34 | 2010-02-02,13.1 35 | 2010-02-03,18.5 36 | 2010-02-04,15.1 37 | 2010-02-05,16.5 38 | 2010-02-06,17.1 39 | 2010-02-07,21.6 40 | 2010-02-08,19.9 41 | 2010-02-09,20.5 42 | 2010-02-10,14.5 43 | 2010-02-11,7.8 44 | 2010-02-12,11.1 45 | 2010-02-13,13.7 46 | 2010-02-14,19.4 47 | 2010-02-15,11.4 48 | 2010-02-16,12.1 49 | 2010-02-17,21.2 50 | 2010-02-18,11.5 51 | 2010-02-19,17.3 52 | 2010-02-20,12.5 53 | 2010-02-21,11.1 54 | 2010-02-22,15.8 55 | 2010-02-23,13.8 56 | 2010-02-24,14 57 | 2010-02-25,18.1 58 | 2010-02-26,18.1 59 | 2010-02-27,21.5 60 | 2010-02-28,18.6 61 | 2010-03-01,23.1 62 | 2010-03-02,23.7 63 | 2010-03-03,15.6 64 | 2010-03-04,16.3 65 | 2010-03-05,13.7 66 | 2010-03-06,21.6 67 | 2010-03-07,20.4 68 | 2010-03-08,21.7 69 | 2010-03-09,19.2 70 | 2010-03-10,23.6 71 | 2010-03-11,16.3 72 | 2010-03-12,14.2 73 | 2010-03-13,19.3 74 | 2010-03-14,19.1 75 | 2010-03-15,14 76 | 2010-03-16,19.9 77 | 2010-03-17,18.2 78 | 2010-03-18,19.7 79 | 2010-03-19,17.3 80 | 2010-03-20,14.4 81 | 2010-03-21,15.3 82 | 2010-03-22,14 83 | 2010-03-23,10.2 84 | 2010-03-24,20.7 85 | 2010-03-25,9.9 86 | 2010-03-26,14.8 87 | 2010-03-27,12.7 88 | 2010-03-28,10.6 89 | 2010-03-29,12.9 90 | 2010-03-30,15.5 91 | 2010-03-31,9 92 | 2010-04-01,11.6 93 | 2010-04-02,10.8 94 | 2010-04-03,8.1 95 | 2010-04-04,7.3 96 | 2010-04-05,5.9 97 | 2010-04-06,6.2 98 | 2010-04-07,13.4 99 | 2010-04-08,8.6 100 | 2010-04-09,8 101 | 2010-04-10,10.7 102 | -------------------------------------------------------------------------------- /book-data/5-2-ローカルレベルモデル.R: -------------------------------------------------------------------------------- 1 | 2 | # ローカルレベルモデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(ggfortify) 12 | library(gridExtra) 13 | 14 | # 計算の高速化 15 | rstan_options(auto_write = TRUE) 16 | options(mc.cores = parallel::detectCores()) 17 | 18 | # ホワイトノイズとランダムウォーク ---------------------------------------------------------------- 19 | 20 | # 正規ホワイトノイズ 21 | set.seed(1) 22 | wn <- rnorm(n = 100, mean = 0, sd = 1) 23 | 24 | # 累積和をとる関数cumsumの説明 25 | cumsum(c(1,3,2)) 26 | 27 | # ランダムウォーク 28 | rw <- cumsum(wn) 29 | 30 | # グラフを作る 31 | p_wn_1 <- autoplot(ts(wn), main = "ホワイトノイズ") 32 | p_rw_1 <- autoplot(ts(rw), main = "ランダムウォーク") 33 | 34 | # 2つのグラフをまとめる 35 | grid.arrange(p_wn_1, p_rw_1) 36 | 37 | 38 | # 複数のホワイトノイズ・ランダムウォーク系列 39 | wn_mat <- matrix(nrow = 100, ncol = 20) 40 | rw_mat <- matrix(nrow = 100, ncol = 20) 41 | 42 | set.seed(1) 43 | for(i in 1:20){ 44 | wn <- rnorm(n = 100, mean = 0, sd = 1) 45 | wn_mat[,i] <- wn 46 | rw_mat[,i] <- cumsum(wn) 47 | } 48 | 49 | # グラフを作る 50 | p_wn_2 <- autoplot(ts(wn_mat), facets = F, main = "ホワイトノイズ") + 51 | theme(legend.position = 'none') # 凡例を消す 52 | 53 | p_rw_2 <- autoplot(ts(rw_mat), facets = F, main = "ランダムウォーク") + 54 | theme(legend.position = 'none') # 凡例を消す 55 | 56 | # 2つのグラフをまとめる 57 | grid.arrange(p_wn_2, p_rw_2) 58 | 59 | 60 | # データの読み込みとPOSIXctへの変換 ---------------------------------------------------- 61 | 62 | # データの読み込み 63 | sales_df <- read.csv("5-2-1-sales-ts-1.csv") 64 | 65 | # 日付をPOSIXct形式にする 66 | sales_df$date <- as.POSIXct(sales_df$date) 67 | 68 | # データの先頭行を表示 69 | head(sales_df, n = 3) 70 | 71 | # POSIXctの補足 72 | POSIXct_time <- as.POSIXct("1970-01-01 00:00:05", tz="UTC") 73 | as.numeric(POSIXct_time) 74 | 75 | 76 | # ローカルレベルモデルの推定 ------------------------------------------------------------- 77 | 78 | # データの準備 79 | data_list <- list( 80 | y = sales_df$sales, 81 | T = nrow(sales_df) 82 | ) 83 | 84 | # モデルの推定 85 | local_level_stan <- stan( 86 | file = "5-2-1-local-level.stan", 87 | data = data_list, 88 | seed = 1 89 | ) 90 | 91 | # 収束の確認 92 | mcmc_rhat(rhat(local_level_stan)) 93 | 94 | 95 | # 結果の表示 96 | print(local_level_stan, 97 | pars = c("s_w", "s_v","lp__"), 98 | probs = c(0.025, 0.5, 0.975)) 99 | 100 | 101 | # 結果の図示 ------------------------------------------------------------------- 102 | 103 | # 生成された乱数を格納 104 | mcmc_sample <- rstan::extract(local_level_stan) 105 | 106 | # Stanにおける状態を表す変数名 107 | state_name <- "mu" 108 | 109 | # 1時点目の状態の95%ベイズ信用区間と中央値を得る 110 | quantile(mcmc_sample[[state_name]][, 1], 111 | probs=c(0.025, 0.5, 0.975)) 112 | 113 | # すべての時点の状態の、95%ベイズ信用区間と中央値 114 | result_df <- data.frame(t(apply( 115 | X = mcmc_sample[[state_name]],# 実行対象となるデータ 116 | MARGIN = 2, # 列を対象としてループ 117 | FUN = quantile, # 実行対象となる関数 118 | probs=c(0.025, 0.5, 0.975) # 上記関数に入れる引数 119 | ))) 120 | 121 | # 列名の変更 122 | colnames(result_df) <- c("lwr", "fit", "upr") 123 | 124 | # 時間軸の追加 125 | result_df$time <- sales_df$date 126 | 127 | # 観測値の追加 128 | result_df$obs <- sales_df$sales 129 | 130 | # 図示のためのデータの確認 131 | head(result_df, n = 3) 132 | 133 | # 図示 134 | ggplot(data = result_df, aes(x = time, y = obs)) + 135 | labs(title="ローカルレベルモデルの推定結果") + 136 | ylab("sales") + 137 | geom_point(alpha = 0.6, size = 0.9) + 138 | geom_line(aes(y = fit), size = 1.2) + 139 | geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.3) + 140 | scale_x_datetime(date_labels = "%Y年%m月") 141 | 142 | 143 | # 図示をする関数 ----------------------------------------------------------------- 144 | 145 | plotSSM <- function(mcmc_sample, time_vec, obs_vec = NULL, 146 | state_name, graph_title, y_label, 147 | date_labels = "%Y年%m月"){ 148 | # 状態空間モデルを図示する関数 149 | # 150 | # Args: 151 | # mcmc_sample : MCMCサンプル 152 | # time_vec : 時間軸(POSIXct)のベクトル 153 | # obs_vec : (必要なら)観測値のベクトル 154 | # state_name : 図示する状態の変数名 155 | # graph_title : グラフタイトル 156 | # y_label : y軸のラベル 157 | # date_labels : 日付の書式 158 | # 159 | # Returns: 160 | # ggplot2により生成されたグラフ 161 | 162 | # すべての時点の状態の、95%区間と中央値 163 | result_df <- data.frame(t(apply( 164 | X = mcmc_sample[[state_name]], 165 | MARGIN = 2, quantile, probs = c(0.025, 0.5, 0.975) 166 | ))) 167 | 168 | # 列名の変更 169 | colnames(result_df) <- c("lwr", "fit", "upr") 170 | 171 | # 時間軸の追加 172 | result_df$time <- time_vec 173 | 174 | # 観測値の追加 175 | if(!is.null(obs_vec)){ 176 | result_df$obs <- obs_vec 177 | } 178 | 179 | # 図示 180 | p <- ggplot(data = result_df, aes(x = time)) + 181 | labs(title = graph_title) + 182 | ylab(y_label) + 183 | geom_line(aes(y = fit), size = 1.2) + 184 | geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.3) + 185 | scale_x_datetime(date_labels = date_labels) 186 | 187 | # 観測値をグラフに追加 188 | if(!is.null(obs_vec)){ 189 | p <- p + geom_point(alpha = 0.6, size = 0.9, 190 | data = result_df, aes(x = time, y = obs)) 191 | } 192 | 193 | # グラフを返す 194 | return(p) 195 | } 196 | 197 | plotSSM(mcmc_sample = mcmc_sample, time_vec = sales_df$date, 198 | obs_vec = sales_df$sales, 199 | state_name = "mu", graph_title = "ローカルレベルモデルの推定結果", 200 | y_label = "sales") 201 | 202 | 203 | 204 | 205 | 206 | -------------------------------------------------------------------------------- /book-data/5-3-1-local-level-pred.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | int pred_term; // 予測期間の長さ 5 | } 6 | 7 | parameters { 8 | vector[T] mu; // 状態の推定値(水準成分) 9 | real s_w; // 過程誤差の標準偏差 10 | real s_v; // 観測誤差の標準偏差 11 | } 12 | 13 | model { 14 | // 状態方程式に従い、状態が遷移する 15 | for(i in 2:T) { 16 | mu[i] ~ normal(mu[i-1], s_w); 17 | } 18 | 19 | // 観測方程式に従い、観測値が得られる 20 | for(i in 1:T) { 21 | y[i] ~ normal(mu[i], s_v); 22 | } 23 | } 24 | 25 | generated quantities{ 26 | vector[T + pred_term] mu_pred; // 予測値も含めた状態の推定値 27 | 28 | // データ取得期間においては、状態推定値muと同じ 29 | mu_pred[1:T] = mu; 30 | 31 | // データ取得期間を超えた部分を予測 32 | for(i in 1:pred_term){ 33 | mu_pred[T + i] = normal_rng(mu_pred[T + i - 1], s_w); 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /book-data/5-3-1-sales-ts-1-NA.csv: -------------------------------------------------------------------------------- 1 | date,sales 2 | 2010-01-01,23.9 3 | 2010-01-02,19 4 | 2010-01-03,NA 5 | 2010-01-04,24.2 6 | 2010-01-05,19.3 7 | 2010-01-06,16.7 8 | 2010-01-07,24.2 9 | 2010-01-08,20.5 10 | 2010-01-09,18.6 11 | 2010-01-10,21.9 12 | 2010-01-11,20.8 13 | 2010-01-12,14.8 14 | 2010-01-13,18.2 15 | 2010-01-14,16.7 16 | 2010-01-15,15.9 17 | 2010-01-16,17.2 18 | 2010-01-17,12 19 | 2010-01-18,8.9 20 | 2010-01-19,11.8 21 | 2010-01-20,11.4 22 | 2010-01-21,9.8 23 | 2010-01-22,12.2 24 | 2010-01-23,11.3 25 | 2010-01-24,13.7 26 | 2010-01-25,11.6 27 | 2010-01-26,11.3 28 | 2010-01-27,NA 29 | 2010-01-28,NA 30 | 2010-01-29,NA 31 | 2010-01-30,NA 32 | 2010-01-31,NA 33 | 2010-02-01,NA 34 | 2010-02-02,NA 35 | 2010-02-03,NA 36 | 2010-02-04,NA 37 | 2010-02-05,NA 38 | 2010-02-06,NA 39 | 2010-02-07,NA 40 | 2010-02-08,NA 41 | 2010-02-09,NA 42 | 2010-02-10,NA 43 | 2010-02-11,NA 44 | 2010-02-12,NA 45 | 2010-02-13,NA 46 | 2010-02-14,NA 47 | 2010-02-15,NA 48 | 2010-02-16,NA 49 | 2010-02-17,NA 50 | 2010-02-18,11.5 51 | 2010-02-19,17.3 52 | 2010-02-20,12.5 53 | 2010-02-21,11.1 54 | 2010-02-22,15.8 55 | 2010-02-23,13.8 56 | 2010-02-24,14 57 | 2010-02-25,18.1 58 | 2010-02-26,18.1 59 | 2010-02-27,21.5 60 | 2010-02-28,18.6 61 | 2010-03-01,23.1 62 | 2010-03-02,23.7 63 | 2010-03-03,15.6 64 | 2010-03-04,16.3 65 | 2010-03-05,13.7 66 | 2010-03-06,21.6 67 | 2010-03-07,20.4 68 | 2010-03-08,21.7 69 | 2010-03-09,19.2 70 | 2010-03-10,23.6 71 | 2010-03-11,16.3 72 | 2010-03-12,14.2 73 | 2010-03-13,19.3 74 | 2010-03-14,19.1 75 | 2010-03-15,14 76 | 2010-03-16,19.9 77 | 2010-03-17,18.2 78 | 2010-03-18,19.7 79 | 2010-03-19,NA 80 | 2010-03-20,NA 81 | 2010-03-21,15.3 82 | 2010-03-22,14 83 | 2010-03-23,10.2 84 | 2010-03-24,20.7 85 | 2010-03-25,9.9 86 | 2010-03-26,14.8 87 | 2010-03-27,12.7 88 | 2010-03-28,10.6 89 | 2010-03-29,12.9 90 | 2010-03-30,15.5 91 | 2010-03-31,9 92 | 2010-04-01,11.6 93 | 2010-04-02,10.8 94 | 2010-04-03,8.1 95 | 2010-04-04,7.3 96 | 2010-04-05,NA 97 | 2010-04-06,6.2 98 | 2010-04-07,13.4 99 | 2010-04-08,8.6 100 | 2010-04-09,8 101 | 2010-04-10,10.7 102 | -------------------------------------------------------------------------------- /book-data/5-3-2-local-level-interpolation.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | int len_obs; // 観測値が得られた個数 4 | vector[len_obs] y; // 観測値 5 | int obs_no[len_obs]; // 観測値が得られた時点 6 | } 7 | 8 | parameters { 9 | vector[T] mu; // 状態の推定値(水準成分) 10 | real s_w; // 過程誤差の標準偏差 11 | real s_v; // 観測誤差の標準偏差 12 | } 13 | 14 | model { 15 | // 状態方程式に従い、状態が遷移する 16 | for(i in 2:T) { 17 | mu[i] ~ normal(mu[i-1], s_w); 18 | } 19 | 20 | // 観測方程式に従い、観測値が得られる 21 | // ただし、「観測値が得られた時点」でのみ実行する 22 | for(i in 1:len_obs) { 23 | y[i] ~ normal(mu[obs_no[i]], s_v); 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /book-data/5-3-3-local-level-interpolation-prediction-interval.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | int len_obs; // 観測値が得られた個数 4 | vector[len_obs] y; // 観測値 5 | int obs_no[len_obs]; // 観測値が得られた時点 6 | } 7 | 8 | parameters { 9 | vector[T] mu; // 状態の推定値(水準成分) 10 | real s_w; // 過程誤差の標準偏差 11 | real s_v; // 観測誤差の標準偏差 12 | } 13 | 14 | model { 15 | // 状態方程式に従い、状態が遷移する 16 | for(i in 2:T) { 17 | mu[i] ~ normal(mu[i-1], s_w); 18 | } 19 | 20 | // 観測方程式に従い、観測値が得られる 21 | // ただし、「観測値が得られた時点」でのみ実行する 22 | for(i in 1:len_obs) { 23 | y[i] ~ normal(mu[obs_no[i]], s_v); 24 | } 25 | } 26 | 27 | generated quantities { 28 | vector[T] y_pred; // 観測値の予測値 29 | 30 | for (i in 1:T) { 31 | y_pred[i] = normal_rng(mu[i], s_v); 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /book-data/5-3-状態空間モデルによる予測と補間.R: -------------------------------------------------------------------------------- 1 | 2 | # 状態空間モデルによる予測と補間｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | 12 | # 計算の高速化 13 | rstan_options(auto_write = TRUE) 14 | options(mc.cores = parallel::detectCores()) 15 | 16 | # 状態空間モデルの図示をする関数の読み込み 17 | source("plotSSM.R", encoding="utf-8") 18 | 19 | # データの読み込み 20 | sales_df_all <- read.csv("5-2-1-sales-ts-1.csv") 21 | sales_df_all$date <- as.POSIXct(sales_df_all$date) 22 | 23 | # ローカルレベルモデルによる予測の実行 ---------------------------------------------------------------------- 24 | 25 | # データの準備 26 | data_list_pred <- list( 27 | T = nrow(sales_df_all), 28 | y = sales_df_all$sales, 29 | pred_term = 20 30 | ) 31 | 32 | # モデルの推定 33 | local_level_pred <- stan( 34 | file = "5-3-1-local-level-pred.stan", 35 | data = data_list_pred, 36 | seed = 1 37 | ) 38 | 39 | # 参考：収束の確認 40 | mcmc_rhat(rhat(local_level_pred)) 41 | 42 | # 参考：結果の表示 43 | print(local_level_pred, 44 | pars = c("s_w", "s_v","lp__"), 45 | probs = c(0.025, 0.5, 0.975)) 46 | 47 | 48 | ## 図示 49 | 50 | # 予測対象期間も含めた日付を用意 51 | date_plot <- seq( 52 | from = as.POSIXct("2010-01-01"), 53 | by = "days", 54 | len = 120) 55 | 56 | # 参考 57 | seq(from = as.POSIXct("2010-01-01"), 58 | by = 60*60*24, 59 | len = 120) 60 | 61 | # 生成された乱数を格納 62 | mcmc_sample_pred <- rstan::extract(local_level_pred) 63 | 64 | # 予測結果の図示 65 | plotSSM(mcmc_sample = mcmc_sample_pred, 66 | time_vec = date_plot, 67 | state_name = "mu_pred", 68 | graph_title = "予測の結果", 69 | y_label = "sales") 70 | 71 | 72 | # 欠損があるデータ ---------------------------------------------------------------- 73 | 74 | # データの読み込み 75 | sales_df_NA <- read.csv("5-3-1-sales-ts-1-NA.csv") 76 | 77 | # 日付をPOSIXct形式にする 78 | sales_df_NA$date <- as.POSIXct(sales_df_NA$date) 79 | 80 | # 売り上げデータに一部欠損がある 81 | head(sales_df_NA, n = 3) 82 | 83 | 84 | # 欠損データの取り扱い ------------------------------------------------------------------ 85 | 86 | # NAがある行を削除 87 | sales_df_omit_NA <- na.omit(sales_df_NA) 88 | head(sales_df_omit_NA, n = 3) 89 | 90 | # データを取得した期間 91 | nrow(sales_df_NA) 92 | 93 | # 正しくデータが取得できた日数 94 | nrow(sales_df_omit_NA) 95 | 96 | # NAがどこにあるのかを判別 97 | !is.na(sales_df_NA$sales) 98 | 99 | # TRUEである要素番号の取得 100 | which(c(TRUE, FALSE, TRUE)) 101 | 102 | # データがある行番号の取得 103 | which(!is.na(sales_df_NA$sales)) 104 | 105 | 106 | # ローカルレベルモデルによる補間の実行 ------------------------------------------------------------------ 107 | 108 | # データの準備 109 | data_list_interpolation <- list( 110 | T = nrow(sales_df_NA), 111 | len_obs = nrow(sales_df_omit_NA), 112 | y = sales_df_omit_NA$sales, 113 | obs_no = which(!is.na(sales_df_NA$sales)) 114 | ) 115 | 116 | # モデルの推定 117 | local_level_interpolation <- stan( 118 | file = "5-3-2-local-level-interpolation.stan", 119 | data = data_list_interpolation, 120 | seed = 1, 121 | iter = 4000 122 | ) 123 | 124 | # 参考：収束の確認 125 | mcmc_rhat(rhat(local_level_interpolation)) 126 | 127 | # 参考：結果の表示 128 | print(local_level_interpolation, 129 | pars = c("s_w", "s_v","lp__"), 130 | probs = c(0.025, 0.5, 0.975)) 131 | 132 | 133 | ## 図示 134 | 135 | # 生成された乱数を格納 136 | mcmc_sample_interpolation <- rstan::extract( 137 | local_level_interpolation) 138 | 139 | # 図示 140 | plotSSM(mcmc_sample = mcmc_sample_interpolation, 141 | time_vec = sales_df_all$date, 142 | obs_vec = sales_df_all$sales, 143 | state_name = "mu", 144 | graph_title = "補間の結果", 145 | y_label = "sales") 146 | 147 | 148 | 149 | # 参考：予測区間 ----------------------------------------------------------------- 150 | 151 | 152 | # モデルの推定 153 | local_level_prediction_interval <- stan( 154 | file = "5-3-3-local-level-interpolation-prediction-interval.stan", 155 | data = data_list_interpolation, 156 | seed = 1, 157 | iter = 4000 158 | ) 159 | 160 | # 参考：収束の確認 161 | mcmc_rhat(rhat(local_level_prediction_interval)) 162 | 163 | # 参考：結果の表示 164 | print(local_level_prediction_interval, 165 | pars = c("s_w", "s_v","lp__"), 166 | probs = c(0.025, 0.5, 0.975)) 167 | 168 | 169 | ## 図示 170 | 171 | # 生成された乱数を格納 172 | mcmc_sample_prediction_interval <- rstan::extract( 173 | local_level_prediction_interval) 174 | 175 | # 図示 176 | plotSSM(mcmc_sample = mcmc_sample_prediction_interval, 177 | time_vec = sales_df_all$date, 178 | obs_vec = sales_df_all$sales, 179 | state_name = "y_pred", 180 | graph_title = "補間の結果:予測分布", 181 | y_label = "sales") 182 | 183 | 184 | 185 | -------------------------------------------------------------------------------- /book-data/5-4-1-sales-ts-2.csv: -------------------------------------------------------------------------------- 1 | date,sales,publicity 2 | 2010-01-01,95.8,0 3 | 2010-01-02,83.6,0 4 | 2010-01-03,94.1,0 5 | 2010-01-04,98.1,0 6 | 2010-01-05,122.8,1 7 | 2010-01-06,96.2,0 8 | 2010-01-07,124.1,1 9 | 2010-01-08,117.6,1 10 | 2010-01-09,133.1,2 11 | 2010-01-10,128.4,0 12 | 2010-01-11,148.1,1 13 | 2010-01-12,129.8,0 14 | 2010-01-13,131.4,0 15 | 2010-01-14,128.6,2 16 | 2010-01-15,118.8,0 17 | 2010-01-16,97.6,0 18 | 2010-01-17,139.8,2 19 | 2010-01-18,103.2,0 20 | 2010-01-19,140.1,2 21 | 2010-01-20,133.5,1 22 | 2010-01-21,131,1 23 | 2010-01-22,166.4,3 24 | 2010-01-23,108.5,0 25 | 2010-01-24,111.3,0 26 | 2010-01-25,124.9,1 27 | 2010-01-26,125.6,1 28 | 2010-01-27,102.4,0 29 | 2010-01-28,116.6,1 30 | 2010-01-29,109.9,0 31 | 2010-01-30,95.2,0 32 | 2010-01-31,130.9,2 33 | 2010-02-01,109.2,1 34 | 2010-02-02,164.2,4 35 | 2010-02-03,133.4,2 36 | 2010-02-04,147.2,2 37 | 2010-02-05,151.5,5 38 | 2010-02-06,140.6,2 39 | 2010-02-07,140,2 40 | 2010-02-08,141.2,1 41 | 2010-02-09,101,0 42 | 2010-02-10,159.8,4 43 | 2010-02-11,129.8,1 44 | 2010-02-12,150.7,2 45 | 2010-02-13,108.2,1 46 | 2010-02-14,155.9,4 47 | 2010-02-15,129.1,0 48 | 2010-02-16,137.7,4 49 | 2010-02-17,148.6,4 50 | 2010-02-18,141.9,3 51 | 2010-02-19,127,2 52 | 2010-02-20,128,1 53 | 2010-02-21,152.8,3 54 | 2010-02-22,171.3,4 55 | 2010-02-23,139.2,3 56 | 2010-02-24,152.4,3 57 | 2010-02-25,143.7,2 58 | 2010-02-26,129.6,1 59 | 2010-02-27,144.2,1 60 | 2010-02-28,150.4,4 61 | 2010-03-01,149.5,3 62 | 2010-03-02,157.9,3 63 | 2010-03-03,130,1 64 | 2010-03-04,143.3,5 65 | 2010-03-05,139.2,5 66 | 2010-03-06,123.3,2 67 | 2010-03-07,150.8,3 68 | 2010-03-08,125.8,1 69 | 2010-03-09,155.6,3 70 | 2010-03-10,158.9,4 71 | 2010-03-11,148.9,7 72 | 2010-03-12,145.1,2 73 | 2010-03-13,126.5,3 74 | 2010-03-14,125.1,2 75 | 2010-03-15,129.2,2 76 | 2010-03-16,150.5,5 77 | 2010-03-17,140,4 78 | 2010-03-18,132.5,2 79 | 2010-03-19,130.2,3 80 | 2010-03-20,126.8,2 81 | 2010-03-21,124.9,1 82 | 2010-03-22,132,5 83 | 2010-03-23,134.7,4 84 | 2010-03-24,139.2,3 85 | 2010-03-25,134.3,6 86 | 2010-03-26,130.5,5 87 | 2010-03-27,127.6,1 88 | 2010-03-28,136.8,0 89 | 2010-03-29,178,8 90 | 2010-03-30,140.3,2 91 | 2010-03-31,157.7,6 92 | 2010-04-01,104.5,1 93 | 2010-04-02,136.6,1 94 | 2010-04-03,132.5,3 95 | 2010-04-04,106,2 96 | 2010-04-05,108.1,2 97 | 2010-04-06,119.3,1 98 | 2010-04-07,131.9,4 99 | 2010-04-08,123.3,3 100 | 2010-04-09,109.4,0 101 | 2010-04-10,146.6,4 102 | -------------------------------------------------------------------------------- /book-data/5-4-time-varying-coef.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] ex; // 説明変数 4 | vector[T] y; // 観測値 5 | } 6 | 7 | parameters { 8 | vector[T] mu; // 水準成分の推定値 9 | vector[T] b; // 時変係数の推定値 10 | real s_w; // 水準成分の過程誤差の標準偏差 11 | real s_t; // 時変係数の変動の大きさを表す標準偏差 12 | real s_v; // 観測誤差の標準偏差 13 | } 14 | 15 | transformed parameters { 16 | vector[T] alpha; // 各成分の和として得られる状態推定値 17 | 18 | for(i in 1:T) { 19 | alpha[i] = mu[i] + b[i] * ex[i]; 20 | } 21 | 22 | } 23 | 24 | model { 25 | // 状態方程式に従い、状態が遷移する 26 | for(i in 2:T) { 27 | mu[i] ~ normal(mu[i-1], s_w); 28 | b[i] ~ normal(b[i-1], s_t); 29 | } 30 | 31 | // 観測方程式に従い、観測値が得られる 32 | for(i in 1:T) { 33 | y[i] ~ normal(alpha[i], s_v); 34 | } 35 | 36 | } 37 | -------------------------------------------------------------------------------- /book-data/5-4-時変係数モデル.R: -------------------------------------------------------------------------------- 1 | 2 | # 時変係数モデル｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(brms) 11 | library(bayesplot) 12 | library(ggfortify) 13 | library(gridExtra) 14 | 15 | # 計算の高速化 16 | rstan_options(auto_write = TRUE) 17 | options(mc.cores = parallel::detectCores()) 18 | 19 | # 状態空間モデルの図示をする関数の読み込み 20 | source("plotSSM.R", encoding="utf-8") 21 | 22 | 23 | # データの読み込みと図示------------------------------------------------------------- 24 | 25 | # データの読み込み 26 | sales_df_2 <- read.csv("5-4-1-sales-ts-2.csv") 27 | sales_df_2$date <- as.POSIXct(sales_df_2$date) 28 | head(sales_df_2, n = 3) 29 | 30 | # 図示 31 | autoplot(ts(sales_df_2[, -1])) 32 | 33 | 34 | # 普通の単回帰モデルの適用 ------------------------------------------------------------- 35 | 36 | mod_lm <- brm( 37 | formula = sales ~ publicity, 38 | family = gaussian(link = "identity"), 39 | data = sales_df_2, 40 | seed = 1 41 | ) 42 | 43 | fixef(mod_lm) 44 | 45 | 46 | # 時点を分けた、2つの単回帰モデルの適用 -------------------------------------------------------------- 47 | 48 | # データの分割 49 | sales_df_2_head <- head(sales_df_2, n = 50) 50 | sales_df_2_tail <- tail(sales_df_2, n = 50) 51 | 52 | # 前半のモデル化 53 | mod_lm_head <- brm( 54 | formula = sales ~ publicity, 55 | family = gaussian(link = "identity"), 56 | data = sales_df_2_head, 57 | seed = 1 58 | ) 59 | 60 | # 後半のモデル化 61 | mod_lm_tail <- brm( 62 | formula = sales ~ publicity, 63 | family = gaussian(link = "identity"), 64 | data = sales_df_2_tail, 65 | seed = 1 66 | ) 67 | 68 | # 結果の出力 69 | # 前半 70 | fixef(mod_lm_head) 71 | # 後半 72 | fixef(mod_lm_tail) 73 | 74 | 75 | # 時変係数モデルの推定 ---------------------------------------------------------------------- 76 | 77 | # データの準備 78 | data_list <- list( 79 | y = sales_df_2$sales, 80 | ex = sales_df_2$publicity, 81 | T = nrow(sales_df_2) 82 | ) 83 | 84 | # モデルの推定 85 | time_varying_coef_stan <- stan( 86 | file = "5-4-time-varying-coef.stan", 87 | data = data_list, 88 | seed = 1, 89 | iter = 8000, 90 | warmup = 2000, 91 | thin = 6 92 | ) 93 | 94 | # 結果の表示 95 | print(time_varying_coef_stan, 96 | pars = c("s_w", "s_t", "s_v", "b[100]"), 97 | probs = c(0.025, 0.5, 0.975)) 98 | 99 | 100 | # 参考:収束の確認など 101 | mcmc_rhat(rhat(time_varying_coef_stan)) 102 | check_hmc_diagnostics(time_varying_coef_stan) 103 | 104 | # 参考:トレースなどのチェック 105 | mcmc_sample <- rstan::extract(time_varying_coef_stan, permuted = FALSE) 106 | mcmc_acf_bar(mcmc_sample, pars = c("s_w", "s_t", "s_v", "lp__")) 107 | mcmc_trace(mcmc_sample, pars = c("s_w", "s_t", "s_v", "lp__")) 108 | 109 | # 参考:すべての推定値を出力 110 | options(max.print=100000) 111 | print(time_varying_coef_stan, probs = c(0.025, 0.5, 0.975)) 112 | 113 | 114 | # 推定された状態の図示 -------------------------------------------------------------- 115 | 116 | # MCMCサンプルの取得 117 | mcmc_sample <- rstan::extract(time_varying_coef_stan) 118 | 119 | # 図示 120 | p_all <- plotSSM(mcmc_sample = mcmc_sample, 121 | time_vec = sales_df_2$date, 122 | obs_vec = sales_df_2$sales, 123 | state_name = "alpha", 124 | graph_title = "推定結果:状態", 125 | y_label = "sales") 126 | 127 | p_mu <- plotSSM(mcmc_sample = mcmc_sample, 128 | time_vec = sales_df_2$date, 129 | obs_vec = sales_df_2$sales, 130 | state_name = "mu", 131 | graph_title = "推定結果:集客効果を除いた", 132 | y_label = "sales") 133 | 134 | p_b <- plotSSM(mcmc_sample = mcmc_sample, 135 | time_vec = sales_df_2$date, 136 | state_name = "b", 137 | graph_title = "推定結果:集客効果の変遷", 138 | y_label = "coef") 139 | 140 | grid.arrange(p_all, p_mu, p_b) 141 | 142 | 143 | -------------------------------------------------------------------------------- /book-data/5-5-1-sales-ts-3.csv: -------------------------------------------------------------------------------- 1 | date,sales 2 | 2010-01-01,93.5 3 | 2010-01-02,81.9 4 | 2010-01-03,91 5 | 2010-01-04,91.2 6 | 2010-01-05,102.5 7 | 2010-01-06,92.7 8 | 2010-01-07,107 9 | 2010-01-08,99.1 10 | 2010-01-09,98.2 11 | 2010-01-10,118.4 12 | 2010-01-11,121.4 13 | 2010-01-12,122.6 14 | 2010-01-13,126.8 15 | 2010-01-14,103.3 16 | 2010-01-15,119.6 17 | 2010-01-16,104.6 18 | 2010-01-17,119.3 19 | 2010-01-18,115.7 20 | 2010-01-19,121.8 21 | 2010-01-20,132.5 22 | 2010-01-21,130 23 | 2010-01-22,135.5 24 | 2010-01-23,131.6 25 | 2010-01-24,135.2 26 | 2010-01-25,137 27 | 2010-01-26,138.2 28 | 2010-01-27,134.8 29 | 2010-01-28,133.4 30 | 2010-01-29,145.7 31 | 2010-01-30,136.3 32 | 2010-01-31,149.2 33 | 2010-02-01,140.6 34 | 2010-02-02,151.9 35 | 2010-02-03,149.2 36 | 2010-02-04,164 37 | 2010-02-05,139.4 38 | 2010-02-06,163 39 | 2010-02-07,161.4 40 | 2010-02-08,173.6 41 | 2010-02-09,151.4 42 | 2010-02-10,166.8 43 | 2010-02-11,166.6 44 | 2010-02-12,175.4 45 | 2010-02-13,150.6 46 | 2010-02-14,172.5 47 | 2010-02-15,176.7 48 | 2010-02-16,160.4 49 | 2010-02-17,165.5 50 | 2010-02-18,166.3 51 | 2010-02-19,161.5 52 | 2010-02-20,166 53 | 2010-02-21,167.6 54 | 2010-02-22,177.6 55 | 2010-02-23,159.5 56 | 2010-02-24,172.6 57 | 2010-02-25,172.6 58 | 2010-02-26,168.5 59 | 2010-02-27,177.5 60 | 2010-02-28,165.9 61 | 2010-03-01,172.2 62 | 2010-03-02,185 63 | 2010-03-03,174.2 64 | 2010-03-04,163.6 65 | 2010-03-05,159.9 66 | 2010-03-06,162.3 67 | 2010-03-07,182.8 68 | 2010-03-08,169.2 69 | 2010-03-09,185.8 70 | 2010-03-10,183.9 71 | 2010-03-11,167.5 72 | 2010-03-12,181.6 73 | 2010-03-13,157 74 | 2010-03-14,162.9 75 | 2010-03-15,167 76 | 2010-03-16,171.1 77 | 2010-03-17,166.9 78 | 2010-03-18,165.5 79 | 2010-03-19,160.2 80 | 2010-03-20,161 81 | 2010-03-21,162.9 82 | 2010-03-22,156.5 83 | 2010-03-23,161.7 84 | 2010-03-24,165.1 85 | 2010-03-25,146.5 86 | 2010-03-26,150.7 87 | 2010-03-27,159.1 88 | 2010-03-28,169.7 89 | 2010-03-29,175.2 90 | 2010-03-30,163.8 91 | 2010-03-31,160.4 92 | 2010-04-01,135.8 93 | 2010-04-02,164.7 94 | 2010-04-03,151.6 95 | 2010-04-04,137 96 | 2010-04-05,140.4 97 | 2010-04-06,153.9 98 | 2010-04-07,151.1 99 | 2010-04-08,140 100 | 2010-04-09,147.1 101 | 2010-04-10,159.3 102 | -------------------------------------------------------------------------------- /book-data/5-5-1-smooth-trend.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | } 5 | 6 | parameters { 7 | vector[T] mu; // 水準+ドリフト成分の推定値 8 | real s_z; // ドリフト成分の変動の大きさを表す標準偏差 9 | real s_v; // 観測誤差の標準偏差 10 | } 11 | 12 | model { 13 | // 状態方程式に従い、状態が遷移する 14 | for(i in 3:T) { 15 | mu[i] ~ normal(2 * mu[i-1] - mu[i-2], s_z); 16 | } 17 | 18 | // 観測方程式に従い、観測値が得られる 19 | for(i in 1:T) { 20 | y[i] ~ normal(mu[i], s_v); 21 | } 22 | 23 | } 24 | -------------------------------------------------------------------------------- /book-data/5-5-2-local-linear-trend.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | } 5 | 6 | parameters { 7 | vector[T] mu; // 水準+ドリフト成分の推定値 8 | vector[T] delta; // ドリフト成分の推定値 9 | real s_w; // 水準成分の変動の大きさを表す標準偏差 10 | real s_z; // ドリフト成分の変動の大きさを表す標準偏差 11 | real s_v; // 観測誤差の標準偏差 12 | } 13 | 14 | model { 15 | // 弱情報事前分布 16 | s_w ~ normal(2, 2); 17 | s_z ~ normal(0.5, 0.5); 18 | s_v ~ normal(10, 5); 19 | 20 | // 状態方程式に従い、状態が遷移する 21 | for(i in 2:T) { 22 | mu[i] ~ normal(mu[i-1] + delta[i-1], s_w); 23 | delta[i] ~ normal(delta[i-1], s_z); 24 | } 25 | 26 | // 観測方程式に従い、観測値が得られる 27 | for(i in 1:T) { 28 | y[i] ~ normal(mu[i], s_v); 29 | } 30 | 31 | } 32 | -------------------------------------------------------------------------------- /book-data/5-5-トレンドの構造.R: -------------------------------------------------------------------------------- 1 | 2 | # トレンドの構造｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(ggfortify) 12 | library(gridExtra) 13 | 14 | # 計算の高速化 15 | rstan_options(auto_write = TRUE) 16 | options(mc.cores = parallel::detectCores()) 17 | 18 | # 状態空間モデルの図示をする関数の読み込み 19 | source("plotSSM.R", encoding="utf-8") 20 | 21 | 22 | ## データの読み込みと図示 23 | 24 | # データの読み込み 25 | sales_df_3 <- read.csv("5-5-1-sales-ts-3.csv") 26 | sales_df_3$date <- as.POSIXct(sales_df_3$date) 27 | head(sales_df_3, n = 3) 28 | 29 | # 図示 30 | autoplot(ts(sales_df_3[, -1])) 31 | 32 | 33 | # ローカルレベルモデルの推定 ----------------------------------------------------------- 34 | 35 | # データの準備 36 | data_list <- list( 37 | y = sales_df_3$sales, 38 | T = nrow(sales_df_3) 39 | ) 40 | 41 | # ローカルレベルモデルの推定 42 | local_level <- stan( 43 | file = "5-2-1-local-level.stan", 44 | data = data_list, 45 | seed = 1 46 | ) 47 | 48 | # ローカルレベルモデルの推定結果 49 | print(local_level, 50 | par = c("s_w", "s_v", "lp__"), 51 | probs = c(0.025, 0.5, 0.975)) 52 | 53 | 54 | # 平滑化トレンドモデルの推定 ---------------------------------------------------------------------- 55 | 56 | 57 | # 平滑化トレンドモデルの推定 58 | smooth_trend <- stan( 59 | file = "5-5-1-smooth-trend.stan", 60 | data = data_list, 61 | seed = 1, 62 | iter = 8000, 63 | warmup = 2000, 64 | thin = 6, 65 | control = list(adapt_delta = 0.9, max_treedepth = 15) 66 | ) 67 | 68 | # 平滑化トレンドモデルの推定結果 69 | print(smooth_trend, 70 | par = c("s_z", "s_v", "lp__"), 71 | probs = c(0.025, 0.5, 0.975)) 72 | 73 | 74 | 75 | # ローカル線形トレンドモデルの推定 -------------------------------------------------------- 76 | 77 | # ローカル線形トレンドモデルの推定 78 | local_linear_trend <- stan( 79 | file = "5-5-2-local-linear-trend.stan", 80 | data = data_list, 81 | seed = 1, 82 | iter = 8000, 83 | warmup = 2000, 84 | thin = 6 85 | ) 86 | 87 | # ローカル線形トレンドモデルの推定結果 88 | print(local_linear_trend, 89 | par = c("s_w", "s_z", "s_v", "lp__"), 90 | probs = c(0.025, 0.5, 0.975)) 91 | 92 | 93 | 94 | # 参考：収束の確認など 95 | mcmc_rhat(rhat(local_level)) 96 | mcmc_rhat(rhat(smooth_trend)) 97 | mcmc_rhat(rhat(local_linear_trend)) 98 | 99 | check_hmc_diagnostics(local_level) 100 | check_hmc_diagnostics(smooth_trend) 101 | check_hmc_diagnostics(local_linear_trend) 102 | 103 | # 参考：推定結果一覧 104 | options(max.print=100000) 105 | print(local_level, probs = c(0.025, 0.5, 0.975)) 106 | print(smooth_trend, probs = c(0.025, 0.5, 0.975)) 107 | print(local_linear_trend, probs = c(0.025, 0.5, 0.975)) 108 | 109 | # 参考：トレースプロット 110 | mcmc_sample_1 <- rstan::extract(local_level, permuted = FALSE) 111 | mcmc_sample_2 <- rstan::extract(smooth_trend, permuted = FALSE) 112 | mcmc_sample_3 <- rstan::extract(local_linear_trend, permuted = FALSE) 113 | mcmc_trace(mcmc_sample_1, pars = c("s_w", "s_v", "lp__")) 114 | mcmc_trace(mcmc_sample_2, pars = c("s_z", "s_v", "lp__")) 115 | mcmc_trace(mcmc_sample_3, pars = c("s_w", "s_z", "s_v", "lp__")) 116 | 117 | 118 | # 推定された状態の図示 ----------------------------------------------------------------- 119 | 120 | # MCMCサンプルの取得 121 | mcmc_sample_ll <- rstan::extract(local_level) 122 | mcmc_sample_st <- rstan::extract(smooth_trend) 123 | mcmc_sample_llt <- rstan::extract(local_linear_trend) 124 | 125 | # ローカルレベルモデル 126 | p_ll <- plotSSM(mcmc_sample = mcmc_sample_ll, 127 | time_vec = sales_df_3$date, 128 | obs_vec = sales_df_3$sales, 129 | state_name = "mu", 130 | graph_title = "ローカルレベルモデル", 131 | y_label = "sales") 132 | 133 | # 平滑化トレンドモデル 134 | p_st <- plotSSM(mcmc_sample = mcmc_sample_st, 135 | time_vec = sales_df_3$date, 136 | obs_vec = sales_df_3$sales, 137 | state_name = "mu", 138 | graph_title = "平滑化トレンドモデル", 139 | y_label = "sales") 140 | 141 | # ローカル線形トレンドモデル 142 | p_llt <- plotSSM(mcmc_sample = mcmc_sample_llt, 143 | time_vec = sales_df_3$date, 144 | obs_vec = sales_df_3$sales, 145 | state_name = "mu", 146 | graph_title = "ローカル線形トレンドモデル", 147 | y_label = "sales") 148 | 149 | grid.arrange(p_ll, p_st, p_llt) 150 | 151 | 152 | # ドリフト成分の図示 153 | plotSSM(mcmc_sample = mcmc_sample_llt, 154 | time_vec = sales_df_3$date, 155 | state_name = "delta", 156 | graph_title = "ドリフト成分", 157 | y_label = "delta") 158 | 159 | 160 | 161 | -------------------------------------------------------------------------------- /book-data/5-6-1-basic-structual-time-series.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | } 5 | 6 | parameters { 7 | vector[T] mu; // 水準+ドリフト成分の推定値 8 | vector[T] gamma; // 季節成分の推定値 9 | real s_z; // ドリフト成分の変動の大きさを表す標準偏差 10 | real s_v; // 観測誤差の標準偏差 11 | real s_s; // 季節変動の大きさを表す標準偏差 12 | } 13 | 14 | transformed parameters { 15 | vector[T] alpha; // 各成分の和として得られる状態推定値 16 | 17 | for(i in 1:T) { 18 | alpha[i] = mu[i] + gamma[i]; 19 | } 20 | 21 | } 22 | 23 | model { 24 | // 水準+ドリフト成分 25 | for(i in 3:T) { 26 | mu[i] ~ normal(2 * mu[i-1] - mu[i-2], s_z); 27 | } 28 | 29 | // 季節成分 30 | for(i in 7:T){ 31 | gamma[i] ~ normal(-sum(gamma[(i-6):(i-1)]), s_s); 32 | } 33 | 34 | // 観測方程式に従い、観測値が得られる 35 | for(i in 1:T) { 36 | y[i] ~ normal(alpha[i], s_v); 37 | } 38 | 39 | } 40 | -------------------------------------------------------------------------------- /book-data/5-6-1-sales-ts-4.csv: -------------------------------------------------------------------------------- 1 | date,sales 2 | 2010-01-01,81.1 3 | 2010-01-02,127.7 4 | 2010-01-03,119.5 5 | 2010-01-04,55.8 6 | 2010-01-05,71.1 7 | 2010-01-06,83.8 8 | 2010-01-07,92.5 9 | 2010-01-08,79.3 10 | 2010-01-09,132.9 11 | 2010-01-10,126 12 | 2010-01-11,72.8 13 | 2010-01-12,68 14 | 2010-01-13,86.6 15 | 2010-01-14,109.2 16 | 2010-01-15,97.4 17 | 2010-01-16,147.4 18 | 2010-01-17,156.1 19 | 2010-01-18,87.9 20 | 2010-01-19,79.3 21 | 2010-01-20,94.2 22 | 2010-01-21,139 23 | 2010-01-22,113.6 24 | 2010-01-23,170.2 25 | 2010-01-24,175.9 26 | 2010-01-25,121.3 27 | 2010-01-26,112.9 28 | 2010-01-27,107.9 29 | 2010-01-28,136.9 30 | 2010-01-29,148.9 31 | 2010-01-30,176.5 32 | 2010-01-31,188 33 | 2010-02-01,121.1 34 | 2010-02-02,121.9 35 | 2010-02-03,121.8 36 | 2010-02-04,171 37 | 2010-02-05,171.9 38 | 2010-02-06,199.4 39 | 2010-02-07,203.4 40 | 2010-02-08,146 41 | 2010-02-09,134.8 42 | 2010-02-10,159.5 43 | 2010-02-11,197.1 44 | 2010-02-12,168.2 45 | 2010-02-13,221.2 46 | 2010-02-14,222 47 | 2010-02-15,144.4 48 | 2010-02-16,167.2 49 | 2010-02-17,172.4 50 | 2010-02-18,220.2 51 | 2010-02-19,177.3 52 | 2010-02-20,249.5 53 | 2010-02-21,249 54 | 2010-02-22,175.4 55 | 2010-02-23,164.5 56 | 2010-02-24,182.6 57 | 2010-02-25,224.6 58 | 2010-02-26,209.1 59 | 2010-02-27,267.9 60 | 2010-02-28,264.6 61 | 2010-03-01,185.3 62 | 2010-03-02,166.6 63 | 2010-03-03,192.8 64 | 2010-03-04,244 65 | 2010-03-05,205.5 66 | 2010-03-06,256.6 67 | 2010-03-07,277.4 68 | 2010-03-08,194.2 69 | 2010-03-09,195.5 70 | 2010-03-10,205.6 71 | 2010-03-11,253.3 72 | 2010-03-12,215.4 73 | 2010-03-13,266.1 74 | 2010-03-14,298.5 75 | 2010-03-15,215.2 76 | 2010-03-16,207.5 77 | 2010-03-17,176 78 | 2010-03-18,256.9 79 | 2010-03-19,231.1 80 | 2010-03-20,281.6 81 | 2010-03-21,304.1 82 | 2010-03-22,218.6 83 | 2010-03-23,219.3 84 | 2010-03-24,194.6 85 | 2010-03-25,277.4 86 | 2010-03-26,252.6 87 | 2010-03-27,290.1 88 | 2010-03-28,300 89 | 2010-03-29,233.7 90 | 2010-03-30,235.7 91 | 2010-03-31,200.6 92 | 2010-04-01,278.1 93 | 2010-04-02,243.1 94 | 2010-04-03,292.5 95 | 2010-04-04,323.8 96 | 2010-04-05,230.3 97 | 2010-04-06,249 98 | 2010-04-07,199.9 99 | 2010-04-08,264.9 100 | 2010-04-09,258.5 101 | 2010-04-10,294.5 102 | -------------------------------------------------------------------------------- /book-data/5-6-周期性のモデル化.R: -------------------------------------------------------------------------------- 1 | 2 | # 周期性のモデル化｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(ggfortify) 12 | library(gridExtra) 13 | 14 | # 計算の高速化 15 | rstan_options(auto_write = TRUE) 16 | options(mc.cores = parallel::detectCores()) 17 | 18 | # 状態空間モデルの図示をする関数の読み込み 19 | source("plotSSM.R", encoding="utf-8") 20 | 21 | 22 | ## データの読み込みと図示 23 | 24 | # データの読み込み 25 | sales_df_4 <- read.csv("5-6-1-sales-ts-4.csv") 26 | sales_df_4$date <- as.POSIXct(sales_df_4$date) 27 | head(sales_df_4, n = 3) 28 | 29 | # 図示 30 | autoplot(ts(sales_df_4[, -1])) 31 | 32 | 33 | # 基本構造時系列モデルの推定 -------------------------------------------------------- 34 | 35 | # データの準備 36 | data_list <- list( 37 | y = sales_df_4$sales, 38 | T = nrow(sales_df_4) 39 | ) 40 | 41 | # 基本構造時系列モデルの推定 42 | basic_structual <- stan( 43 | file = "5-6-1-basic-structual-time-series.stan", 44 | data = data_list, 45 | seed = 1, 46 | iter = 8000, 47 | warmup = 2000, 48 | thin = 6, 49 | control = list(adapt_delta = 0.97, max_treedepth = 15) 50 | ) 51 | 52 | # 基本構造時系列モデルの推定結果 53 | print(basic_structual, 54 | par = c("s_z", "s_s", "s_v", "lp__"), 55 | probs = c(0.025, 0.5, 0.975)) 56 | 57 | 58 | # 参考：収束の確認 59 | mcmc_rhat(rhat(basic_structual)) 60 | check_hmc_diagnostics(basic_structual) 61 | 62 | # 参考:トレースプロット 63 | mcmc_sample <- rstan::extract(basic_structual, permuted = FALSE) 64 | mcmc_trace(mcmc_sample, pars = c("s_z", "s_s", "s_v", "lp__")) 65 | 66 | # 参考：推定結果一覧 67 | options(max.print=100000) 68 | print(basic_structual, probs = c(0.025, 0.5, 0.975)) 69 | 70 | 71 | # 推定結果の図示 ----------------------------------------------------------------- 72 | 73 | # MCMCサンプルの取得 74 | mcmc_sample <- rstan::extract(basic_structual) 75 | 76 | # すべての成分を含んだ状態推定値の図示 77 | p_all <- plotSSM(mcmc_sample = mcmc_sample, 78 | time_vec = sales_df_4$date, 79 | obs_vec = sales_df_4$sales, 80 | state_name = "alpha", 81 | graph_title = "すべての成分を含んだ状態推定値", 82 | y_label = "sales") 83 | 84 | # 周期成分を除いた状態推定値の図示 85 | p_trend <- plotSSM(mcmc_sample = mcmc_sample, 86 | time_vec = sales_df_4$date, 87 | obs_vec = sales_df_4$sales, 88 | state_name = "mu", 89 | graph_title = "周期成分を除いた状態推定値", 90 | y_label = "sales") 91 | 92 | # 周期成分の図示 93 | p_cycle <- plotSSM(mcmc_sample = mcmc_sample, 94 | time_vec = sales_df_4$date, 95 | state_name = "gamma", 96 | graph_title = "周期成分", 97 | y_label = "gamma") 98 | 99 | grid.arrange(p_all, p_trend, p_cycle) 100 | 101 | -------------------------------------------------------------------------------- /book-data/5-7-1-autoregressive.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] y; // 観測値 4 | } 5 | 6 | parameters { 7 | real s_w; // 過程誤差の標準偏差 8 | real b_ar; // 自己回帰項の係数 9 | real Intercept; // 切片 10 | } 11 | 12 | model { 13 | for(i in 2:T) { 14 | y[i] ~ normal(Intercept + y[i-1]*b_ar, s_w); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /book-data/5-7-1-sales-ts-5.csv: -------------------------------------------------------------------------------- 1 | date,sales 2 | 2010-01-01,91 3 | 2010-01-02,96.5 4 | 2010-01-03,113.8 5 | 2010-01-04,97 6 | 2010-01-05,97.4 7 | 2010-01-06,99.7 8 | 2010-01-07,106.9 9 | 2010-01-08,101.8 10 | 2010-01-09,120.9 11 | 2010-01-10,111.2 12 | 2010-01-11,110.9 13 | 2010-01-12,116.3 14 | 2010-01-13,105.9 15 | 2010-01-14,93.1 16 | 2010-01-15,113.7 17 | 2010-01-16,85.1 18 | 2010-01-17,99.9 19 | 2010-01-18,100.3 20 | 2010-01-19,110.3 21 | 2010-01-20,110.5 22 | 2010-01-21,127.2 23 | 2010-01-22,104.3 24 | 2010-01-23,118.5 25 | 2010-01-24,130.6 26 | 2010-01-25,118.4 27 | 2010-01-26,86.5 28 | 2010-01-27,96.7 29 | 2010-01-28,92.1 30 | 2010-01-29,103.2 31 | 2010-01-30,104.8 32 | 2010-01-31,110.3 33 | 2010-02-01,109.3 34 | 2010-02-02,116.4 35 | 2010-02-03,107 36 | 2010-02-04,96.4 37 | 2010-02-05,91.9 38 | 2010-02-06,77.9 39 | 2010-02-07,77.7 40 | 2010-02-08,81 41 | 2010-02-09,86.2 42 | 2010-02-10,87.9 43 | 2010-02-11,73.1 44 | 2010-02-12,75.5 45 | 2010-02-13,104.3 46 | 2010-02-14,108.8 47 | 2010-02-15,125.2 48 | 2010-02-16,112.1 49 | 2010-02-17,106.3 50 | 2010-02-18,102 51 | 2010-02-19,89.2 52 | 2010-02-20,85.1 53 | 2010-02-21,111.7 54 | 2010-02-22,101.4 55 | 2010-02-23,113.6 56 | 2010-02-24,97.7 57 | 2010-02-25,79 58 | 2010-02-26,84.1 59 | 2010-02-27,99.8 60 | 2010-02-28,111.3 61 | 2010-03-01,123.5 62 | 2010-03-02,96.2 63 | 2010-03-03,118 64 | 2010-03-04,103.8 65 | 2010-03-05,103.9 66 | 2010-03-06,107.4 67 | 2010-03-07,96.2 68 | 2010-03-08,77.7 69 | 2010-03-09,81.9 70 | 2010-03-10,90 71 | 2010-03-11,85 72 | 2010-03-12,81.8 73 | 2010-03-13,92.4 74 | 2010-03-14,94 75 | 2010-03-15,100.8 76 | 2010-03-16,99.9 77 | 2010-03-17,90.9 78 | 2010-03-18,107.6 79 | 2010-03-19,112.3 80 | 2010-03-20,117.9 81 | 2010-03-21,96.6 82 | 2010-03-22,107.9 83 | 2010-03-23,87.8 84 | 2010-03-24,87.3 85 | 2010-03-25,78.7 86 | 2010-03-26,65.1 87 | 2010-03-27,97.3 88 | 2010-03-28,91.8 89 | 2010-03-29,92.3 90 | 2010-03-30,91.5 91 | 2010-03-31,98.8 92 | 2010-04-01,115.3 93 | 2010-04-02,126 94 | 2010-04-03,103.7 95 | 2010-04-04,88.7 96 | 2010-04-05,78.1 97 | 2010-04-06,74.3 98 | 2010-04-07,104.2 99 | 2010-04-08,102.6 100 | 2010-04-09,93.1 101 | 2010-04-10,89.9 102 | -------------------------------------------------------------------------------- /book-data/5-7-自己回帰モデルとその周辺.R: -------------------------------------------------------------------------------- 1 | 2 | # 自己回帰モデルとその周辺｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(ggfortify) 12 | 13 | # 計算の高速化 14 | rstan_options(auto_write = TRUE) 15 | options(mc.cores = parallel::detectCores()) 16 | 17 | 18 | ## データの読み込みと図示 19 | 20 | # データの読み込み 21 | sales_df_5 <- read.csv("5-7-1-sales-ts-5.csv") 22 | sales_df_5$date <- as.POSIXct(sales_df_5$date) 23 | head(sales_df_5, n = 3) 24 | 25 | # 図示 26 | autoplot(ts(sales_df_5[, -1])) 27 | 28 | 29 | # 自己回帰モデルの推定 -------------------------------------------------------- 30 | 31 | # データの準備 32 | data_list <- list( 33 | y = sales_df_5$sales, 34 | T = nrow(sales_df_5) 35 | ) 36 | 37 | # 自己回帰モデルの推定 38 | autoregressive <- stan( 39 | file = "5-7-1-autoregressive.stan", 40 | data = data_list, 41 | seed = 1, 42 | control = list(max_treedepth = 15) 43 | ) 44 | 45 | # 自己回帰モデルの推定結果 46 | print(autoregressive, 47 | par = c("s_w", "b_ar", "Intercept", "lp__"), 48 | probs = c(0.025, 0.5, 0.975)) 49 | 50 | 51 | # 参考：収束の確認 52 | mcmc_rhat(rhat(autoregressive)) 53 | check_hmc_diagnostics(autoregressive) 54 | 55 | # 参考:トレースプロット 56 | mcmc_sample <- rstan::extract(autoregressive, permuted = FALSE) 57 | mcmc_trace(mcmc_sample, pars = c("s_w", "b_ar", "Intercept", "lp__")) 58 | 59 | 60 | -------------------------------------------------------------------------------- /book-data/5-8-1-dglm-binom.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | int len_obs; // 観測値が得られた個数 4 | int y[len_obs]; // 観測値 5 | int obs_no[len_obs]; // 観測値が得られた時点 6 | } 7 | 8 | parameters { 9 | vector[T] mu; // 状態の推定値 10 | real s_w; // 過程誤差の標準偏差 11 | } 12 | 13 | model { 14 | // 弱情報事前分布 15 | s_w ~ student_t(3, 0, 10); 16 | 17 | // 状態方程式に従い、状態が遷移する 18 | for(i in 2:T) { 19 | mu[i] ~ normal(mu[i-1], s_w); 20 | } 21 | 22 | // 観測方程式に従い、観測値が得られる 23 | // ただし、「観測値が得られた時点」でのみ実行する 24 | for(i in 1:len_obs) { 25 | y[i] ~ bernoulli_logit(mu[obs_no[i]]); 26 | } 27 | } 28 | 29 | generated quantities{ 30 | vector[T] probs; // 推定された勝率 31 | 32 | probs = inv_logit(mu); 33 | } 34 | -------------------------------------------------------------------------------- /book-data/5-8-動的一般化線形モデル：二項分布を仮定した例.R: -------------------------------------------------------------------------------- 1 | 2 | # 動的一般化線形モデル：二項分布を仮定した例｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(KFAS) 12 | 13 | # 計算の高速化 14 | rstan_options(auto_write = TRUE) 15 | options(mc.cores = parallel::detectCores()) 16 | 17 | # 状態空間モデルの図示をする関数の読み込み 18 | source("plotSSM.R", encoding="utf-8") 19 | 20 | 21 | # データの読み込み 22 | data("boat") 23 | boat 24 | 25 | 26 | # 二項分布を仮定したDGLMの推定 -------------------------------------------------------- 27 | 28 | # 参考 29 | !is.na(boat) # データがあればTRUE 30 | which(!is.na(boat)) # データがある時点一覧 31 | 32 | # NAを除く 33 | boat_omit_NA <- na.omit(as.numeric(boat)) 34 | 35 | # データの準備 36 | data_list <- list( 37 | T = length(boat), 38 | len_obs = length(boat_omit_NA), 39 | y = boat_omit_NA, 40 | obs_no = which(!is.na(boat)) 41 | ) 42 | 43 | # モデルの推定 44 | dglm_binom <- stan( 45 | file = "5-8-1-dglm-binom.stan", 46 | data = data_list, 47 | seed = 1, 48 | iter = 30000, 49 | warmup = 10000, 50 | thin = 20 51 | ) 52 | 53 | # 推定されたパラメタ 54 | print(dglm_binom, 55 | par = c("s_w", "lp__"), 56 | probs = c(0.025, 0.5, 0.975)) 57 | 58 | 59 | # 参考：収束の確認 60 | mcmc_rhat(rhat(dglm_binom)) 61 | check_hmc_diagnostics(dglm_binom) 62 | 63 | # 参考:トレースプロット 64 | mcmc_sample <- rstan::extract(dglm_binom, permuted = FALSE) 65 | mcmc_trace(mcmc_sample, pars = c("s_w", "lp__")) 66 | 67 | # 参考：推定結果一覧 68 | options(max.print=100000) 69 | print(dglm_binom, probs = c(0.025, 0.5, 0.975)) 70 | 71 | # 推定された状態の図示 ----------------------------------------------------------------- 72 | 73 | # 時間ラベルの作成 74 | years <- seq(from = as.POSIXct("1829-01-01"), 75 | by = "1 year", 76 | len = length(boat)) 77 | head(years, n = 3) 78 | 79 | # MCMCサンプルの取得 80 | mcmc_sample <- rstan::extract(dglm_binom) 81 | 82 | # ケンブリッジ大学の勝率の推移のグラフ 83 | plotSSM(mcmc_sample = mcmc_sample, 84 | time_vec = years, 85 | obs_vec = as.numeric(boat), 86 | state_name = "probs", 87 | graph_title = "ケンブリッジ大学の勝率の推移", 88 | y_label = "勝率", 89 | date_labels = "%Y年") 90 | 91 | 92 | # ケンブリッジ大学の平均勝率 93 | mean(boat_omit_NA) 94 | 95 | 96 | -------------------------------------------------------------------------------- /book-data/5-9-1-dglm-poisson.stan: -------------------------------------------------------------------------------- 1 | data { 2 | int T; // データ取得期間の長さ 3 | vector[T] ex; // 説明変数 4 | int y[T]; // 観測値 5 | } 6 | 7 | parameters { 8 | vector[T] mu; // 水準+ドリフト成分の推定値 9 | vector[T] r; // ランダム効果 10 | real b; // 係数の推定値 11 | real s_z; // ドリフト成分の変動の大きさを表す標準偏差 12 | real s_r; // ランダム効果の標準偏差 13 | } 14 | 15 | transformed parameters { 16 | vector[T] lambda; // 観測値の期待値のlogをとった値 17 | 18 | for(i in 1:T) { 19 | lambda[i] = mu[i] + b * ex[i] + r[i]; 20 | } 21 | 22 | } 23 | 24 | model { 25 | // 時点ごとに加わるランダム効果 26 | r ~ normal(0, s_r); 27 | 28 | // 状態方程式に従い、状態が遷移する 29 | for(i in 3:T) { 30 | mu[i] ~ normal(2 * mu[i-1] - mu[i-2], s_z); 31 | } 32 | 33 | // 観測方程式に従い、観測値が得られる 34 | for(i in 1:T) { 35 | y[i] ~ poisson_log(lambda[i]); 36 | } 37 | 38 | } 39 | 40 | generated quantities { 41 | // 状態推定値（EXP） 42 | vector[T] lambda_exp; 43 | // ランダム効果除外の状態推定値 44 | vector[T] lambda_smooth; 45 | // ランダム効果除外、説明変数固定の状態推定値 46 | vector[T] lambda_smooth_fix; 47 | 48 | lambda_exp = exp(lambda); 49 | lambda_smooth = exp(mu + b * ex); 50 | lambda_smooth_fix = exp(mu + b * mean(ex)); 51 | } 52 | -------------------------------------------------------------------------------- /book-data/5-9-1-fish-num-ts.csv: -------------------------------------------------------------------------------- 1 | date,fish_num,temperature 2 | 2010-01-01,2,1.8 3 | 2010-01-02,1,7 4 | 2010-01-03,2,5.7 5 | 2010-01-04,2,1.7 6 | 2010-01-05,5,9.4 7 | 2010-01-06,3,9.4 8 | 2010-01-07,5,1.3 9 | 2010-01-08,2,8.3 10 | 2010-01-09,6,4.7 11 | 2010-01-10,13,5.5 12 | 2010-01-11,6,5.5 13 | 2010-01-12,8,2.4 14 | 2010-01-13,15,7.6 15 | 2010-01-14,10,1.8 16 | 2010-01-15,12,4.1 17 | 2010-01-16,14,8.5 18 | 2010-01-17,42,9.8 19 | 2010-01-18,15,2.3 20 | 2010-01-19,25,4.4 21 | 2010-01-20,23,0.7 22 | 2010-01-21,24,6.6 23 | 2010-01-22,18,3.9 24 | 2010-01-23,37,8.4 25 | 2010-01-24,24,1.5 26 | 2010-01-25,24,3.5 27 | 2010-01-26,27,4.9 28 | 2010-01-27,10,1.5 29 | 2010-01-28,21,3.6 30 | 2010-01-29,35,9.6 31 | 2010-01-30,14,1.3 32 | -------------------------------------------------------------------------------- /book-data/5-9-動的一般化線形モデル：ポアソン分布を仮定した例.R: -------------------------------------------------------------------------------- 1 | 2 | # 動的一般化線形モデル：ポアソン分布を仮定した例｜RとStanではじめる ベイズ統計モデリングによるデータ分析入門 3 | # 馬場真哉 4 | 5 | 6 | # 分析の準備 ------------------------------------------------------------------- 7 | 8 | # パッケージの読み込み 9 | library(rstan) 10 | library(bayesplot) 11 | library(ggfortify) 12 | library(gridExtra) 13 | 14 | # 計算の高速化 15 | rstan_options(auto_write = TRUE) 16 | options(mc.cores = parallel::detectCores()) 17 | 18 | # 状態空間モデルの図示をする関数の読み込み 19 | source("plotSSM.R", encoding="utf-8") 20 | 21 | 22 | 23 | # データの読み込み 24 | fish_ts <- read.csv("5-9-1-fish-num-ts.csv") 25 | fish_ts$date <- as.POSIXct(fish_ts$date) 26 | head(fish_ts, n = 3) 27 | 28 | # 図示 29 | autoplot(ts(fish_ts[, -1])) 30 | 31 | 32 | # モデルの推定 -------------------------------------------------------- 33 | 34 | # データの準備 35 | data_list <- list( 36 | y = fish_ts$fish_num, 37 | ex = fish_ts$temperature, 38 | T = nrow(fish_ts) 39 | ) 40 | 41 | # モデルの推定 42 | dglm_poisson <- stan( 43 | file = "5-9-1-dglm-poisson.stan", 44 | data = data_list, 45 | seed = 1, 46 | iter = 8000, 47 | warmup = 2000, 48 | thin = 6, 49 | control = list(adapt_delta = 0.99, max_treedepth = 15) 50 | ) 51 | 52 | 53 | # 推定されたパラメタ 54 | print(dglm_poisson, 55 | par = c("s_z", "s_r", "b", "lp__"), 56 | probs = c(0.025, 0.5, 0.975)) 57 | 58 | 59 | # 参考：収束の確認 60 | mcmc_rhat(rhat(dglm_poisson)) 61 | check_hmc_diagnostics(dglm_poisson) 62 | 63 | # 参考:トレースプロット 64 | mcmc_sample <- rstan::extract(dglm_poisson, permuted = FALSE) 65 | mcmc_trace(mcmc_sample, pars = c("s_z", "s_r", "lp__")) 66 | 67 | # 参考：推定結果一覧 68 | options(max.print=100000) 69 | print(dglm_poisson, probs = c(0.025, 0.5, 0.975)) 70 | 71 | 72 | # 推定結果の図示 ----------------------------------------------------------------- 73 | 74 | # MCMCサンプルの取得 75 | mcmc_sample <- rstan::extract(dglm_poisson) 76 | 77 | # 個別のグラフの作成 78 | p_all <- plotSSM(mcmc_sample = mcmc_sample, 79 | time_vec = fish_ts$date, 80 | obs_vec = fish_ts$fish_num, 81 | state_name = "lambda_exp", 82 | graph_title = "状態推定値", 83 | y_label = "釣獲尾数", 84 | date_labels = "%Y年%m月%d日") 85 | 86 | p_smooth <- plotSSM(mcmc_sample = mcmc_sample, 87 | time_vec = fish_ts$date, 88 | obs_vec = fish_ts$fish_num, 89 | state_name = "lambda_smooth", 90 | graph_title = "ランダム効果を除いた状態推定値", 91 | y_label = "釣獲尾数", 92 | date_labels = "%Y年%m月%d日") 93 | 94 | p_fix <- plotSSM(mcmc_sample = mcmc_sample, 95 | time_vec = fish_ts$date, 96 | obs_vec = fish_ts$fish_num, 97 | state_name = "lambda_smooth_fix", 98 | graph_title = "気温を固定した状態推定値", 99 | y_label = "釣獲尾数", 100 | date_labels = "%Y年%m月%d日") 101 | 102 | # まとめて図示 103 | grid.arrange(p_all, p_smooth, p_fix) 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /book-data/plotSSM.R: -------------------------------------------------------------------------------- 1 | plotSSM <- function(mcmc_sample, time_vec, obs_vec = NULL, 2 | state_name, graph_title, y_label, 3 | date_labels = "%Y年%m月"){ 4 | # 状態空間モデルを図示する関数 5 | # 6 | # Args: 7 | # mcmc_sample : MCMCサンプル 8 | # time_vec : 時間軸(POSIXct)のベクトル 9 | # obs_vec : (必要なら)観測値のベクトル 10 | # state_name : 図示する状態の変数名 11 | # graph_title : グラフタイトル 12 | # y_label : y軸のラベル 13 | # date_labels : 日付の書式 14 | # 15 | # Returns: 16 | # ggplot2により生成されたグラフ 17 | 18 | # すべての時点の状態の、95%区間と中央値 19 | result_df <- data.frame(t(apply( 20 | X = mcmc_sample[[state_name]], 21 | MARGIN = 2, quantile, probs = c(0.025, 0.5, 0.975) 22 | ))) 23 | 24 | # 列名の変更 25 | colnames(result_df) <- c("lwr", "fit", "upr") 26 | 27 | # 時間軸の追加 28 | result_df$time <- time_vec 29 | 30 | # 観測値の追加 31 | if(!is.null(obs_vec)){ 32 | result_df$obs <- obs_vec 33 | } 34 | 35 | # 図示 36 | p <- ggplot(data = result_df, aes(x = time)) + 37 | labs(title = graph_title) + 38 | ylab(y_label) + 39 | geom_line(aes(y = fit), size = 1.2) + 40 | geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.3) + 41 | scale_x_datetime(date_labels = date_labels) 42 | 43 | # 観測値をグラフに追加 44 | if(!is.null(obs_vec)){ 45 | p <- p + geom_point(alpha = 0.6, size = 0.9, 46 | data = result_df, aes(x = time, y = obs)) 47 | } 48 | 49 | # グラフを返す 50 | return(p) 51 | } --------------------------------------------------------------------------------