R version 2.8.0 (2008-10-20)
Copyright (C) 2008 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> x <- array(list(8,0,-10,0,-24,0,-19,0,8,1,24,1,14,1,7,1,9,1,-26,0,19,0,15,0,-1,0,-10,0,-21,0,-14,0,-27,0,26,0,23,0,5,0,19,0,-19,0,24,1,17,1,1,1,-9,1,-16,1,-21,1,-14,1,31,1,27,1,10,1,12,1,-23,1,13,1,26,1,-1,1,4,1,-16,1,-5,1,9,1,23,1,9,1,2,1,10,1,-29,0,17,0,9,0,9,0,-10,0,-23,0,13,0,13,0,-9,0,9,0,5,0,8,0,-18,0,7,1,4,1),dim=c(2,60),dimnames=list(c('Woongebouwen','Conjunctuur'),1:60))
> y <- array(NA,dim=c(2,60),dimnames=list(c('Woongebouwen','Conjunctuur'),1:60))
> for (i in 1:dim(x)[1])
+ {
+ for (j in 1:dim(x)[2])
+ {
+ y[i,j] <- as.numeric(x[i,j])
+ }
+ }
> par3 = 'No Linear Trend'
> par2 = 'Include Monthly Dummies'
> par1 = '1'
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description (don't use hard returns!)
> library(lattice)
> library(lmtest)
Loading required package: zoo
Attaching package: 'zoo'
The following object(s) are masked from package:base :
as.Date.numeric
> 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
Woongebouwen Conjunctuur M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 M11
1 8 0 1 0 0 0 0 0 0 0 0 0 0
2 -10 0 0 1 0 0 0 0 0 0 0 0 0
3 -24 0 0 0 1 0 0 0 0 0 0 0 0
4 -19 0 0 0 0 1 0 0 0 0 0 0 0
5 8 1 0 0 0 0 1 0 0 0 0 0 0
6 24 1 0 0 0 0 0 1 0 0 0 0 0
7 14 1 0 0 0 0 0 0 1 0 0 0 0
8 7 1 0 0 0 0 0 0 0 1 0 0 0
9 9 1 0 0 0 0 0 0 0 0 1 0 0
10 -26 0 0 0 0 0 0 0 0 0 0 1 0
11 19 0 0 0 0 0 0 0 0 0 0 0 1
12 15 0 0 0 0 0 0 0 0 0 0 0 0
13 -1 0 1 0 0 0 0 0 0 0 0 0 0
14 -10 0 0 1 0 0 0 0 0 0 0 0 0
15 -21 0 0 0 1 0 0 0 0 0 0 0 0
16 -14 0 0 0 0 1 0 0 0 0 0 0 0
17 -27 0 0 0 0 0 1 0 0 0 0 0 0
18 26 0 0 0 0 0 0 1 0 0 0 0 0
19 23 0 0 0 0 0 0 0 1 0 0 0 0
20 5 0 0 0 0 0 0 0 0 1 0 0 0
21 19 0 0 0 0 0 0 0 0 0 1 0 0
22 -19 0 0 0 0 0 0 0 0 0 0 1 0
23 24 1 0 0 0 0 0 0 0 0 0 0 1
24 17 1 0 0 0 0 0 0 0 0 0 0 0
25 1 1 1 0 0 0 0 0 0 0 0 0 0
26 -9 1 0 1 0 0 0 0 0 0 0 0 0
27 -16 1 0 0 1 0 0 0 0 0 0 0 0
28 -21 1 0 0 0 1 0 0 0 0 0 0 0
29 -14 1 0 0 0 0 1 0 0 0 0 0 0
30 31 1 0 0 0 0 0 1 0 0 0 0 0
31 27 1 0 0 0 0 0 0 1 0 0 0 0
32 10 1 0 0 0 0 0 0 0 1 0 0 0
33 12 1 0 0 0 0 0 0 0 0 1 0 0
34 -23 1 0 0 0 0 0 0 0 0 0 1 0
35 13 1 0 0 0 0 0 0 0 0 0 0 1
36 26 1 0 0 0 0 0 0 0 0 0 0 0
37 -1 1 1 0 0 0 0 0 0 0 0 0 0
38 4 1 0 1 0 0 0 0 0 0 0 0 0
39 -16 1 0 0 1 0 0 0 0 0 0 0 0
40 -5 1 0 0 0 1 0 0 0 0 0 0 0
41 9 1 0 0 0 0 1 0 0 0 0 0 0
42 23 1 0 0 0 0 0 1 0 0 0 0 0
43 9 1 0 0 0 0 0 0 1 0 0 0 0
44 2 1 0 0 0 0 0 0 0 1 0 0 0
45 10 1 0 0 0 0 0 0 0 0 1 0 0
46 -29 0 0 0 0 0 0 0 0 0 0 1 0
47 17 0 0 0 0 0 0 0 0 0 0 0 1
48 9 0 0 0 0 0 0 0 0 0 0 0 0
49 9 0 1 0 0 0 0 0 0 0 0 0 0
50 -10 0 0 1 0 0 0 0 0 0 0 0 0
51 -23 0 0 0 1 0 0 0 0 0 0 0 0
52 13 0 0 0 0 1 0 0 0 0 0 0 0
53 13 0 0 0 0 0 1 0 0 0 0 0 0
54 -9 0 0 0 0 0 0 1 0 0 0 0 0
55 9 0 0 0 0 0 0 0 1 0 0 0 0
56 5 0 0 0 0 0 0 0 0 1 0 0 0
57 8 0 0 0 0 0 0 0 0 0 1 0 0
58 -18 0 0 0 0 0 0 0 0 0 0 1 0
59 7 1 0 0 0 0 0 0 0 0 0 0 1
60 4 1 0 0 0 0 0 0 0 0 0 0 0
> k <- length(x[1,])
> df <- as.data.frame(x)
> (mylm <- lm(df))
Call:
lm(formula = df)
Coefficients:
(Intercept) Conjunctuur M1 M2 M3 M4
12.803 2.329 -10.534 -20.734 -33.734 -22.934
M5 M6 M7 M8 M9 M10
-16.400 4.800 2.200 -8.400 -2.600 -36.269
M11
1.800
> (mysum <- summary(mylm))
Call:
lm(formula = df)
Residuals:
Min 1Q Median 3Q Max
-26.603 -3.649 -0.300 4.716 23.131
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 12.803 4.461 2.870 0.006138 **
Conjunctuur 2.329 2.510 0.928 0.358238
M1 -10.534 5.960 -1.767 0.083648 .
M2 -20.734 5.960 -3.479 0.001097 **
M3 -33.734 5.960 -5.660 8.77e-07 ***
M4 -22.934 5.960 -3.848 0.000358 ***
M5 -16.400 5.939 -2.761 0.008185 **
M6 4.800 5.939 0.808 0.423041
M7 2.200 5.939 0.370 0.712726
M8 -8.400 5.939 -1.414 0.163844
M9 -2.600 5.939 -0.438 0.663550
M10 -36.269 6.023 -6.021 2.50e-07 ***
M11 1.800 5.939 0.303 0.763167
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 9.39 on 47 degrees of freedom
Multiple R-squared: 0.7349, Adjusted R-squared: 0.6672
F-statistic: 10.86 on 12 and 47 DF, p-value: 7.063e-10
> 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
+ }
[,1] [,2] [,3]
[1,] 0.07749432 0.15498864 0.9225057
[2,] 0.03416364 0.06832728 0.9658364
[3,] 0.42635171 0.85270342 0.5736483
[4,] 0.54451125 0.91097750 0.4554888
[5,] 0.42828398 0.85656796 0.5717160
[6,] 0.42379183 0.84758366 0.5762082
[7,] 0.33606779 0.67213559 0.6639322
[8,] 0.25818531 0.51637062 0.7418147
[9,] 0.17874230 0.35748461 0.8212577
[10,] 0.12599666 0.25199331 0.8740033
[11,] 0.08194223 0.16388446 0.9180578
[12,] 0.05176820 0.10353639 0.9482318
[13,] 0.06990782 0.13981564 0.9300922
[14,] 0.10891683 0.21783365 0.8910832
[15,] 0.15173769 0.30347538 0.8482623
[16,] 0.18149499 0.36298998 0.8185050
[17,] 0.13300882 0.26601764 0.8669912
[18,] 0.08987185 0.17974370 0.9101282
[19,] 0.05695928 0.11391855 0.9430407
[20,] 0.04388407 0.08776814 0.9561159
[21,] 0.07900654 0.15801308 0.9209935
[22,] 0.06526884 0.13053769 0.9347312
[23,] 0.08335448 0.16670897 0.9166455
[24,] 0.05638142 0.11276284 0.9436186
[25,] 0.09931350 0.19862700 0.9006865
[26,] 0.11692710 0.23385420 0.8830729
[27,] 0.85199584 0.29600831 0.1480042
[28,] 0.78268359 0.43463281 0.2173164
[29,] 0.63011810 0.73976380 0.3698819
> postscript(file="/var/www/html/rcomp/tmp/1kyr01227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> 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()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/2rmdk1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> plot(mysum$resid, type='b', pch=19, main='Residuals', ylab='value of Residuals', xlab='time or index')
> grid()
> dev.off()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/3xtur1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> hist(mysum$resid, main='Residual Histogram', xlab='values of Residuals')
> grid()
> dev.off()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/4d73v1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> densityplot(~mysum$resid,col='black',main='Residual Density Plot', xlab='values of Residuals')
> dev.off()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/54ze31227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> qqnorm(mysum$resid, main='Residual Normal Q-Q Plot')
> qqline(mysum$resid)
> grid()
> dev.off()
null device
1
> (myerror <- as.ts(mysum$resid))
Time Series:
Start = 1
End = 60
Frequency = 1
1 2 3 4 5 6
5.73142857 -2.06857143 -3.06857143 -8.86857143 9.26857143 4.06857143
7 8 9 10 11 12
-3.33142857 0.26857143 -3.53142857 -2.53428571 4.39714286 2.19714286
13 14 15 16 17 18
-3.26857143 -2.06857143 -0.06857143 -3.86857143 -23.40285714 8.39714286
19 20 21 22 23 24
7.99714286 0.59714286 8.79714286 4.46571429 7.06857143 1.86857143
25 26 27 28 29 30
-3.59714286 -3.39714286 2.60285714 -13.19714286 -12.73142857 11.06857143
31 32 33 34 35 36
9.66857143 3.26857143 -0.53142857 -1.86285714 -3.93142857 10.86857143
37 38 39 40 41 42
-5.59714286 9.60285714 2.60285714 2.80285714 10.26857143 3.06857143
43 44 45 46 47 48
-8.33142857 -4.73142857 -2.53142857 -5.53428571 2.39714286 -3.80285714
49 50 51 52 53 54
6.73142857 -2.06857143 -2.06857143 23.13142857 16.59714286 -26.60285714
55 56 57 58 59 60
-6.00285714 0.59714286 -2.20285714 5.46571429 -9.93142857 -11.13142857
> postscript(file="/var/www/html/rcomp/tmp/6u71i1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> dum <- cbind(lag(myerror,k=1),myerror)
> dum
Time Series:
Start = 0
End = 60
Frequency = 1
lag(myerror, k = 1) myerror
0 5.73142857 NA
1 -2.06857143 5.73142857
2 -3.06857143 -2.06857143
3 -8.86857143 -3.06857143
4 9.26857143 -8.86857143
5 4.06857143 9.26857143
6 -3.33142857 4.06857143
7 0.26857143 -3.33142857
8 -3.53142857 0.26857143
9 -2.53428571 -3.53142857
10 4.39714286 -2.53428571
11 2.19714286 4.39714286
12 -3.26857143 2.19714286
13 -2.06857143 -3.26857143
14 -0.06857143 -2.06857143
15 -3.86857143 -0.06857143
16 -23.40285714 -3.86857143
17 8.39714286 -23.40285714
18 7.99714286 8.39714286
19 0.59714286 7.99714286
20 8.79714286 0.59714286
21 4.46571429 8.79714286
22 7.06857143 4.46571429
23 1.86857143 7.06857143
24 -3.59714286 1.86857143
25 -3.39714286 -3.59714286
26 2.60285714 -3.39714286
27 -13.19714286 2.60285714
28 -12.73142857 -13.19714286
29 11.06857143 -12.73142857
30 9.66857143 11.06857143
31 3.26857143 9.66857143
32 -0.53142857 3.26857143
33 -1.86285714 -0.53142857
34 -3.93142857 -1.86285714
35 10.86857143 -3.93142857
36 -5.59714286 10.86857143
37 9.60285714 -5.59714286
38 2.60285714 9.60285714
39 2.80285714 2.60285714
40 10.26857143 2.80285714
41 3.06857143 10.26857143
42 -8.33142857 3.06857143
43 -4.73142857 -8.33142857
44 -2.53142857 -4.73142857
45 -5.53428571 -2.53142857
46 2.39714286 -5.53428571
47 -3.80285714 2.39714286
48 6.73142857 -3.80285714
49 -2.06857143 6.73142857
50 -2.06857143 -2.06857143
51 23.13142857 -2.06857143
52 16.59714286 23.13142857
53 -26.60285714 16.59714286
54 -6.00285714 -26.60285714
55 0.59714286 -6.00285714
56 -2.20285714 0.59714286
57 5.46571429 -2.20285714
58 -9.93142857 5.46571429
59 -11.13142857 -9.93142857
60 NA -11.13142857
> dum1 <- dum[2:length(myerror),]
> dum1
lag(myerror, k = 1) myerror
[1,] -2.06857143 5.73142857
[2,] -3.06857143 -2.06857143
[3,] -8.86857143 -3.06857143
[4,] 9.26857143 -8.86857143
[5,] 4.06857143 9.26857143
[6,] -3.33142857 4.06857143
[7,] 0.26857143 -3.33142857
[8,] -3.53142857 0.26857143
[9,] -2.53428571 -3.53142857
[10,] 4.39714286 -2.53428571
[11,] 2.19714286 4.39714286
[12,] -3.26857143 2.19714286
[13,] -2.06857143 -3.26857143
[14,] -0.06857143 -2.06857143
[15,] -3.86857143 -0.06857143
[16,] -23.40285714 -3.86857143
[17,] 8.39714286 -23.40285714
[18,] 7.99714286 8.39714286
[19,] 0.59714286 7.99714286
[20,] 8.79714286 0.59714286
[21,] 4.46571429 8.79714286
[22,] 7.06857143 4.46571429
[23,] 1.86857143 7.06857143
[24,] -3.59714286 1.86857143
[25,] -3.39714286 -3.59714286
[26,] 2.60285714 -3.39714286
[27,] -13.19714286 2.60285714
[28,] -12.73142857 -13.19714286
[29,] 11.06857143 -12.73142857
[30,] 9.66857143 11.06857143
[31,] 3.26857143 9.66857143
[32,] -0.53142857 3.26857143
[33,] -1.86285714 -0.53142857
[34,] -3.93142857 -1.86285714
[35,] 10.86857143 -3.93142857
[36,] -5.59714286 10.86857143
[37,] 9.60285714 -5.59714286
[38,] 2.60285714 9.60285714
[39,] 2.80285714 2.60285714
[40,] 10.26857143 2.80285714
[41,] 3.06857143 10.26857143
[42,] -8.33142857 3.06857143
[43,] -4.73142857 -8.33142857
[44,] -2.53142857 -4.73142857
[45,] -5.53428571 -2.53142857
[46,] 2.39714286 -5.53428571
[47,] -3.80285714 2.39714286
[48,] 6.73142857 -3.80285714
[49,] -2.06857143 6.73142857
[50,] -2.06857143 -2.06857143
[51,] 23.13142857 -2.06857143
[52,] 16.59714286 23.13142857
[53,] -26.60285714 16.59714286
[54,] -6.00285714 -26.60285714
[55,] 0.59714286 -6.00285714
[56,] -2.20285714 0.59714286
[57,] 5.46571429 -2.20285714
[58,] -9.93142857 5.46571429
[59,] -11.13142857 -9.93142857
> z <- as.data.frame(dum1)
> z
lag(myerror, k = 1) myerror
1 -2.06857143 5.73142857
2 -3.06857143 -2.06857143
3 -8.86857143 -3.06857143
4 9.26857143 -8.86857143
5 4.06857143 9.26857143
6 -3.33142857 4.06857143
7 0.26857143 -3.33142857
8 -3.53142857 0.26857143
9 -2.53428571 -3.53142857
10 4.39714286 -2.53428571
11 2.19714286 4.39714286
12 -3.26857143 2.19714286
13 -2.06857143 -3.26857143
14 -0.06857143 -2.06857143
15 -3.86857143 -0.06857143
16 -23.40285714 -3.86857143
17 8.39714286 -23.40285714
18 7.99714286 8.39714286
19 0.59714286 7.99714286
20 8.79714286 0.59714286
21 4.46571429 8.79714286
22 7.06857143 4.46571429
23 1.86857143 7.06857143
24 -3.59714286 1.86857143
25 -3.39714286 -3.59714286
26 2.60285714 -3.39714286
27 -13.19714286 2.60285714
28 -12.73142857 -13.19714286
29 11.06857143 -12.73142857
30 9.66857143 11.06857143
31 3.26857143 9.66857143
32 -0.53142857 3.26857143
33 -1.86285714 -0.53142857
34 -3.93142857 -1.86285714
35 10.86857143 -3.93142857
36 -5.59714286 10.86857143
37 9.60285714 -5.59714286
38 2.60285714 9.60285714
39 2.80285714 2.60285714
40 10.26857143 2.80285714
41 3.06857143 10.26857143
42 -8.33142857 3.06857143
43 -4.73142857 -8.33142857
44 -2.53142857 -4.73142857
45 -5.53428571 -2.53142857
46 2.39714286 -5.53428571
47 -3.80285714 2.39714286
48 6.73142857 -3.80285714
49 -2.06857143 6.73142857
50 -2.06857143 -2.06857143
51 23.13142857 -2.06857143
52 16.59714286 23.13142857
53 -26.60285714 16.59714286
54 -6.00285714 -26.60285714
55 0.59714286 -6.00285714
56 -2.20285714 0.59714286
57 5.46571429 -2.20285714
58 -9.93142857 5.46571429
59 -11.13142857 -9.93142857
> 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()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/7ex6z1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> acf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Autocorrelation Function')
> grid()
> dev.off()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/82bdg1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> pacf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Partial Autocorrelation Function')
> grid()
> dev.off()
null device
1
> postscript(file="/var/www/html/rcomp/tmp/9y7yi1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
> plot(mylm, las = 1, sub='Residual Diagnostics')
> par(opar)
> dev.off()
null device
1
> if (n > n25) {
+ postscript(file="/var/www/html/rcomp/tmp/105kkc1227724849.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
+ plot(kp3:nmkm3,gqarr[,2], main='Goldfeld-Quandt test',ylab='2-sided p-value',xlab='breakpoint')
+ grid()
+ dev.off()
+ }
null device
1
>
> #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/rcomp/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="/var/www/html/rcomp/tmp/11f1421227724849.tab")
> a<-table.start()
> a<-table.row.start(a)
> a<-table.element(a,hyperlink('http://www.xycoon.com/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="/var/www/html/rcomp/tmp/12kg6h1227724849.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="/var/www/html/rcomp/tmp/1391a21227724850.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="/var/www/html/rcomp/tmp/14vmwy1227724850.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="/var/www/html/rcomp/tmp/15ueps1227724850.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="/var/www/html/rcomp/tmp/16uvjb1227724850.tab")
+ }
>
> system("convert tmp/1kyr01227724849.ps tmp/1kyr01227724849.png")
> system("convert tmp/2rmdk1227724849.ps tmp/2rmdk1227724849.png")
> system("convert tmp/3xtur1227724849.ps tmp/3xtur1227724849.png")
> system("convert tmp/4d73v1227724849.ps tmp/4d73v1227724849.png")
> system("convert tmp/54ze31227724849.ps tmp/54ze31227724849.png")
> system("convert tmp/6u71i1227724849.ps tmp/6u71i1227724849.png")
> system("convert tmp/7ex6z1227724849.ps tmp/7ex6z1227724849.png")
> system("convert tmp/82bdg1227724849.ps tmp/82bdg1227724849.png")
> system("convert tmp/9y7yi1227724849.ps tmp/9y7yi1227724849.png")
> system("convert tmp/105kkc1227724849.ps tmp/105kkc1227724849.png")
>
>
> proc.time()
user system elapsed
2.396 1.542 2.919