-
Notifications
You must be signed in to change notification settings - Fork 2
/
Lesson4.R
141 lines (124 loc) · 3.94 KB
/
Lesson4.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#########################################
#
# 行動計量学会第19回春の合宿セミナー
# サンプルスクリプト
# Lesson 4 ベイジアンモデリングの実際
#
# (c) Koij Kosugi(@kosugitti)
#
#########################################
# ひとつのデータの例
set.seed(12345)
N <- 100
mu <- 170
sig <- 10
Y <- rnorm(N,mu,sig)
mean(Y)
sd(Y)
library(rstan)
rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())
model1 <- stan_model("model1.stan",model_name="single Norm")
datastan <- list(N=N,Y=Y)
fit1 <- sampling(model1,data=datastan,iter=3000,warmup=1000,chains=2)
print(fit1)
stan_hist(fit1,pars="mu",bins=50)
stan_hist(fit1,pars="sig")
# データを増やしてみる
N <- 1000
mu <- 170
sig <- 10
Y <- rnorm(N,mu,sig)
mean(Y)
sd(Y)
datastan <- list(N=N,Y=Y)
fit1.2 <- sampling(model1,data=datastan,iter=3000,warmup=1000,chains=2)
print(fit1.2)
# 実際のデータでやってみる
baseball <- read.csv("baseball.csv",fileEncoding = "utf-8")
datastan <- list(N=nrow(baseball),Y=baseball$height)
fit1.3 <- sampling(model1,data=datastan)
print(fit1.3)
# 事前分布の指定
datastan <- list(N=nrow(baseball),Y=baseball$height)
model2 <- stan_model("model2.stan",model_name="single Norm with Prior")
fit2 <- sampling(model2,data=datastan)
print(fit2)
# 事後予測分布の生成
datastan <- list(N=nrow(baseball),Y=baseball$height)
model3 <- stan_model("model3.stan",model_name="single Norm and PPD")
fit3 <- sampling(model3,data=datastan)
# モデルから生成されたデータを抜き出す
predY <- extract(fit3,pars="predY")$predY
# 描画
library(ggplot2)
# 実データと抜きだした生成データを結合
value <- c(baseball$height,predY)
# 実データと生成データを区別する変数を作る
ID <- c(rep(1,length(baseball$height)),rep(2,length(predY)))
# あわせてデータフレームに
plotData <- data.frame(cbind(ID,value))
# 識別変数をfactor型に
plotData$ID <- factor(plotData$ID,labels=c("observed","predicted"))
# plot
g <- ggplot(data=plotData,aes(x=value,group=ID,fill=ID))
g <- g + geom_density(alpha=0.5,position="identity")
g
# WAICの計算
datastan <- list(N=nrow(baseball),Y=baseball$height)
model3b <- stan_model("model3b.stan",model_name="single Norm and PPD/Log_lik")
fit3 <- sampling(model3b,data=datastan)
# モデルから生成されたデータを抜き出す
logLik <- extract(fit3,pars="log_lik")$log_lik
# looパッケージで計算してもらう
library(loo)
waic(logLik)
loo(logLik)
########################### 二群の平均値の差を比べる
# 仮想データ
N <- 100
muA <- 20
muB <- 30
sigA <- 10
sigB <- 20
X1 <- rnorm(N,muA,sigA)
X2 <- rnorm(N,muB,sigB)
t.test(X1,X2)
model4 <- stan_model("model4.stan",model_name="Two groups")
datastan <- list(N=N,X1=X1,X2=X2)
fit4 <- sampling(model4,datastan)
print(fit4)
# サンプルサイズの違いに対応
# 等分散モデル
N1 <- 100
N2 <- 200
muA <- 20
muB <- 30
sig <- 10
X1 <- rnorm(N1,muA,sig)
X2 <- rnorm(N2,muB,sig)
t.test(X1,X2)
model4b <- stan_model("model4b.stan",model_name="Two groups model2")
datastan <- list(N1=N1,N2=N2,X1=X1,X2=X2)
fit4b <- sampling(model4b,datastan)
print(fit4b)
# 実際のデータでやってみる
baseball <- read.csv("baseball.csv",fileEncoding = "utf-8")
# セ・パを判別する
Central <- c("巨人","阪神","広島","ヤクルト","中日","DeNA")
# match関数で判断させる
baseball$CP <- ifelse(is.na(match(baseball$team,Central)),2,1)
# セリーグのデータ
X1 <- baseball$height[baseball$CP==1]
X2 <- baseball$height[baseball$CP==2]
t.test(X1,X2)
model4c <- stan_model("model4c.stan",model_name="Two groups unbalanced data")
datastan <- list(N1=length(X1),N2=length(X2),X1=X1,X2=X2)
fit4c <- sampling(model4c,datastan)
print(fit4c)
# 積極的な仮説検証
model4d <- stan_model("model4d.stan",model_name="Over the NHST")
datastan <- list(N1=length(X1),N2=length(X2),X1=X1,X2=X2)
fit4d <- sampling(model4d,datastan)
print(fit4d)
stan_plot(fit4d,pars="diff")