• QR Code (size=2)
• QR Code (size=3)
• QR Code (size=4)
• QR Code (size=5)
• QR Code (size=6)

 149	 96	 18	 68	 12,9
 139	 70	 31	 39	 12,2
 148	 88	 39	 32	 12,8
 158	 114	 46	 62	 7,4
 128	 69	 31	 33	 6,7
 224	 176	 67	 52	 12,6
 159	 114	 35	 62	 14,8
 105	 121	 52	 77	 13,3
 159	 110	 77	 76	 11,1
 167	 158	 37	 41	 8,2
 165	 116	 32	 48	 11,4
 159	 181	 36	 63	 6,4
 119	 77	 38	 30	 10,6
 176	 141	 69	 78	 12,0
 54	 35	 21	 19	 6,3
 91	 80	 26	 31	 11,3
 163	 152	 54	 66	 11,9
 124	 97	 36	 35	 9,3
 137	 99	 42	 42	 9,6
 121	 84	 23	 45	 10,0
 153	 68	 34	 21	 6,4
 148	 101	 112	 25	 13,8
 221	 107	 35	 44	 10,8
 188	 88	 47	 69	 13,8
 149	 112	 47	 54	 11,7
 244	 171	 37	 74	 10,9
 148	 137	 109	 80	 16,1
 92	 77	 24	 42	 13,4
 150	 66	 20	 61	 9,9
 153	 93	 22	 41	 11,5
 94	 105	 23	 46	 8,3
 156	 131	 32	 39	 11,7
 132	 102	 30	 34	 9,0
 161	 161	 92	 51	 9,7
 105	 120	 43	 42	 10,8
 97	 127	 55	 31	 10,3
 151	 77	 16	 39	 10,4
 131	 108	 49	 20	 12,7
 166	 85	 71	 49	 9,3
 157	 168	 43	 53	 11,8
 111	 48	 29	 31	 5,9
 145	 152	 56	 39	 11,4
 162	 75	 46	 54	 13,0
 163	 107	 19	 49	 10,8
 59	 62	 23	 34	 12,3
 187	 121	 59	 46	 11,3
 109	 124	 30	 55	 11,8
 90	 72	 61	 42	 7,9
 105	 40	 7	 50	 12,7
 83	 58	 38	 13	 12,3
 116	 97	 32	 37	 11,6
 42	 88	 16	 25	 6,7
 148	 126	 19	 30	 10,9
 155	 104	 22	 28	 12,1
 125	 148	 48	 45	 13,3
 116	 146	 23	 35	 10,1
 128	 80	 26	 28	 5,7
 138	 97	 33	 41	 14,3
 49	 25	 9	 6	 8,0
 96	 99	 24	 45	 13,3
 164	 118	 34	 73	 9,3
 162	 58	 48	 17	 12,5
 99	 63	 18	 40	 7,6
 202	 139	 43	 64	 15,9
 186	 50	 33	 37	 9,2
 66	 60	 28	 25	 9,1
 183	 152	 71	 65	 11,1
 214	 142	 26	 100	 13,0
 188	 94	 67	 28	 14,5
 104	 66	 34	 35	 12,2
 177	 127	 80	 56	 12,3
 126	 67	 29	 29	 11,4
 76	 90	 16	 43	 8,8
 99	 75	 59	 59	 14,6
 139	 128	 32	 50	 12,6
 162	 146	 43	 59	 13,0
 108	 69	 38	 27	 12,6
 159	 186	 29	 61	 13,2
 74	 81	 36	 28	 9,9
 110	 85	 32	 51	 7,7
 96	 54	 35	 35	 10,5
 116	 46	 21	 29	 13,4
 87	 106	 29	 48	 10,9
 97	 34	 12	 25	 4,3
 127	 60	 37	 44	 10,3
 106	 95	 37	 64	 11,8
 80	 57	 47	 32	 11,2
 74	 62	 51	 20	 11,4
 91	 36	 32	 28	 8,6
 133	 56	 21	 34	 13,2
 74	 54	 13	 31	 12,6
 114	 64	 14	 26	 5,6
 140	 76	 -2	 58	 9,9
 95	 98	 20	 23	 8,8
 98	 88	 24	 21	 7,7
 121	 35	 11	 21	 9,0
 126	 102	 23	 33	 7,3
 98	 61	 24	 16	 11,4
 95	 80	 14	 20	 13,6
 110	 49	 52	 37	 7,9
 70	 78	 15	 35	 10,7
 102	 90	 23	 33	 10,3
 86	 45	 19	 27	 8,3
 130	 55	 35	 41	 9,6
 96	 96	 24	 40	 14,2
 102	 43	 39	 35	 8,5
 100	 52	 29	 28	 13,5
 94	 60	 13	 32	 4,9
 52	 54	 8	 22	 6,4
 98	 51	 18	 44	 9,6
 118	 51	 24	 27	 11,6
 99	 38	 19	 17	 11,1
 48	 41	 23	 12	 4,35
 50	 146	 16	 45	 12,7
 150	 182	 33	 37	 18,1
 154	 192	 32	 37	 17,85
 109	 263	 37	 108	 16,6
 68	 35	 14	 10	 12,6
 194	 439	 52	 68	 17,1
 158	 214	 75	 72	 19,1
 159	 341	 72	 143	 16,1
 67	 58	 15	 9	 13,35
 147	 292	 29	 55	 18,4
 39	 85	 13	 17	 14,7
 100	 200	 40	 37	 10,6
 111	 158	 19	 27	 12,6
 138	 199	 24	 37	 16,2
 101	 297	 121	 58	 13,6
 131	 227	 93	 66	 18,9
 101	 108	 36	 21	 14,1
 114	 86	 23	 19	 14,5
 165	 302	 85	 78	 16,15
 114	 148	 41	 35	 14,75
 111	 178	 46	 48	 14,8
 75	 120	 18	 27	 12,45
 82	 207	 35	 43	 12,65
 121	 157	 17	 30	 17,35
 32	 128	 4	 25	 8,6
 150	 296	 28	 69	 18,4
 117	 323	 44	 72	 16,1
 71	 79	 10	 23	 11,6
 165	 70	 38	 13	 17,75
 154	 146	 57	 61	 15,25
 126	 246	 23	 43	 17,65
 149	 196	 36	 51	 16,35
 145	 199	 22	 67	 17,65
 120	 127	 40	 36	 13,6
 109	 153	 31	 44	 14,35
 132	 299	 11	 45	 14,75
 172	 228	 38	 34	 18,25
 169	 190	 24	 36	 9,9
 114	 180	 37	 72	 16
 156	 212	 37	 39	 18,25
 172	 269	 22	 43	 16,85
 68	 130	 15	 25	 14,6
 89	 179	 2	 56	 13,85
 167	 243	 43	 80	 18,95
 113	 190	 31	 40	 15,6
 115	 299	 29	 73	 14,85
 78	 121	 45	 34	 11,75
 118	 137	 25	 72	 18,45
 87	 305	 4	 42	 15,9
 173	 157	 31	 61	 17,1
 2	 96	 -4	 23	 16,1
 162	 183	 66	 74	 19,9
 49	 52	 61	 16	 10,95
 122	 238	 32	 66	 18,45
 96	 40	 31	 9	 15,1
 100	 226	 39	 41	 15
 82	 190	 19	 57	 11,35
 100	 214	 31	 48	 15,95
 115	 145	 36	 51	 18,1
 141	 119	 42	 53	 14,6
 165	 222	 21	 29	 15,4
 165	 222	 21	 29	 15,4
 110	 159	 25	 55	 17,6
 118	 165	 32	 54	 13,35
 158	 249	 26	 43	 19,1
 146	 125	 28	 51	 15,35
 49	 122	 32	 20	 7,6
 90	 186	 41	 79	 13,4
 121	 148	 29	 39	 13,9
 155	 274	 33	 61	 19,1
 104	 172	 17	 55	 15,25
 147	 84	 13	 30	 12,9
 110	 168	 32	 55	 16,1
 108	 102	 30	 22	 17,35
 113	 106	 34	 37	 13,15
 115	 2	 59	 2	 12,15
 61	 139	 13	 38	 12,6
 60	 95	 23	 27	 10,35
 109	 130	 10	 56	 15,4
 68	 72	 5	 25	 9,6
 111	 141	 31	 39	 18,2
 77	 113	 19	 33	 13,6
 73	 206	 32	 43	 14,85
 151	 268	 30	 57	 14,75
 89	 175	 25	 43	 14,1
 78	 77	 48	 23	 14,9
 110	 125	 35	 44	 16,25
 220	 255	 67	 54	 19,25
 65	 111	 15	 28	 13,6
 141	 132	 22	 36	 13,6
 117	 211	 18	 39	 15,65
 122	 92	 33	 16	 12,75
 63	 76	 46	 23	 14,6
 44	 171	 24	 40	 9,85
 52	 83	 14	 24	 12,65
 131	 266	 12	 78	 19,2
 101	 186	 38	 57	 16,6
 42	 50	 12	 37	 11,2
 152	 117	 28	 27	 15,25
 107	 219	 41	 61	 11,9
 77	 246	 12	 27	 13,2
 154	 279	 31	 69	 16,35
 103	 148	 33	 34	 12,4
 96	 137	 34	 44	 15,85
 175	 181	 21	 34	 18,15
 57	 98	 20	 39	 11,15
 112	 226	 44	 51	 15,65
 143	 234	 52	 34	 17,75
 49	 138	 7	 31	 7,65
 110	 85	 29	 13	 12,35
 131	 66	 11	 12	 15,6
 167	 236	 26	 51	 19,3
 56	 106	 24	 24	 15,2
 137	 135	 7	 19	 17,1
 86	 122	 60	 30	 15,6
 121	 218	 13	 81	 18,4
 149	 199	 20	 42	 19,05
 168	 112	 52	 22	 18,55
 140	 278	 28	 85	 19,1
 88	 94	 25	 27	 13,1
 168	 113	 39	 25	 12,85
 94	 84	 9	 22	 9,5
 51	 86	 19	 19	 4,5
 48	 62	 13	 14	 11,85
 145	 222	 60	 45	 13,6
 66	 167	 19	 45	 11,7
 85	 82	 34	 28	 12,4
 109	 207	 14	 51	 13,35
 63	 184	 17	 41	 11,4
 102	 83	 45	 31	 14,9
 162	 183	 66	 74	 19,9
 86	 89	 48	 19	 11,2
 114	 225	 29	 51	 14,6
 164	 237	 -2	 73	 17,6
 119	 102	 51	 24	 14,05
 126	 221	 2	 61	 16,1
 132	 128	 24	 23	 13,35
 142	 91	 40	 14	 11,85
 83	 198	 20	 54	 11,95
 94	 204	 19	 51	 14,75
 81	 158	 16	 62	 15,15
 166	 138	 20	 36	 13,2
 110	 226	 40	 59	 16,85
 64	 44	 27	 24	 7,85
 93	 196	 25	 26	 7,7
 104	 83	 49	 54	 12,6
 105	 79	 39	 39	 7,85
 49	 52	 61	 16	 10,95
 88	 105	 19	 36	 12,35
 95	 116	 67	 31	 9,95
 102	 83	 45	 31	 14,9
 99	 196	 30	 42	 16,65
 63	 153	 8	 39	 13,4
 76	 157	 19	 25	 13,95
 109	 75	 52	 31	 15,7
 117	 106	 22	 38	 16,85
 57	 58	 17	 31	 10,95
 120	 75	 33	 17	 15,35
 73	 74	 34	 22	 12,2
 91	 185	 22	 55	 15,1
 108	 265	 30	 62	 17,75
 105	 131	 25	 51	 15,2
 117	 139	 38	 30	 14,6
 119	 196	 26	 49	 16,65
 31	 78	 13	 16	 8,1

library(lattice)
library(lmtest)
n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test
par1 <- as.numeric(par1)
x <- t(y)
k <- length(x[1,])
n <- length(x[,1])
x1 <- cbind(x[,par1], x[,1:k!=par1])
mycolnames <- c(colnames(x)[par1], colnames(x)[1:k!=par1])
colnames(x1) <- mycolnames #colnames(x)[par1]
x <- x1
if (par3 == 'First Differences'){
x2 <- array(0, dim=c(n-1,k), dimnames=list(1:(n-1), paste('(1-B)',colnames(x),sep='')))
for (i in 1:n-1) {
for (j in 1:k) {
x2[i,j] <- x[i+1,j] - x[i,j]
}
}
x <- x2
}
if (par2 == 'Include Monthly Dummies'){
x2 <- array(0, dim=c(n,11), dimnames=list(1:n, paste('M', seq(1:11), sep ='')))
for (i in 1:11){
x2[seq(i,n,12),i] <- 1
}
x <- cbind(x, x2)
}
if (par2 == 'Include Quarterly Dummies'){
x2 <- array(0, dim=c(n,3), dimnames=list(1:n, paste('Q', seq(1:3), sep ='')))
for (i in 1:3){
x2[seq(i,n,4),i] <- 1
}
x <- cbind(x, x2)
}
k <- length(x[1,])
if (par3 == 'Linear Trend'){
x <- cbind(x, c(1:n))
colnames(x)[k+1] <- 't'
}
x
k <- length(x[1,])
df <- as.data.frame(x)
(mylm <- lm(df))
(mysum <- summary(mylm))
if (n > n25) {
kp3 <- k + 3
nmkm3 <- n - k - 3
gqarr <- array(NA, dim=c(nmkm3-kp3+1,3))
numgqtests <- 0
numsignificant1 <- 0
numsignificant5 <- 0
numsignificant10 <- 0
for (mypoint in kp3:nmkm3) {
j <- 0
numgqtests <- numgqtests + 1
for (myalt in c('greater', 'two.sided', 'less')) {
j <- j + 1
gqarr[mypoint-kp3+1,j] <- gqtest(mylm, point=mypoint, alternative=myalt)$p.value
}
if (gqarr[mypoint-kp3+1,2] < 0.01) numsignificant1 <- numsignificant1 + 1
if (gqarr[mypoint-kp3+1,2] < 0.05) numsignificant5 <- numsignificant5 + 1
if (gqarr[mypoint-kp3+1,2] < 0.10) numsignificant10 <- numsignificant10 + 1
}
gqarr
}
bitmap(file='test0.png')
plot(x[,1], type='l', main='Actuals and Interpolation', ylab='value of Actuals and Interpolation (dots)', xlab='time or index')
points(x[,1]-mysum$resid)
grid()
dev.off()
bitmap(file='test1.png')
plot(mysum$resid, type='b', pch=19, main='Residuals', ylab='value of Residuals', xlab='time or index')
grid()
dev.off()
bitmap(file='test2.png')
hist(mysum$resid, main='Residual Histogram', xlab='values of Residuals')
grid()
dev.off()
bitmap(file='test3.png')
densityplot(~mysum$resid,col='black',main='Residual Density Plot', xlab='values of Residuals')
dev.off()
bitmap(file='test4.png')
qqnorm(mysum$resid, main='Residual Normal Q-Q Plot')
qqline(mysum$resid)
grid()
dev.off()
(myerror <- as.ts(mysum$resid))
bitmap(file='test5.png')
dum <- cbind(lag(myerror,k=1),myerror)
dum
dum1 <- dum[2:length(myerror),]
dum1
z <- as.data.frame(dum1)
z
plot(z,main=paste('Residual Lag plot, lowess, and regression line'), ylab='values of Residuals', xlab='lagged values of Residuals')
lines(lowess(z))
abline(lm(z))
grid()
dev.off()
bitmap(file='test6.png')
acf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Autocorrelation Function')
grid()
dev.off()
bitmap(file='test7.png')
pacf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Partial Autocorrelation Function')
grid()
dev.off()
bitmap(file='test8.png')
opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
plot(mylm, las = 1, sub='Residual Diagnostics')
par(opar)
dev.off()
if (n > n25) {
bitmap(file='test9.png')
plot(kp3:nmkm3,gqarr[,2], main='Goldfeld-Quandt test',ylab='2-sided p-value',xlab='breakpoint')
grid()
dev.off()
}
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Estimated Regression Equation', 1, TRUE)
a<-table.row.end(a)
myeq <- colnames(x)[1]
myeq <- paste(myeq, '[t] = ', sep='')
for (i in 1:k){
if (mysum$coefficients[i,1] > 0) myeq <- paste(myeq, '+', '')
myeq <- paste(myeq, signif(mysum$coefficients[i,1],6), sep=' ')
if (rownames(mysum$coefficients)[i] != '(Intercept)') {
myeq <- paste(myeq, rownames(mysum$coefficients)[i], sep='')
if (rownames(mysum$coefficients)[i] != 't') myeq <- paste(myeq, '[t]', sep='')
}
}
myeq <- paste(myeq, ' + e[t]')
a<-table.row.start(a)
a<-table.element(a, myeq)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable1.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,hyperlink('ols1.htm','Multiple Linear Regression - Ordinary Least Squares',''), 6, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Variable',header=TRUE)
a<-table.element(a,'Parameter',header=TRUE)
a<-table.element(a,'S.D.',header=TRUE)
a<-table.element(a,'T-STAT
H0: parameter = 0',header=TRUE)
a<-table.element(a,'2-tail p-value',header=TRUE)
a<-table.element(a,'1-tail p-value',header=TRUE)
a<-table.row.end(a)
for (i in 1:k){
a<-table.row.start(a)
a<-table.element(a,rownames(mysum$coefficients)[i],header=TRUE)
a<-table.element(a,signif(mysum$coefficients[i,1],6))
a<-table.element(a, signif(mysum$coefficients[i,2],6))
a<-table.element(a, signif(mysum$coefficients[i,3],4))
a<-table.element(a, signif(mysum$coefficients[i,4],6))
a<-table.element(a, signif(mysum$coefficients[i,4]/2,6))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable2.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Regression Statistics', 2, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Multiple R',1,TRUE)
a<-table.element(a, signif(sqrt(mysum$r.squared),6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'R-squared',1,TRUE)
a<-table.element(a, signif(mysum$r.squared,6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Adjusted R-squared',1,TRUE)
a<-table.element(a, signif(mysum$adj.r.squared,6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (value)',1,TRUE)
a<-table.element(a, signif(mysum$fstatistic[1],6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE)
a<-table.element(a, signif(mysum$fstatistic[2],6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE)
a<-table.element(a, signif(mysum$fstatistic[3],6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'p-value',1,TRUE)
a<-table.element(a, signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Residual Statistics', 2, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Residual Standard Deviation',1,TRUE)
a<-table.element(a, signif(mysum$sigma,6))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Sum Squared Residuals',1,TRUE)
a<-table.element(a, signif(sum(myerror*myerror),6))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable3.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a, 'Multiple Linear Regression - Actuals, Interpolation, and Residuals', 4, TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Time or Index', 1, TRUE)
a<-table.element(a, 'Actuals', 1, TRUE)
a<-table.element(a, 'Interpolation
Forecast', 1, TRUE)
a<-table.element(a, 'Residuals
Prediction Error', 1, TRUE)
a<-table.row.end(a)
for (i in 1:n) {
a<-table.row.start(a)
a<-table.element(a,i, 1, TRUE)
a<-table.element(a,signif(x[i],6))
a<-table.element(a,signif(x[i]-mysum$resid[i],6))
a<-table.element(a,signif(mysum$resid[i],6))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable4.tab')
if (n > n25) {
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Goldfeld-Quandt test for Heteroskedasticity',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'p-values',header=TRUE)
a<-table.element(a,'Alternative Hypothesis',3,header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'breakpoint index',header=TRUE)
a<-table.element(a,'greater',header=TRUE)
a<-table.element(a,'2-sided',header=TRUE)
a<-table.element(a,'less',header=TRUE)
a<-table.row.end(a)
for (mypoint in kp3:nmkm3) {
a<-table.row.start(a)
a<-table.element(a,mypoint,header=TRUE)
a<-table.element(a,signif(gqarr[mypoint-kp3+1,1],6))
a<-table.element(a,signif(gqarr[mypoint-kp3+1,2],6))
a<-table.element(a,signif(gqarr[mypoint-kp3+1,3],6))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable5.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Meta Analysis of Goldfeld-Quandt test for Heteroskedasticity',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Description',header=TRUE)
a<-table.element(a,'# significant tests',header=TRUE)
a<-table.element(a,'% significant tests',header=TRUE)
a<-table.element(a,'OK/NOK',header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'1% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant1,6))
a<-table.element(a,signif(numsignificant1/numgqtests,6))
if (numsignificant1/numgqtests < 0.01) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'5% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant5,6))
a<-table.element(a,signif(numsignificant5/numgqtests,6))
if (numsignificant5/numgqtests < 0.05) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'10% type I error level',header=TRUE)
a<-table.element(a,signif(numsignificant10,6))
a<-table.element(a,signif(numsignificant10/numgqtests,6))
if (numsignificant10/numgqtests < 0.1) dum <- 'OK' else dum <- 'NOK'
a<-table.element(a,dum)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable6.tab')
}