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

10	72	36	32	68	56	43	89	56
20	70	30	50	70	60	30	60	50
40	90	70	70	90	70	30	95	70
67	81	61	63	95	68	54	97	67
38	80	46	85	75	63	30	80	60
61	40	40	40	69	67	16	92	83
29	49	50	45	39	41	42	61	37
0	80	10	50	80	50	0	90	50
30	90	30	70	100	80	30	100	70
39	86	61	67	80	59	44	96	51
70	100	80	80	81	81	70	100	81
65	40	65	45	55	70	30	70	60
5	100	20	90	100	90	5	100	90
30	75	60	45	75	50	30	85	45
50	83	69	78	70	85	62	89	62
90	100	91	100	100	100	91	100	100
45	77	62	60	61	60	41	74	51
75	55	90	70	83	90	73	94	72
76	97	80	64	90	61	60	96	59
15	60	25	40	60	45	20	70	30
10	40	NA	44	44	82	4	85	73
NA	100	NA	90	90	90	NA	90	90
60	100	70	90	100	100	60	100	90
67	59	63	NA	82	54	62	81	NA
60	65	60	68	80	55	60	71	80
80	91	77	92	88	86	76	85	84
70	100	70	90	100	95	65	100	95
70	85	76	82	83	76	60	62	58
87	62	78	83	75	75	88	86	76
27	68	61	59	55	59	16	60	57
65	75	65	55	75	60	65	80	55
56	80	80	66	80	80	35	80	65
82	80	30	50	70	70	70	100	70
30	34	23	18	100	29	21	100	28
38	42	100	61	60	92	60	100	57
56	94	94	NA	95	89	100	96	89
70	85	75	85	95	85	65	95	85
80	95	80	90	90	90	80	100	80
71	90	71	65	90	65	65	90	65
50	80	60	60	80	70	60	80	59
31	61	37	65	76	70	31	90	67
40	65	55	60	65	56	55	65	60
71	73	79	72	78	74	74	98	93
71	81	38	20	70	44	32	38	56
10	40	20	30	60	50	10	90	50
20	90	40	80	65	60	20	90	60
40	95	70	45	100	90	40	100	85
55	67	60	67	65	65	55	70	67
80	90	85	100	90	90	70	100	95
80	90	70	80	90	80	80	95	80
72	90	78	65	90	72	50	88	62
60	85	75	80	80	80	55	85	80
29	91	49	91	91	91	29	91	91
70	100	70	100	100	100	70	100	100
60	60	70	66	90	78	50	100	71
63	100	70	65	80	81	60	100	63
70	90	70	70	100	70	60	100	60
38	85	48	78	88	61	27	95	53
40	81	59	100	61	100	38	80	100
80	80	80	70	90	80	70	100	80
24	45	38	45	58	49	15	70	50
40	90	50	40	90	50	40	100	40
47	93	65	74	88	63	37	93	54
70	75	50	80	90	75	NA	100	60
70	80	70	60	80	70	10	100	59
75	85	65	75	85	65	75	85	75
60	70	70	70	60	75	60	75	70
65	80	70	75	95	90	55	100	75
91	96	90	90	100	91	91	100	91
68	62	43	69	61	69	29	50	66
80	82	NA	70	NA	70	NA	80	70
90	50	90	50	80	90	50	90	50
20	75	40	50	90	75	10	100	50
61	59	59	66	75	77	57	88	74
13	78	31	66	85	81	45	90	79
80	95	80	65	95	75	70	99	70
40	70	54	64	78	65	38	90	57
70	80	70	80	90	85	70	90	85
39	75	40	60	80	60	40	100	60
93	95	65	93	100	94	61	100	96
10	70	15	40	30	45	15	88	10
25	90	40	80	70	70	25	100	40
56	59	58	65	67	62	54	71	58
18	16	14	38	35	34	36	95	34
60	60	70	70	100	80	50	100	70
74	87	87	82	96	90	68	97	80
35	80	43	57	74	55	14	93	60
NA	70	70	70	70	70	NA	70	70
71	80	71	70	80	71	68	90	71
100	100	100	100	100	100	100	100	100
64	100	78	74	100	74	74	100	74
50	81	32	43	74	61	59	96	56
40	49	52	52	59	58	50	72	51
35	75	60	60	35	60	60	75	35
60	70	NA	80	80	90	60	81	64
70	91	71	71	91	71	70	91	70
55	75	53	68	75	75	45	82	75
65	85	65	80	82	70	60	84	70
30	84	50	81	NA	88	21	99	47
25	100	20	65	100	65	0	100	50
80	90	80	90	90	90	65	100	90
26	87	39	51	50	47	33	73	53
78	86	80	68	90	69	70	100	69
10	60	30	10	60	10	20	70	10
70	100	65	81	100	84	60	100	83
NA	78	77	85	80	83	84	81	79
65	80	35	55	65	60	65	85	65
80	90	60	85	100	91	60	100	90
60	81	72	65	72	68	53	90	44
74	71	63	67	98	70	71	93	67
49	92	60	48	93	56	32	97	45
70	NA	60	40	45	66	70	90	80
66	50	71	60	88	100	60	100	91
65	81	66	65	82	72	60	82	67
65	90	65	60	90	60	NA	90	50
40	90	75	75	100	80	50	100	65
40	85	40	65	75	70	25	85	60
20	80	30	80	100	50	20	100	30
90	95	70	100	100	100	80	100	100
48	100	59	98	80	91	53	88	89
25	79	57	65	71	64	39	84	59
35	80	55	68	71	70	53	76	69
40	50	45	50	60	60	39	80	54
77	70	50	82	100	84	70	95	78
70	81	59	65	80	71	60	86	66
82	91	87	72	85	89	77	89	84
80	100	80	80	100	80	80	100	80
52	57	62	64	61	59	50	67	51
71	79	60	77	73	74	69	78	76
70	95	60	70	80	75	70	95	70
50	NA	59	60	60	71	36	64	61
80	90	60	NA	100	NA	30	100	NA
72	81	69	82	83	77	57	82	77
80	70	40	70	70	70	80	85	70
91	90	90	91	91	91	91	91	91
18	40	23	40	45	80	8	80	44
70	60	60	60	70	60	60	80	60
76	100	78	40	95	52	63	100	53
65	80	60	65	80	65	60	81	63
35	81	46	NA	78	63	18	91	71
62	100	69	70	100	95	39	100	100
76	87	58	49	100	73	41	93	73
50	100	69	100	100	100	50	100	68
68	88	71	77	82	80	65	85	81
80	NA	85	60	NA	60	80	60	60
90	100	85	80	90	65	68	100	70
79	93	83	75	87	89	58	98	89
30	60	50	40	75	70	30	85	60
60	85	70	60	NA	70	60	100	60
100	100	100	100	100	100	100	100	100

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