Browse code

finaly

Michi authored on11/06/2012 18:57:43
Showing1 changed files
... ...
@@ -1,8 +1,9 @@
1 1
 #Problem 1
2
-
2
+library(Hmisc)
3 3
 #definition of a straight line function
4 4
 linrel=function(x,m,b) m*x+b
5
-
5
+#sigvar = 0.4
6
+sigvar = 1
6 7
 #definition x-Vctor
7 8
 x_vec=seq(-1,3,0.1)
8 9
 
... ...
@@ -15,7 +16,7 @@ plot(x_vec, y_vec, type="l", col="black", xlab='x',ylab='f(x)=y')
15 16
 equ_points=10
16 17
 mock_vec = rep(NA,10)
17 18
 x_vec_2 =seq(0,2, 2/(equ_points-1))
18
-mock_vec = rnorm({1:10},mean = x_vec_2, sd =  0.4)
19
+mock_vec = rnorm({1:10},mean = x_vec_2, sd =  sigvar)
19 20
 points(x_vec_2,mock_vec, col="red", type="p")
20 21
 
21 22
 ##Problem2
... ...
@@ -29,9 +30,9 @@ b_vec = seq(-2,2,length.out = reso)
29 30
 
30 31
 
31 32
 # Define function chi2_quad
32
-chi2_qua = function(a,m,b) sum((mock_vec - quarel(mock_vec,a,m,b))**2/(0.4)**2)
33
-chi2_lin = function(m,b) sum((mock_vec - linrel(mock_vec,m,b))**2/(0.4)**2)
34
-chi2_con = function(b) sum((mock_vec - conrel(b))**2/(0.4)**2)
33
+chi2_qua = function(a,m,b) sum((mock_vec - quarel(mock_vec,a,m,b))**2/(sigvar)**2)
34
+chi2_lin = function(m,b) sum((mock_vec - linrel(mock_vec,m,b))**2/(sigvar)**2)
35
+chi2_con = function(b) sum((mock_vec - conrel(b))**2/(sigvar)**2)
35 36
 
36 37
 # Calculate 3-dim grid for values a=-4..4, m=-4..8, b-2..2
37 38
 qua_arr = array(NA, dim=c(length(b_vec),length(m_vec),length(a_vec)))
... ...
@@ -90,42 +91,58 @@ err_lin_b = 0
90 91
 err_lin_m = 0
91 92
 err_con_b = 0
92 93
 
93
-#Marginalization of posterior_quad over a
94
+#Marginalization of posterior_quad over a and m
94 95
 int_qua_a=array(0, c(dim_m, dim_b))
95 96
 for (i in (1:dim_m)){
96 97
 	for (j in (1:dim_b)){
97
-		I=int(a_vec, norm(posterior_qua[j,i,]))
98
+		I=int(a_vec, (posterior_qua)[j,i,])
98 99
 		int_qua_a[i,j]=I
99 100
 	}
100 101
 }
101 102
 
102
-#Marginalization of posterior_quad over b
103
+int_qua_am=array(0, c(dim_b))
104
+for (i in (1:dim_b)){
105
+		I=int(m_vec, (int_qua_a)[,i])
106
+		int_qua_am[i]=I
107
+}
108
+#Marginalization of posterior_quad over b and m
103 109
 int_qua_b=array(0, c(dim_m, dim_a))
104 110
 for (i in (1:dim_m)){
105 111
 	for (j in (1:dim_a)){
106
-		I=int(b_vec, norm(posterior_qua[,i,j]))
112
+		I=int(b_vec, (posterior_qua)[,i,j])
107 113
 		int_qua_b[i,j]=I
108 114
 	}
109 115
 }
110
-#Marginalization of posterior_quad over m
111
-int_qua_m=array(0, c(dim_a, dim_b))
116
+
117
+int_qua_bm=array(0, c(dim_a))
112 118
 for (i in (1:dim_a)){
113
-	for (j in (1:dim_b)){
114
-		I=int(m_vec, norm(posterior_qua[j,,i]))
115
-		int_qua_m[i,j]=I
116
-	}
119
+		I=int(m_vec, (int_qua_b)[,i])
120
+		int_qua_bm[i]=I
117 121
 }
118 122
 
123
+#Marginalization of posterior_quad over b and a
124
+
125
+int_qua_ba=array(0, c(dim_m))
126
+for (i in (1:dim_m)){
127
+		I=int(b_vec, (int_qua_a)[,i])
128
+		int_qua_ba[i]=I
129
+}
130
+
131
+
132
+
133
+
134
+######
135
+
119 136
 #Marginalization of posterior_lin over b and m
120 137
 int_lin_b=array(0, dim=c(length(m_vec)))
121 138
 for (i in (1:length(m_vec))){
122
-	I=int(b_vec, norm(posterior_lin[i,]))
139
+	I=int(b_vec, (posterior_lin[i,]))
123 140
 		int_lin_b[i]=I
124 141
 }
125 142
 
126 143
 int_lin_m=array(0, dim=c(length(b_vec)))
127 144
 for (i in (1:length(b_vec))){
128
-	I=int(m_vec, norm(posterior_lin[,i]))
145
+	I=int(m_vec, (posterior_lin[,i]))
129 146
 		int_lin_m[i]=I
130 147
 }
131 148
 
... ...
@@ -133,18 +150,97 @@ for (i in (1:length(b_vec))){
133 150
 #Marginalization of posterior_con over b
134 151
 
135 152
 int_lin_m=array(0, dim=c(dim_b))
136
-I=int(b_vec, norm(posterior_con))
137
-int_con_b=I
153
+I=int(b_vec, (posterior_con))
154
+int_con_b=posterior_con
155
+
156
+#search for best sigma
157
+sdtest=seq(0.01,1,by=0.01)
158
+
159
+sigma_test=function(A,mu,sd,xvec,f){
160
+	chi=0
161
+	for(j in (1:length(xvec)))
162
+		{
163
+			chi=chi+(f[j]-(A*exp(-0.5*(((xvec[j]-mu)**2)/(sd**2))))/sigvar)**2
164
+        }
165
+        return(chi)
166
+    }
167
+
168
+# create grids for vaious sigma functions
169
+# later, find min of grid
170
+
171
+grid_con_b <-array(0, dim=c(length(sdtest)))
172
+grid_lin_b <-array(0, dim=c(length(sdtest)))
173
+grid_lin_m <-array(0, dim=c(length(sdtest)))
174
+grid_qua_b <-array(0, dim=c(length(sdtest)))
175
+grid_qua_m <-array(0, dim=c(length(sdtest)))
176
+grid_qua_a <-array(0, dim=c(length(sdtest)))
177
+
178
+for(i in (1:length(sdtest)))
179
+{
180
+	grid_con_b[i] = sigma_test(max(int_con_b),best_b_con,sdtest[i], b_vec,int_con_b)
181
+	grid_lin_b[i] = sigma_test(max(int_lin_b),best_b_lin,sdtest[i], b_vec,int_lin_b)
182
+	grid_lin_m[i] = sigma_test(max(int_lin_m),best_m_lin,sdtest[i], m_vec,int_lin_m)
183
+	grid_qua_b[i] = sigma_test(max(int_qua_am),best_b_qua,sdtest[i], b_vec,int_qua_am)
184
+	grid_qua_m[i] = sigma_test(max(int_qua_ba),best_m_qua,sdtest[i], m_vec,int_qua_ba)
185
+	grid_qua_a[i] = sigma_test(max(int_qua_bm),best_a_qua,sdtest[i], a_vec,int_qua_bm)
186
+}
187
+err_con_b=sdtest[which(grid_con_b==min(grid_con_b),arr.ind=TRUE)]
188
+err_lin_b=sdtest[which(grid_lin_b==min(grid_lin_b),arr.ind=TRUE)]
189
+err_lin_m=sdtest[which(grid_lin_m==min(grid_lin_m),arr.ind=TRUE)]
190
+err_qua_b=sdtest[which(grid_qua_b==min(grid_qua_b),arr.ind=TRUE)]
191
+err_qua_m=sdtest[which(grid_qua_m==min(grid_qua_m),arr.ind=TRUE)]
192
+err_qua_a=sdtest[which(grid_qua_a==min(grid_qua_a),arr.ind=TRUE)]
193
+err_lin_m = err_lin_m[1]
194
+
138 195
 
139 196
 
140 197
 
141 198
 # The integration via fit is computationally expensive compared to the simple numerical integration 
142 199
 
143 200
 
144
-strqua = paste("quadratic: ax^2 + mx +b with a=",toString(best_a_qua),"+-",toString(err_qua_a),",\n m=", toString(best_m_qua),"+-",toString(err_qua_m),", b=",toString(best_b_qua),"+-",toString(err_qua_b))
145
-strlin = paste("linear: mx +b with m=", toString(best_m_lin),"+-",toString(err_lin_m),",\n b=",toString(best_b_lin),"+-",toString(err_lin_b))
146
-strcon = paste("constant: b with b=",toString(best_b_con),"+-",toString(err_con_b))
201
+strqua = paste("quadratic: ax^2 + mx +b with a=",round(best_a_qua,2),"+-",round(err_qua_a,2),",\n m=", round(best_m_qua,2),"+-",round(err_qua_m,2),", b=",round(best_b_qua,2),"+-",round(err_qua_b,2))
202
+strlin = paste("linear: mx +b with m=", round(best_m_lin,2),"+-",round(err_lin_m,2),",\n b=",round(best_b_lin,2),"+-",round(err_lin_b,2))
203
+strcon = paste("constant: b with b=",round(best_b_con,2),"+-",round(err_con_b,2))
147 204
 print(strqua)
148 205
 text(0,2.8,strqua)
149 206
 text(0,2.1,strlin)
150 207
 text(0,1.6,strcon)
208
+
209
+#Plot errorbars quad
210
+for( x in (x_vec_2)){
211
+
212
+tmperrup = quarel(x,best_a_qua,best_m_qua,best_b_qua) + (err_qua_a*x**2+x*err_qua_m+err_qua_b)
213
+tmperrdo = quarel(x,best_a_qua,best_m_qua,best_b_qua) - (err_qua_a*x**2+x*err_qua_m+err_qua_b)
214
+errbar(x,quarel(x,best_a_qua,best_m_qua,best_b_qua),tmperrup,tmperrdo,add=TRUE)
215
+
216
+tmperrup = linrel(x,best_m_lin,best_b_lin) + (x*err_lin_m+err_lin_b)
217
+tmperrdo = linrel(x,best_m_lin,best_b_lin) - (x*err_lin_m+err_lin_b)
218
+errbar(x,linrel(x,best_m_lin,best_b_lin),tmperrup,tmperrdo,add=TRUE)
219
+
220
+tmperrup = best_b_lin + err_con_b
221
+tmperrdo = best_b_lin - err_con_b
222
+#print(tmperrup)
223
+#print(tmperrdo)
224
+#print(x)
225
+#print(best_b_con)
226
+errbar(x,best_b_con,tmperrup,tmperrdo,add=TRUE)
227
+}
228
+#Problem 4
229
+# calculate the evidence
230
+evidence_qua=err_qua_a*err_qua_m*err_qua_b*max(posterior_qua)*(1/sum(posterior_qua))
231
+evidence_lin=err_lin_m*err_lin_b*max(posterior_lin)*(1/sum(posterior_lin))
232
+evidence_con=err_con_b*max(posterior_con)* (1/sum(posterior_con))
233
+print('evidence')
234
+print('quadratic')
235
+print(evidence_qua)
236
+print('linear')
237
+print(evidence_lin)
238
+print('const.')
239
+print(evidence_con)
240
+
241
+#the constant would be the best model. This is in contrast to the naive expectation that straight line model would fit best.
242
+
243
+#Problem 5
244
+#To run the script with sigma 1 change the variable sigvar to 1
245
+#Theoretically the evidence should point to the quadratic model because it could better fit the new mock data with higher sigvar. We get the constant again as the best model. Forthermor we gat bigger error bars and so a better evidence.
246
+