forked from luisdamiano/gsoc17-hhmm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsim-fine1998.R
153 lines (127 loc) · 3.72 KB
/
sim-fine1998.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
142
143
144
145
146
147
148
149
150
151
152
153
source('hhmm/R/hhmm-sim.R')
# Fine (1998) Fig. 1 ------------------------------------------------------
r <- root_node(
pi_d = c(0.5, 0.5, 0.0),
A_d = matrix(c(0.0, 1.0, 0.0,
0.7, 0.0, 0.3,
0.0, 0.0, 1.0),
nrow = 3, ncol = 3,
byrow = TRUE))
q21 <- internal_node(
d = 2, i = 1,
pi_d = c(1, 0),
A_d = matrix(c(0.0, 1.0,
0.0, 1.0),
nrow = 2, ncol = 2,
byrow = TRUE))
p21 <- production_node(
d = 2, i = 1,
obs.mod = obsmodel_gaussian,
obs.par = list(mu = 21, sigma = 1))
p21e<- end_node(
d = 2, i = 2)
q22 <- internal_node(
d = 2, i = 2,
pi_d = c(0.9, 0.1, 0),
A_d = matrix(c(0.0, 1.0, 0.0,
0.0, 0.7, 0.3,
0.0, 0.0, 1.0),
nrow = 3, ncol = 3,
byrow = TRUE))
q2e <- end_node(
d = 2, i = 3)
q31 <- internal_node(
d = 3, i = 1,
pi_d = c(0.5, 0.3, 0.2, 0.0),
A_d = matrix(c(0.0, 0.6, 0.4, 0.0,
0.0, 0.0, 0.8, 0.2,
0.0, 0.0, 0.0, 1.0,
0.0, 0.0, 0.0, 1.0),
nrow = 4, ncol = 4,
byrow = TRUE))
q32 <- internal_node(
d = 3, i = 3,
pi_d = c(1.0, 0.0),
A_d = matrix(c(0.0, 1.0,
0.0, 1.0),
nrow = 2, ncol = 2,
byrow = TRUE))
p32 <- production_node(
d = 3, i = 1,
obs.mod = obsmodel_gaussian,
obs.par = list(mu = 32, sigma = 1))
p32e<- end_node(
d = 3, i = 2)
q3e <- end_node(
d = 3, i = 2)
q41 <- internal_node(
d = 4, i = 1,
pi_d = c(1.0, 0.0),
A_d = matrix(c(0.0, 1.0,
0.0, 1.0),
nrow = 2, ncol = 2,
byrow = TRUE))
p41 <- production_node(
d = 4, i = 1,
obs.mod = obsmodel_gaussian,
obs.par = list(mu = 41, sigma = 1))
p41e<- end_node(
d = 4, i = 2)
q42 <- internal_node(
d = 4, i = 2,
pi_d = c(1.0, 0.0),
A_d = matrix(c(0.0, 1.0,
0.0, 1.0),
nrow = 2, ncol = 2,
byrow = TRUE))
p42 <- production_node(
d = 4, i = 2,
obs.mod = obsmodel_gaussian,
obs.par = list(mu = 42, sigma = 1))
p42e<- end_node(
d = 4, i = 2)
q43 <- internal_node(
d = 4, i = 3,
pi_d = c(1.0, 0.0),
A_d = matrix(c(0.0, 1.0,
0.0, 1.0),
nrow = 2, ncol = 2,
byrow = TRUE))
p43 <- production_node(
d = 4, i = 3,
obs.mod = obsmodel_gaussian,
obs.par = list(mu = 43, sigma = 1))
p43e<- end_node(
d = 4, i = 3)
q4e <- end_node(
d = 4, i = 4)
r$children <- list(as.ref(q21), as.ref(q22), as.ref(q2e))
q21$parent <- as.ref(r)
q21$children <- list(as.ref(p21), as.ref(p21e))
p21$parent <- as.ref(q21)
p21e$parent <- as.ref(q21)
q22$parent <- as.ref(r)
q22$children <- list(as.ref(q31), as.ref(q32), as.ref(q3e))
q2e$parent <- as.ref(r)
q31$parent <- as.ref(q22)
q31$children <- list(as.ref(q41), as.ref(q42), as.ref(q43), as.ref(q4e))
q32$parent <- as.ref(q22)
q32$children <- list(as.ref(p32), as.ref(p32e))
p32$parent <- as.ref(q32)
p32e$parent <- as.ref(q32)
q3e$parent <- as.ref(q22)
q41$parent <- as.ref(q31)
q41$children <- list(as.ref(p41), as.ref(p41e))
p41$parent <- as.ref(q41)
p41e$parent <- as.ref(q41)
q42$parent <- as.ref(q31)
q42$children <- list(as.ref(p42), as.ref(p42e))
p42$parent <- as.ref(q42)
p42e$parent <- as.ref(q42)
q43$parent <- as.ref(q31)
q43$children <- list(as.ref(p43), as.ref(p43e))
p43$parent <- as.ref(q43)
p43e$parent <- as.ref(q43)
q4e$parent <- as.ref(q31)
set.seed(9000)
hist(activate(r, T.length = 200))