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

210907	1418	56	81	94	210907
120982	869	56	55	103	120982
176508	1530	54	50	93	176508
179321	2172	89	125	103	179321
123185	901	40	40	51	123185
52746	463	25	37	70	52746
385534	3201	92	63	91	385534
33170	371	18	44	22	33170
101645	1192	63	88	38	101645
149061	1583	44	66	93	149061
165446	1439	33	57	60	165446
237213	1764	84	74	123	237213
173326	1495	88	49	148	173326
133131	1373	55	52	90	133131
258873	2187	60	88	124	258873
180083	1491	66	36	70	180083
324799	4041	154	108	168	324799
230964	1706	53	43	115	230964
236785	2152	119	75	71	236785
135473	1036	41	32	66	135473
202925	1882	61	44	134	202925
215147	1929	58	85	117	215147
344297	2242	75	86	108	344297
153935	1220	33	56	84	153935
132943	1289	40	50	156	132943
174724	2515	92	135	120	174724
174415	2147	100	63	114	174415
225548	2352	112	81	94	225548
223632	1638	73	52	120	223632
124817	1222	40	44	81	124817
221698	1812	45	113	110	221698
210767	1677	60	39	133	210767
170266	1579	62	73	122	170266
260561	1731	75	48	158	260561
84853	807	31	33	109	84853
294424	2452	77	59	124	294424
101011	829	34	41	39	101011
215641	1940	46	69	92	215641
325107	2662	99	64	126	325107
7176	186	17	1	0	7176
167542	1499	66	59	70	167542
106408	865	30	32	37	106408
96560	1793	76	129	38	96560
265769	2527	146	37	120	265769
269651	2747	67	31	93	269651
149112	1324	56	65	95	149112
175824	2702	107	107	77	175824
152871	1383	58	74	90	152871
111665	1179	34	54	80	111665
116408	2099	61	76	31	116408
362301	4308	119	715	110	362301
78800	918	42	57	66	78800
183167	1831	66	66	138	183167
277965	3373	89	106	133	277965
150629	1713	44	54	113	150629
168809	1438	66	32	100	168809
24188	496	24	20	7	24188
329267	2253	259	71	140	329267
65029	744	17	21	61	65029
101097	1161	64	70	41	101097
218946	2352	41	112	96	218946
244052	2144	68	66	164	244052
341570	4691	168	190	78	341570
103597	1112	43	66	49	103597
233328	2694	132	165	102	233328
256462	1973	105	56	124	256462
206161	1769	71	61	99	206161
311473	3148	112	53	129	311473
235800	2474	94	127	62	235800
177939	2084	82	63	73	177939
207176	1954	70	38	114	207176
196553	1226	57	50	99	196553
174184	1389	53	52	70	174184
143246	1496	103	42	104	143246
187559	2269	121	76	116	187559
187681	1833	62	67	91	187681
119016	1268	52	50	74	119016
182192	1943	52	53	138	182192
73566	893	32	39	67	73566
194979	1762	62	50	151	194979
167488	1403	45	77	72	167488
143756	1425	46	57	120	143756
275541	1857	63	73	115	275541
243199	1840	75	34	105	243199
182999	1502	88	39	104	182999
135649	1441	46	46	108	135649
152299	1420	53	63	98	152299
120221	1416	37	35	69	120221
346485	2970	90	106	111	346485
145790	1317	63	43	99	145790
193339	1644	78	47	71	193339
80953	870	25	31	27	80953
122774	1654	45	162	69	122774
130585	1054	46	57	107	130585
112611	937	41	36	73	112611
286468	3004	144	263	107	286468
241066	2008	82	78	93	241066
148446	2547	91	63	129	148446
204713	1885	71	54	69	204713
182079	1626	63	63	118	182079
140344	1468	53	77	73	140344
220516	2445	62	79	119	220516
243060	1964	63	110	104	243060
162765	1381	32	56	107	162765
182613	1369	39	56	99	182613
232138	1659	62	43	90	232138
265318	2888	117	111	197	265318
85574	1290	34	71	36	85574
310839	2845	92	62	85	310839
225060	1982	93	56	139	225060
232317	1904	54	74	106	232317
144966	1391	144	60	50	144966
43287	602	14	43	64	43287
155754	1743	61	68	31	155754
164709	1559	109	53	63	164709
201940	2014	38	87	92	201940
235454	2143	73	46	106	235454
220801	2146	75	105	63	220801
99466	874	50	32	69	99466
92661	1590	61	133	41	92661
133328	1590	55	79	56	133328
61361	1210	77	51	25	61361
125930	2072	75	207	65	125930
100750	1281	72	67	93	100750
224549	1401	50	47	114	224549
82316	834	32	34	38	82316
102010	1105	53	66	44	102010
101523	1272	42	76	87	101523
243511	1944	71	65	110	243511
22938	391	10	9	0	22938
41566	761	35	42	27	41566
152474	1605	65	45	83	152474
61857	530	25	25	30	61857
99923	1988	66	115	80	99923
132487	1386	41	97	98	132487
317394	2395	86	53	82	317394
21054	387	16	2	0	21054
209641	1742	42	52	60	209641
22648	620	19	44	28	22648
31414	449	19	22	9	31414
46698	800	45	35	33	46698
131698	1684	65	74	59	131698
91735	1050	35	103	49	91735
244749	2699	95	144	115	244749
184510	1606	49	60	140	184510
79863	1502	37	134	49	79863
128423	1204	64	89	120	128423
97839	1138	38	42	66	97839
38214	568	34	52	21	38214
151101	1459	32	98	124	151101
272458	2158	65	99	152	272458
172494	1111	52	52	139	172494
108043	1421	62	29	38	108043
328107	2833	65	125	144	328107
250579	1955	83	106	120	250579
351067	2922	95	95	160	351067
158015	1002	29	40	114	158015
98866	1060	18	140	39	98866
85439	956	33	43	78	85439
229242	2186	247	128	119	229242
351619	3604	139	142	141	351619
84207	1035	29	73	101	84207
120445	1417	118	72	56	120445
324598	3261	110	128	133	324598
131069	1587	67	61	83	131069
204271	1424	42	73	116	204271
165543	1701	65	148	90	165543
141722	1249	94	64	36	141722
116048	946	64	45	50	116048
250047	1926	81	58	61	250047
299775	3352	95	97	97	299775
195838	1641	67	50	98	195838
173260	2035	63	37	78	173260
254488	2312	83	50	117	254488
104389	1369	45	105	148	104389
136084	1577	30	69	41	136084
199476	2201	70	46	105	199476
92499	961	32	57	55	92499
224330	1900	83	52	132	224330
135781	1254	31	98	44	135781
74408	1335	67	61	21	74408
81240	1597	66	89	50	81240
14688	207	10	0	0	14688
181633	1645	70	48	73	181633
271856	2429	103	91	86	271856
7199	151	5	0	0	7199
46660	474	20	7	13	46660
17547	141	5	3	4	17547
133368	1639	36	54	57	133368
95227	872	34	70	48	95227
152601	1318	48	36	46	152601
98146	1018	40	37	48	98146
79619	1383	43	123	32	79619
59194	1314	31	247	68	59194
139942	1335	42	46	87	139942
118612	1403	46	72	43	118612
72880	910	33	41	67	72880
65475	616	18	24	46	65475
99643	1407	55	45	46	99643
71965	771	35	33	56	71965
77272	766	59	27	48	77272
49289	473	19	36	44	49289
135131	1376	66	87	60	135131
108446	1232	60	90	65	108446
89746	1521	36	114	55	89746
44296	572	25	31	38	44296
77648	1059	47	45	52	77648
181528	1544	54	69	60	181528
134019	1230	53	51	54	134019
124064	1206	40	34	86	124064
92630	1205	40	60	24	92630
121848	1255	39	45	52	121848
52915	613	14	54	49	52915
81872	721	45	25	61	81872
58981	1109	36	38	61	58981
53515	740	28	52	81	53515
60812	1126	44	67	43	60812
56375	728	30	74	40	56375
65490	689	22	38	40	65490
80949	592	17	30	56	80949
76302	995	31	26	68	76302
104011	1613	55	67	79	104011
98104	2048	54	132	47	98104
67989	705	21	42	57	67989
30989	301	14	35	41	30989
135458	1803	81	118	29	135458
73504	799	35	68	3	73504
63123	861	43	43	60	63123
61254	1186	46	76	30	61254
74914	1451	30	64	79	74914
31774	628	23	48	47	31774
81437	1161	38	64	40	81437
87186	1463	54	56	48	87186
50090	742	20	71	36	50090
65745	979	53	75	42	65745
56653	675	45	39	49	56653
158399	1241	39	42	57	158399
46455	676	20	39	12	46455
73624	1049	24	93	40	73624
38395	620	31	38	43	38395
91899	1081	35	60	33	91899
139526	1688	151	71	77	139526
52164	736	52	52	43	52164
51567	617	30	27	45	51567
70551	812	31	59	47	70551
84856	1051	29	40	43	84856
102538	1656	57	79	45	102538
86678	705	40	44	50	86678
85709	945	44	65	35	85709
34662	554	25	10	7	34662
150580	1597	77	124	71	150580
99611	982	35	81	67	99611
19349	222	11	15	0	19349
99373	1212	63	92	62	99373
86230	1143	44	42	54	86230
30837	435	19	10	4	30837
31706	532	13	24	25	31706
89806	882	42	64	40	89806
62088	608	38	45	38	62088
40151	459	29	22	19	40151
27634	578	20	56	17	27634
76990	826	27	94	67	76990
37460	509	20	19	14	37460
54157	717	19	35	30	54157
49862	637	37	32	54	49862
84337	857	26	35	35	84337
64175	830	42	48	59	64175
59382	652	49	49	24	59382
119308	707	30	48	58	119308
76702	954	49	62	42	76702
103425	1461	67	96	46	103425
70344	672	28	45	61	70344
43410	778	19	63	3	43410
104838	1141	49	71	52	104838
62215	680	27	26	25	62215
69304	1090	30	48	40	69304
53117	616	22	29	32	53117
19764	285	12	19	4	19764
86680	1145	31	45	49	86680
84105	733	20	45	63	84105
77945	888	20	67	67	77945
89113	849	39	30	32	89113
91005	1182	29	36	23	91005
40248	528	16	34	7	40248
64187	642	27	36	54	64187
50857	947	21	34	37	50857
56613	819	19	37	35	56613
62792	757	35	46	51	62792
72535	894	14	44	39	72535

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')
}