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

50	105	20	51.6
50	105	40	154
50	105	60	473
50	105	80	1473
100	105	80	673
100	105	60	236
100	105	40	84.1
100	105	20	30.9
250	105	20	15.8
250	105	40	37.8
250	105	60	93.4
250	105	80	236
250	105	100	603
250	105	120	1549
250	105	120	579
500	105	100	247
500	105	80	106
500	105	60	46.3
500	105	40	20.7
500	105	20	9.46
1000	105	20	5.68
1000	105	40	11.3
1000	105	60	23.1
1000	105	80	47.9
1000	105	100	101
1000	105	120	215
1000	105	120	126
2000	105	90	44
2000	105	70	22.2
2000	105	50	11.4
2000	105	20	4.31
2000	105	40	8.2
5000	105	20	3.11
5000	105	40	5.62
5000	105	60	10.3
5000	105	80	19
5000	105	100	35.5
5000	105	120	67.2
3500	200	120	54.8
3500	200	100	29.6
3500	200	80	16.1
3500	200	60	8.9
3500	200	40	4.97
3500	200	20	2.8
2000	200	20	3.31
2000	200	40	6.04
2000	200	60	11.1
2000	200	80	20.8
2000	200	100	39.5
2000	200	120	75.7
1000	200	120	123
1000	200	100	61
1000	200	80	30.6
1000	200	60	15.6
1000	200	40	8.08
1000	200	20	4.26
500	200	20	7.07
500	200	40	14.7
500	200	60	31.1
500	200	80	67.4
500	200	100	148
500	200	120	329
300	200	120	683
300	200	100	287
300	200	80	121
300	200	60	52.1
300	200	40	22.9
300	200	20	10.3
150	200	20	17.2
150	200	40	41.9
150	200	60	105
150	200	90	435
150	200	110	1132
75	200	90	1007
75	200	60	212
75	200	20	28.6
75	200	75	461
40	200	20	45.6
40	200	40	133
40	200	60	400
40	200	80	1220
10	200	20	128
10	200	30	236
10	200	40	466
10	200	50	844
5	500	50	960
5	500	40	504
5	500	30	266
5	500	20	141
10	500	20	84.2
10	500	40	274
10	500	60	918
10	500	50	501
50	500	50	109
50	500	70	299
50	500	90	830
110	500	90	317
110	500	110	798
110	500	60	80.9
110	500	40	33.4
110	500	20	14.2
110	500	30	21.7
300	500	25	8.11
300	500	50	20.2
300	500	40	14
300	500	70	43
300	500	100	138
300	500	120	304
700	500	120	92.8
700	500	100	47.4
700	500	80	24.5
700	500	40	6.83
700	500	20	3.68
1500	500	20	2.58
1500	500	40	4.51
1500	500	60	7.97
1500	500	90	19.1
1500	500	120	46.8
1700	500	120	44.5
1700	500	70	10.2
1700	500	40	4.37
1700	500	20	2.51
1700	500	95	21.2
670	500	95	25.8
670	990	120	55.9
670	990	70	12.1
670	990	40	5.03
670	990	20	2.83
300	990	20	4.89
300	990	40	9.51
300	990	60	16.8
300	990	90	54.2
300	990	120	161
100	990	120	752
100	990	90	202
100	990	65	69
100	990	40	24.2
100	990	20	10.8
50	990	20	18.1
50	990	40	44.5
50	990	60	113
50	990	80	292
50	990	100	766
20	990	100	2478
20	990	80	841
20	990	60	287
20	990	40	99.7
20	990	20	35.7
10	990	20	60
10	990	40	184
10	990	60	580
10	990	70	1038
2	990	50	1490
2	990	40	760
2	990	30	389
2	990	20	201
7	990	20	78.4
7	990	30	140
7	990	40	252
7	990	60	833
2	2100	20	144
2	2100	30	272
2	2100	40	517
2	2100	50	987
5	2100	50	413
5	2100	60	748
5	2100	40	229
5	2100	30	128
5	2100	20	723
10	2100	20	42.9
10	2100	40	124
10	2100	60	369
10	2100	70	640
50	2100	70	111
50	2100	90	272
50	2100	120	1061
50	2100	40	29.9
50	2100	20	12.9
100	2100	20	7.81
100	2100	40	16.5
100	2100	70	52.9
100	2100	90	118
100	2100	120	399
180	2100	120	179
180	2100	100	85.4
180	2100	80	41.3
180	2100	60	203
180	2100	40	10.1
180	2100	20	5.17
35000	20	20	2.9
35000	20	40	5.16
35000	20	60	9.3
35000	20	80	17
35000	20	100	31.3
35000	20	120	58.5
20000	20	120	82.4
20000	20	100	42.7
20000	20	80	22.3
20000	20	60	11.8
20000	20	40	6.37
20000	20	20	3.46
10000	20	20	4.5
10000	20	40	8.62
10000	20	70	23.6
10000	20	90	47.2
10000	20	120	137
5000	20	120	236
5000	20	90	75.3
5000	20	70	35.6
5000	20	40	12
5000	20	20	5.97
2500	20	20	8
2500	20	40	17
2500	20	60	36.8
2500	20	80	81.7
2500	20	100	184
2500	20	120	418
1000	20	120	896
1000	20	100	367
1000	20	80	151
1000	20	60	63.2
1000	20	40	27
1000	20	20	11.9
500	20	20	19.7
500	20	40	49.23
500	20	60	127
500	20	80	334
500	20	100	890
1000	46	40	17.5
1000	46	60	38.2
1000	46	80	85
1000	46	100	193
1000	46	120	440
500	46	120	1179
500	46	100	471
500	46	80	189
500	46	60	76.8
500	46	40	31.9
500	46	20	13.7
1500	46	20	6.92
1500	46	40	14.3
1500	46	60	30.2
1500	46	80	65.1
1500	46	100	143
1500	46	120	315
2000	46	120	250
2000	46	100	115
2000	46	80	54
2000	46	60	25.6
2000	46	40	12.4
2000	46	20	6.14
3000	46	20	5.19
3000	46	40	10.2
3000	46	60	20.4
3000	46	80	41.7
3000	46	100	86.3
3000	46	120	180
5000	46	120	122
5000	46	100	60.6
5000	46	80	30.4
5000	46	60	15.5
5000	46	40	8.05
5000	46	20	4.24
10000	46	20	3.3
10000	46	40	6
10000	46	60	11.1
10000	46	80	20.7
10000	46	100	39.2
10000	46	120	75

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