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

1.594.385	150.477	59	32
878.114	107.218	2.110	1.106
13.866	424	59	15
404.149	79.356	65	51
12.442	307	36	30
15.506	1.203	134	94
9.565	560	109	46
33.743	3.206	92	62
26.290	1.307	88	33
20.270	901	33	19
14.151	3.646	21	15
9.849	317	61	33
8.028	171	101	57
15.776	1.955	75	50
24.175	2.252	37	16
19.853	636	83	58
8.182	181	46	19
23.517	1.220	64	38
8.971	297	61	28
17.921	332	21	14
14.325	287	49	45
7.930	174	158	84
17.785	1.711	93	42
31.483	1.859	47	18
17.360	606	44	35
8.682	302	82	42
11.894	440	52	25
17.845	1.368	69	48
12.114	273	84	42
20.515	750	59	18
17.930	643	42	34
13.997	534	37	24
311.275	13.036	79	51
10.710	179	76	45
14.309	360	144	101
20.199	357	178	84
16.152	425	380	206
39.223	643	87	45
32.572	1.358	56	34
73.917	7.023	54	35
21.287	285	36	14
16.082	270	75	45
16.275	263	89	65
7.869	200	51	28
19.605	544	7	2
23.075	1.129	78	49
404.996	30.223	79	39
11.138	1.620	31	22
1.317	1.187	158	72
20.134	888	30	21
16.197	806	115	76
8.707	400	31	20
35.435	1.555	57	45
10.727	248	62	34
25.906	853	47	27
8.524	179	41	37
13.959	288	69	35
15.126	4.628	47	26
9.702	162	37	13
17.542	594	154	59
15.845	368	49	25
9.502	223	48	22
7.916	549	44	33
31.654	2.460	45	29
11.524	225	37	30
11.347	1.525	150	117
10.107	4.339	27	17
9.874	867	35	25
10.695	564	100	47
36.583	4.180	63	47
7.400	126	398	230
9.770	530	127	69
23.344	552	88	32
15.021	307	797	4.600
996.103	80.821	212	122
542.950	50.505	147	105
28.210	2.018	206	113
22.105	1.798	109	67
2.068	65	386	270
37.381	2.617	219	126
8.282	116	86	43
8.886	129	534	254
32.555	2.614	204	144
34.137	1.863	133	112
6.459	114	676	412
8.731	1.567	303	179
10.861	361	95	75
8.865	162	226	119
11.953	401	124	101
17.261	394	96	71
11.916	1.414	67	30
17.533	849	7	3
14.821	520	122	72
12.993	277	34	22
19.647	4.783	26	24
4.340	50	99	76
28.309	3.263	118	98
10.912	523	25	6
14.647	359	34	20
34.897	4.731	45	23
24.829	5.617	39	23
21.432	496	37	21
10.900	263	55	36
4.262	691	43	29
9.538	3.830	48	35
4.192	563	59	40
15.073	2.956	44	30
13.599	1.557	57	29
10.641	3.041	17	3
8.593	228	102	62
12.122	275	31	29
453.153	30.316	47	30
27.809	596	144	96
9.666	146	72	37
5.892	76	69	40
8.934	635	32	27
9.215	252	22	13
11.489	284	39	24
7.556	135	13	11
22.209	839	23	20
5.785	121	52	39
13.913	246	39	26
19.402	628	27	27
6.357	189	48	23
9.478	181	117	74
8.742	665	40	27
11.853	790	30	14
7.610	133	28	16
17.266	1.671	42	15
15.000	367	47	24
81.852	13.611	34	14
13.502	270	99	73
10.692	351	26	12
15.176	348	45	25
15.809	5.356	80	40
31.380	1.172	23	10
13.991	376	37	18
8.053	142	31	16
6.991	84	41	27
22.115	438	17	14
10.238	153	74	36
5.178	61	68	29
1.126.354	33.012	569	255
268.933	7.380	52	29
14.910	154	39	15
18.254	653	55	36
112.918	3.823	49	28
10.655	184	145	95
13.467	157	62	25
22.180	272	43	21
19.540	345	31	10
21.949	231	97	55
2.767	29	35	26
32.293	1.532	19	12
49.237	438	15	15
16.089	186	130	89
9.509	78	38	26
8.357	66	48	18
11.994	74	40	20
3.288	34	71	40
102.673	3.155	49	27
33.930	1.032	19	7
819	131	28	20
19.574	386	50	33
17.327	807	20	12
12.070	122	32	24
7.564	561	119	86
7.754	75	29	21
3.635	41	68	62
271.055	10.057	94	53
14.137	97	25	22
9.433	170	87	52
11.091	171	135	67
25.989	588	17	18
70.616	4.295	13	7
12.479	423	49	37
5.519	70	37	21
30.037	2.493	140	71
35.491	815	16	20
30.476	499	38	28
23.779	334	23	16
2.008	102	63	37
145.374	5.467	75	45
15.782	420	474	360
11.556	171	43	35
13.693	146	52	26
18.245	391	97	54
65.181	3.883	102	54
8.885	87	89	55
12.032	369	8	7
142.150	2.874	116	87
9.828	129	60	28
10.405	236	44	21
26.630	481	36	21
9.426	104	53	31
8.390	111	17	1
10.707	92	149	86
55.804	1.628	10	6
10.960	93	89	68
88.714	1.560	57	47
8.171	83	51	33
10.872	187	40	21
7.459	100	28	16
6.520	165	10	8
5.077	100	45	19
19.177	470	35	19
8.999	153	41	33
13.522	166	109	72
8.917	136	299	217
58.218	2.081	44	31
4.834	86	18	10
9.822	792	138	91
21.123	709	152	87
10.985	282	142	73
11.454	212	94	57
1.373.329	58.997	9	4
266.003	7.541	86	43
76.544	3.499	42	32
17.779	706	55	39
31.075	958	48	48
17.413	255	297	239
16.934	204	42	24
17.470	159	40	23
35.597	1.078	40	23
9.616	95	30	25
24.563	319	126	75
19.012	268	35	25
188.201	4.320	44	19
14.400	169	36	28
13.870	211	253	127
43.146	949	36	35
23.266	634	18	17
12.009	126	47	25
17.598	391	26	18
10.147	268	38	22
22.990	561	28	15
11.087	155	69	51
19.688	856	44	30
79.276	2.645	58	31
13.460	346	37	27
19.467	576	24	14
6.066	117	34	24
22.275	516	66	62
6.373	231	48	28
11.635	859	50	25
495.517	31.731	355	210
19.131	370	81	36
28.598	700	106	81
10.071	156	64	39
17.209	462	70	36
32.581	531	68	38
12.291	159	137	88
216.835	26.531	29	19
8.025	139	76	71
21.064	322	74	47
9.232	196	57	38
10.535	239	40	28
22.640	477	181	130
5.855	157	85	73
11.044	160	49	22
11.667	118	84	52
13.218	116	46	31
8.070	256	100	58
7.786	109	40	37
6.845	223	86	56
8.084	88	57	33
14.736	222	86	67
117.068	2.927	21	14
8.063	82	75	59
28.969	733	30	11
23.619	1.527	64	34
7.054	76	85	44
13.978	131	110	79
6.346	90	35	18
6.207	57	47	47
2.028	21	157	75
6.476	58	50	23
6.364	54	1.105	664
7.964	98	22	19
227.264	9.833	86	35
45.198	1.101	29	20
15.438	382	38	39
37.035	2.139	79	57
17.932	569	24	21
67.988	3.818	34	23
16.691	659	55	20
26.982	1.165	36	37
762.379	76.126	39	18
384.586	23.784	31	16
7.316	469	30	16
40.699	2.059	40	26
17.624	584	57	30
56.323	8.434	31	11
7.923	198	139	63
8.895	241	104	68
69.358	3.709	28	14
11.939	280	44	26
14.089	818	23	16
13.938	355	17	8
6.614	118	6	5
9.489	564	20	14
37.672	1.637	24	15
17.292	393	27	14
19.817	753	181	100
6.253	756	65	35
9.842	393	155	86
29.503	2.023	73	39
203.347	29.388	338	217
11.066	1.570	77	35
14.285	888	110	62

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, mysum$coefficients[i,1], 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,mysum$coefficients[i,1])
a<-table.element(a, round(mysum$coefficients[i,2],6))
a<-table.element(a, round(mysum$coefficients[i,3],4))
a<-table.element(a, round(mysum$coefficients[i,4],6))
a<-table.element(a, round(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, sqrt(mysum$r.squared))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'R-squared',1,TRUE)
a<-table.element(a, mysum$r.squared)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Adjusted R-squared',1,TRUE)
a<-table.element(a, mysum$adj.r.squared)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (value)',1,TRUE)
a<-table.element(a, mysum$fstatistic[1])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE)
a<-table.element(a, mysum$fstatistic[2])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE)
a<-table.element(a, mysum$fstatistic[3])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'p-value',1,TRUE)
a<-table.element(a, 1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]))
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, mysum$sigma)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a, 'Sum Squared Residuals',1,TRUE)
a<-table.element(a, sum(myerror*myerror))
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,x[i])
a<-table.element(a,x[i]-mysum$resid[i])
a<-table.element(a,mysum$resid[i])
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,gqarr[mypoint-kp3+1,1])
a<-table.element(a,gqarr[mypoint-kp3+1,2])
a<-table.element(a,gqarr[mypoint-kp3+1,3])
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,numsignificant1)
a<-table.element(a,numsignificant1/numgqtests)
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,numsignificant5)
a<-table.element(a,numsignificant5/numgqtests)
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,numsignificant10)
a<-table.element(a,numsignificant10/numgqtests)
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')
}